extract meta data from lilypond compilation

* write that as yaml file next to the other outputs * extract lyrics * makes chordpro export work in songbooks * more metadata for chordpro export
2026-07-12 23:11:36 +02:00
parent 7de31cf0dd
commit 286779fdac
9 changed files with 2155 additions and 525 deletions
@@ -0,0 +1,162 @@
+(use-modules (ice-9 regex) (srfi srfi-1))
+
+;; YAML-Writer: Gegenstück zu yaml_parser.scm.
+;; Schreibt verschachtelte alist/list-Strukturen als YAML, so dass
+;; yml-file->scm sie wieder einlesen kann.
+;;
+;; Datenmodell (wie vom Parser erzeugt):
+;;  - Mapping: Liste von Paaren (key . value), key als String oder Symbol
+;;  - Liste:   Liste von beliebigen Werten
+;;  - Skalare: String, Zahl, #t/#f, '() (leer/null, wird als [] geschrieben)
+;;
+;; Andere Werte werden vorab automatisch umgewandelt: Markups zu Strings,
+;; alles Unbekannte über ~a formatiert (siehe yml-sanitize).
+
+;; Steuert, ob layout_bottom.ily die Header-Daten des Liedes als
+;; YAML-Datei exportiert; aktivierbar per (set! yaml-export-enabled #t)
+;; oder durch Definieren der Variable vor dem Laden der Includes.
+(define yaml-export-enabled
+  (if (defined? 'yaml-export-enabled) yaml-export-enabled #f))
+
+;; Beliebige Werte in YAML-taugliche Daten umwandeln.
+;; (Benötigt die LilyPond-Umgebung für markup? und markup->string.)
+(define (yml-sanitize v)
+  (cond
+   ((or (string? v) (number? v) (boolean? v) (symbol? v) (null? v)) v)
+   ((markup? v) (markup->string v))
+   ((list? v) (map yml-sanitize v))
+   ((pair? v) (cons (yml-sanitize (car v)) (yml-sanitize (cdr v))))
+   (else (format #f "~a" v))))
+
+(define (scm->yml-string data)
+
+  ;; Ist data ein Mapping (alist)? Nicht-leere Liste, deren Elemente
+  ;; alle Paare mit String- oder Symbol-Key sind.
+  ;; Achtung: eine Liste von Listen, deren erste Elemente Strings sind,
+  ;; ist davon nicht unterscheidbar und wird als Mapping interpretiert.
+  (define (mapping? data)
+    (and (pair? data)
+         (list? data)
+         (every (lambda (entry)
+                  (and (pair? entry)
+                       (or (string? (car entry))
+                           (symbol? (car entry)))))
+                data)))
+
+  (define (scalar? v)
+    (or (string? v) (symbol? v) (number? v) (boolean? v) (null? v)))
+
+  (define (key->string k)
+    (if (symbol? k) (symbol->string k) k))
+
+  ;; Muss der String gequotet werden, damit er beim Einlesen wieder
+  ;; als derselbe String erkannt wird?
+  (define (needs-quotes? s)
+    (or (string-null? s)
+        (member s '("true" "false" "null" "{}" "[]"))
+        (string->number s)                       ;; zahlartig ("1981", "1.", "-5") würde zur Zahl
+        (string-index s #\#)                     ;; würde als Kommentar abgeschnitten
+        (string-index s #\:)                     ;; würde als Key: Value gelesen
+        (string-index s #\newline)               ;; mehrzeilig
+        (string-index s #\")
+        (string-prefix? "-" s)                   ;; würde als Listenelement gelesen
+        (string-prefix? "'" s)
+        (not (string=? s (string-trim-both s))))) ;; führende/folgende Leerzeichen
+
+  ;; Doppelt gequoteter YAML-String; Backslash, Anführungszeichen und
+  ;; Zeilenumbrüche werden escaped, damit alles auf einer Zeile bleibt.
+  (define (quote-string s)
+    (string-append
+     "\""
+     (string-concatenate
+      (map (lambda (c)
+             (cond
+              ((char=? c #\\) "\\\\")
+              ((char=? c #\") "\\\"")
+              ((char=? c #\newline) "\\n")
+              (else (string c))))
+           (string->list s)))
+     "\""))
+
+  (define (scalar->string v)
+    (cond
+     ((eq? v #t) "true")
+     ((eq? v #f) "false")
+     ((null? v) "[]")
+     ((number? v) (number->string v))
+     ((symbol? v) (scalar->string (symbol->string v)))
+     ((string? v) (if (needs-quotes? v) (quote-string v) v))
+     (else (error "scm->yml-string: nicht unterstützter Wert" v))))
+
+  (define (indent-string n) (make-string n #\space))
+
+  ;; Key ggf. quoten (leere oder zahlartige Keys, Sonderzeichen)
+  (define (key->yml-string k)
+    (let ((s (key->string k)))
+      (if (needs-quotes? s) (quote-string s) s)))
+
+  ;; Doppelte Keys sind in YAML nicht erlaubt: Werte gleicher Keys werden
+  ;; zu einer Liste zusammengefasst, z.B. authors mit (voice 2) (voice 3)
+  ;; -> voice: [2, 3].
+  (define (merge-duplicate-keys data)
+    (define (value->list v)
+      (if (and (list? v) (not (mapping? v))) v (list v)))
+    (let loop ((entries data) (result '()))
+      (if (null? entries)
+          (reverse result)
+          (let* ((entry (car entries))
+                 (existing (find (lambda (e) (equal? (car e) (car entry)))
+                                 result)))
+            (if existing
+                (begin
+                  (set-cdr! existing (append (value->list (cdr existing))
+                                             (value->list (cdr entry))))
+                  (loop (cdr entries) result))
+                (loop (cdr entries)
+                      (cons (cons (car entry) (cdr entry)) result)))))))
+
+  ;; Mapping schreiben: "key: skalar" oder "key:" mit eingerücktem Inhalt
+  (define (write-mapping data indent port)
+    (for-each
+     (lambda (entry)
+       (let ((key (key->yml-string (car entry)))
+             (value (cdr entry)))
+         (if (scalar? value)
+             (format port "~a~a: ~a\n"
+                     (indent-string indent) key (scalar->string value))
+             (begin
+               (format port "~a~a:\n" (indent-string indent) key)
+               (write-node value (+ indent 2) port)))))
+     (merge-duplicate-keys data)))
+
+  ;; Liste schreiben: "- skalar" oder "-" mit eingerücktem Inhalt
+  ;; (Verschachtelter Inhalt darf NICHT auf der "-"-Zeile beginnen,
+  ;; weil parse-list den Inhalt der "-"-Zeile verwirft, sobald
+  ;; eingerückte Folgezeilen existieren.)
+  (define (write-list data indent port)
+    (for-each
+     (lambda (item)
+       (if (scalar? item)
+           (format port "~a- ~a\n"
+                   (indent-string indent) (scalar->string item))
+           (begin
+             (format port "~a-\n" (indent-string indent))
+             (write-node item (+ indent 2) port))))
+     data))
+
+  (define (write-node data indent port)
+    (cond
+     ((mapping? data) (write-mapping data indent port))
+     ((and (list? data) (not (null? data))) (write-list data indent port))
+     (else (format port "~a~a\n" (indent-string indent) (scalar->string data)))))
+
+  (call-with-output-string
+   (lambda (port) (write-node (yml-sanitize data) 0 port))))
+
+;; Daten als YAML-Datei schreiben
+(define (scm->yml-file filename data)
+  (call-with-output-file filename
+    (lambda (port)
+      (display "---\n" port)
+      (display (scm->yml-string data) port))))
+