blob: f9409119484fc45dc405e00554860cdde0497d67 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
;;
;; scm->yaml
;;
;; This file implements a library to convert a scm tree to yaml.
(define-module (yaml)
#:use-module (ice-9 match)
#:export (scm->yaml))
(define (kebab->camel string)
"Convert STRING from kebab case to CAMEL case."
(match (string-split string #\-)
((head tail ...)
(string-concatenate
(cons head (map string-titlecase tail))))))
(define (display-atom atom port)
"Display ATOM in PORT converting from kebab case to camel case if
ATOM is a symbol."
(cond
((symbol? atom)
(display (string->symbol (kebab->camel (symbol->string atom))) port))
((number? atom)
(display atom port))
((string? atom)
;; Escape string with double quotes if
;; - every character is a digit or period, and the unescaped
;; string can therefore be misinterpreted as a number
;; - string contains the colon character
(if (or (string-every (char-set-union char-set:digit (char-set #\.)) atom)
(string-any #\: atom))
(write atom port)
(display atom port)))
((boolean? atom)
(display (if atom "true" "false") port))
(else (error "Unknown atom" atom))))
(define (indent-level port level)
"Emit whitespaces to PORT corresponding to nesting LEVEL."
(display (make-string (* 2 level) #\space) port))
(define (display-array-element element port level)
"Display array ELEMENT to PORT at nesting LEVEL."
(display "- " port)
(scm->yaml element port (1+ level)))
(define (display-dictionary-entry entry port level)
"Display dictionary ENTRY to PORT at nesting LEVEL."
(match entry
((key . value)
(display-atom key port)
(display ":" port)
(match value
((or #(_ ...)
((_ . _) (_ . _) ...))
(newline port)
(indent-level port (1+ level))
(scm->yaml value port (1+ level)))
(_ (display " " port)
(scm->yaml value port level))))))
(define* (scm->yaml scm #:optional (port (current-output-port)) (level 0))
"Convert SCM, an S-expression tree, to YAML and display to
PORT. LEVEL is an internal recursion variable."
(match scm
(#(head tail ...)
(display-array-element head port level)
(for-each (lambda (element)
(indent-level port level)
(display-array-element element port level))
tail))
(#()
(display "[]" port))
((head tail ...)
(display-dictionary-entry head port level)
(for-each (lambda (entry)
(indent-level port level)
(display-dictionary-entry entry port level))
tail))
(()
(display "{}" port)
(newline port))
(symbol
(display-atom symbol port)
(newline port))))
|
