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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
;;; ccwl --- Concise Common Workflow Language
;;; Copyright © 2021, 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of ccwl.
;;;
;;; ccwl is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; ccwl is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file implements a function scm->yaml to convert a scm tree to
;; YAML. The inverse function yaml->scm is not implemented.
;;
;; If you are interested in writing a proper and complete YAML library
;; with both a scm->yaml and a yaml->scm, please feel free (under the
;; terms of the license mentioned earlier) to steal this code.
;;; Code:
(define-module (ccwl yaml)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ccwl utils)
#:export (scm->yaml
scm->yaml-string))
(define (atom? x)
"Return @code{#t} if @var{x} is a primitive element that can be
serialized to YAML. Else, return @code{#f}."
(or (symbol? x)
(boolean? x)
(number? x)
(string? x)))
(define (display-atom atom port)
"Display ATOM in PORT."
(cond
((symbol? atom)
(display-atom (symbol->string atom) port))
((number? atom)
(display atom port))
((string? atom)
;; TODO: Implement the complete escape logic as per the YAML
;; specification.
;; 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 indicator characters as mentioned in the YAML
;; spec https://yaml.org/spec/1.2.2/#53-indicator-characters
(if (or (string-every (char-set-union char-set:digit (char-set #\.)) atom)
(string-any (char-set #\- #\? #\: #\, #\[ #\] #\{ #\} #\# #\&
#\* #\! #\| #\> #\' #\" #\% #\@ #\`)
atom))
(write atom port)
(display atom port)))
((boolean? atom)
(display (if atom "true" "false") port))
(else (error "Unknown atom" atom))))
(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
;; Display on the same line if value is
;; - an empty array
;; - an empty dictionary
;; - an atom
;; - an array with an atom as its only element
((or #() () (? atom? _) #((? atom? _)))
(display " " port)
(scm->yaml value port level))
;; Else, display it on the next line.
(_
(newline port)
(indent-level port (1+ level))
(scm->yaml value port (1+ 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
;; Display arrays with a single atomic element on the same line.
(#((? atom? single-element))
(display "[" port)
(display-atom single-element port)
(display "]" port)
(newline port))
;; General arrays
(#(head tail ...)
(display-array-element head port level)
(for-each (lambda (element)
(indent-level port level)
(display-array-element element port level))
tail))
;; Empty arrays
(#()
(display "[]" port)
(newline port))
;; General dictionaries
((head tail ...)
(display-dictionary-entry head port level)
(for-each (lambda (entry)
(indent-level port level)
(display-dictionary-entry entry port level))
tail))
;; Empty dictionaries
(()
(display "{}" port)
(newline port))
;; Atoms
(symbol
(display-atom symbol port)
(newline port))))
(define (scm->yaml-string scm)
(call-with-output-string
(cut scm->yaml scm <>)))
|
