diff options
author | Arun Isaac | 2021-02-27 18:51:48 +0530 |
---|---|---|
committer | Arun Isaac | 2021-02-27 18:51:48 +0530 |
commit | ead05e253861cc796eaf21d19cae1ae3707bef9e (patch) | |
tree | 743b4302b56d8579b3b9067c909b03e3b88e3650 /ccwl/yaml.scm | |
parent | 14b037c135889579013f34534374b46ee491a1d4 (diff) | |
download | ccwl-ead05e253861cc796eaf21d19cae1ae3707bef9e.tar.gz ccwl-ead05e253861cc796eaf21d19cae1ae3707bef9e.tar.lz ccwl-ead05e253861cc796eaf21d19cae1ae3707bef9e.zip |
Rename project to ccwl.
ccwl stands for Concise Common Workflow Language.
* generate-cwl/ccwl.scm: Move to ccwl/ccwl.scm.
* generate-cwl/yaml.scm: Move to ccwl/yaml.scm.
Diffstat (limited to 'ccwl/yaml.scm')
-rw-r--r-- | ccwl/yaml.scm | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/ccwl/yaml.scm b/ccwl/yaml.scm new file mode 100644 index 0000000..2036815 --- /dev/null +++ b/ccwl/yaml.scm @@ -0,0 +1,85 @@ +;; +;; scm->yaml +;; +;; This file implements a library to convert a scm tree to yaml. + +(define-module (ccwl 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)))) |