Guile Scheme scm->yaml

scm->yaml.scm

(use-modules
 (ice-9 match)
 (srfi srfi-1)
 (scheme base))

;; Indentation helper: 2 spaces per nesting level
(define (indent level)
  (make-string (* 2 level) #\space))

;; Very minimal scalar serialization.
;; Adjust if you need quoting or more YAML types.
(define (scalar->yaml v)
  (cond
   ((string? v) v)
   ((boolean? v) (if v "true" "false"))
   ((number?  v) (number->string v))
   ((eq? v 'null) "null")
   (else (format #f "~a" v))))

;; Helper: render a mapping whose first key is printed on the same line
;; as a "- " prefix.
;; level: indentation level of the "- ".
;; alist: non-empty alist ((k1 . v1) (k2 . v2) ...).
(define (mapping-after-dash->yaml alist level)
  (define nl "\n")
  (match alist
    (((k1 . v1) . rest)
     (string-append
      ;; "- key1: value1" or "- key1:" if nested/complex
      (indent level) "- "
      (cond
       ;; if v1 is itself a mapping or sequence, print just "key1:"
       ((or (and (list?  v1) (every pair? v1))
            (vector? v1)
            (and (list? v1)
                 (not (every pair? v1))))
        (string-append k1 ":" nl
                       (scm->yaml v1 (+ level 1))))
       ;; scalar first value: "- key1: value1"
       (else
        (string-append k1 ": " (scalar->yaml v1) nl)))
      ;; rest of mapping keys, each on its own line at level+1
      (apply string-append
             (map (lambda (kv)
                    (match kv
                      ((key . value)
                       (cond
                        ((or (and (list?  value)
                                  (every pair? value))
                             (vector? value)
                             (and (list? value)
                                  (not (every pair? value))))
                         (string-append
                          (indent (+ level 1)) key ":" nl
                          (scm->yaml value (+ level 2))))
                        (else
                         (string-append
                          (indent (+ level 1)) key ": "
                          (scalar->yaml value) nl))))))
                  rest))))))

;; Main entry point: convert an SCM value to a YAML string
(define* (scm->yaml x #:optional (level 0))
  (define nl "\n")

  (match x
    ;; Mapping: alist ((key . value) ...)
    ((? (lambda (v) (and (list? v)
                         (every pair? v)))
        alist)
     (apply string-append
            (map (lambda (kv)
                   (match kv
                     ((key . value)
                      (cond
                       ;; If value is a mapping or sequence, put it on its own line and
                       ;; then indent the nested structure.
                       ((or (and (list?  value)
                                 (every pair? value))
                            (vector? value)
                            (and (list? value)
                                 (not (every pair? value))))
                        (string-append
                         (indent level) key ":" nl
                         (scm->yaml value (+ level 1))))
                       ;; Scalar value on same line
                       (else
                        (string-append
                         (indent level) key ": "
                         (scalar->yaml value) nl))))))
                 alist)))

    ;; Sequence: vector
    ((? vector? vec)
     (apply string-append
            (map (lambda (elem)
                   (match elem
                     ;; Element is a mapping (alist): "- key: value" style
                     ((? (lambda (v) (and (list? v)
                                           (every pair? v))) m)
                      (mapping-after-dash->yaml m level))
                     ;; Nested sequence element (vector)
                     ((? vector? v)
                      (string-append
                       (indent level) "-" nl
                       (scm->yaml v (+ level 1))))
                     ;; Scalar element => "- value"
                     (else
                      (string-append
                       (indent level) "- "
                       (scalar->yaml elem) nl))))
                 (vector->list vec))))

    ;; Treat arbitrary lists as sequences (if they are not alists)
    ((? list? lst)
     (apply string-append
            (map (lambda (elem)
                   (match elem
                     ;; mapping as element of list sequence
                     ((? (lambda (v) (and (list? v)
                                           (every pair? v))) m)
                      (mapping-after-dash->yaml m level))
                     ;; nested sequence
                     ((? vector? v)
                      (string-append
                       (indent level) "-" nl
                       (scm->yaml v (+ level 1))))
                     ;; scalar
                     (else
                      (string-append
                       (indent level) "- "
                       (scalar->yaml elem) nl))))
                 lst)))

    ;; Scalar fallback
    (else (scalar->yaml x))))

#;(use-modules (yaml))
#;(read-yaml-file (string-append (getenv "HOME") "/g-files/storage/borgmatic/prime.yml"))

#;`(("location"
    ("source_directories"
     .
     #("/transmission"
       "~/Documents"
       "~/Projects"
       "~/Music"
       "~/Videos"
       "~/Downloads"
       "~/Pictures"))
    ("repositories" . #((("path" . "ssh://10.0.0.3/backups")))))
   ("storage" ("compression" . "auto,zstd"))
   ("retention"
    ("keep_daily" . "7")
    ("keep_weekly" . "4")
    ("keep_monthly" . "6"))
   ("consistency" ("checks" . #("repository" "archives")))
   ("relocated_repo_access_is_ok" . "true")
   ("unknown_unencrypted_repo_access_is_ok" . "true"))

;; Example usage:
;; (display (scm->yaml borgmatic.config.scm))