blob: 8a2b7a5ba8bd735105590cde27d1b922d7fbe09a (
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
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
|
;;; ccwl --- Concise Common Workflow Language
;;; Copyright © 2021 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 (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 the colon, hyphen or asterisk 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
;; If value is an empty array or dictionary, display it on the
;; same line.
((or #() ())
(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
(#(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)
(newline 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))))
(define (scm->yaml-string scm)
(call-with-output-string
(cut scm->yaml scm <>)))
|
