aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorArun Isaac2021-02-21 19:39:10 +0530
committerArun Isaac2021-02-21 19:45:24 +0530
commitef59807ae0b4853802c25c168dafa4ec7c939e8f (patch)
tree877c8a6ed2d9e173fe5207ba97bdf80114869a1b /scripts
parentb0bf91571b562bbbd824dc0c8b3964a5b7a94f36 (diff)
downloadbh20-seq-resource-ef59807ae0b4853802c25c168dafa4ec7c939e8f.tar.gz
bh20-seq-resource-ef59807ae0b4853802c25c168dafa4ec7c939e8f.tar.lz
bh20-seq-resource-ef59807ae0b4853802c25c168dafa4ec7c939e8f.zip
Add a scm->yaml generator
Diffstat (limited to 'scripts')
-rw-r--r--scripts/yaml.scm85
1 files changed, 85 insertions, 0 deletions
diff --git a/scripts/yaml.scm b/scripts/yaml.scm
new file mode 100644
index 0000000..f940911
--- /dev/null
+++ b/scripts/yaml.scm
@@ -0,0 +1,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))))