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
This commit is contained in:
@@ -1,154 +1,259 @@
|
||||
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
|
||||
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 receive) (srfi srfi-1))
|
||||
|
||||
;; YAML-Parser: liest eine Teilmenge von YAML (Block-Syntax, keine
|
||||
;; Flow-Collections, keine Block-Skalare) in verschachtelte
|
||||
;; alist/list-Strukturen. Gegenstück zu yaml_writer.scm.
|
||||
;;
|
||||
;; Ergebnisformat:
|
||||
;; - Mapping -> alist mit String-Keys, Reihenfolge wie in der Datei
|
||||
;; - Liste -> Liste (auch als "- key: value"-Inline-Mappings)
|
||||
;; - Skalare -> String, Zahl, #t/#f, '() (null / {} / [])
|
||||
;;
|
||||
;; Skalar-Interpretation:
|
||||
;; - unquoted und 'single-quoted' Werte werden interpretiert
|
||||
;; (Zahl, true/false/null). Das Interpretieren von single-quoted
|
||||
;; Werten ist Kompatibilitätsverhalten zum alten Parser:
|
||||
;; authors.yml notiert Zahlen als '1898'.
|
||||
;; - "double-quoted" Werte bleiben immer Strings; \\, \" und \n
|
||||
;; werden entescaped (so schreibt sie der yaml_writer).
|
||||
;; - Kommentare (#) werden nur außerhalb von Quotes entfernt und nur,
|
||||
;; wenn ihnen ein Leerzeichen oder der Zeilenanfang vorausgeht.
|
||||
|
||||
;; Hauptparsingfunktion
|
||||
(define (yml-file->scm filename)
|
||||
|
||||
;; Utility: Zeile einlesen
|
||||
(define (read-lines filename)
|
||||
;; --- Zeilen einlesen ------------------------------------------------
|
||||
|
||||
;; Anzahl führender Leerzeichen
|
||||
(define (line-indent line)
|
||||
(let loop ((i 0))
|
||||
(if (and (< i (string-length line))
|
||||
(char=? (string-ref line i) #\space))
|
||||
(loop (+ i 1))
|
||||
i)))
|
||||
|
||||
;; Liefert Items (indent . inhalt); Leerzeilen, reine Kommentarzeilen
|
||||
;; und Dokumentmarker (--- / ...) werden übersprungen.
|
||||
(define (read-items filename)
|
||||
(call-with-input-file filename
|
||||
(lambda (port)
|
||||
(let loop ((lines '()))
|
||||
(let loop ((items '()))
|
||||
(let ((line (read-line port)))
|
||||
(if (eof-object? line)
|
||||
(reverse lines)
|
||||
(let ((clean (string-trim line)))
|
||||
(if (or (string=? clean "---") (string-null? clean))
|
||||
(loop lines) ;; Ignoriere "---" oder leere Zeile
|
||||
(loop (cons line lines))))))))))
|
||||
(reverse items)
|
||||
(let* ((line (if (string-suffix? "\r" line)
|
||||
(string-drop-right line 1)
|
||||
line))
|
||||
(content (string-trim-both line)))
|
||||
(if (or (string-null? content)
|
||||
(string-prefix? "#" content)
|
||||
(string=? content "---")
|
||||
(string=? content "..."))
|
||||
(loop items)
|
||||
(loop (cons (cons (line-indent line) content)
|
||||
items))))))))))
|
||||
|
||||
;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
|
||||
(define (line-indent line)
|
||||
(let ((match (string-match "^ *" line)))
|
||||
(if match
|
||||
(match:end match) ; Anzahl der Leerzeichen = Position nach Leerzeichen
|
||||
0))) ; Falls kein Match → 0
|
||||
(define (item-indent item) (car item))
|
||||
(define (item-content item) (cdr item))
|
||||
|
||||
;; Kommentar entfernen
|
||||
(define (strip-comment line)
|
||||
(let ((m (string-match "#.*" line)))
|
||||
(if m
|
||||
(string-trim-right (string-take line (match:start m)))
|
||||
line)))
|
||||
;; --- Skalare ----------------------------------------------------------
|
||||
|
||||
;; Hilfsfunktion: Whitespace entfernen
|
||||
(define (clean-line line)
|
||||
(string-trim (strip-comment line)))
|
||||
;; Position des schließenden Double-Quotes ab start (oder #f);
|
||||
;; Backslash escaped das Folgezeichen.
|
||||
(define (closing-double-quote s start)
|
||||
(let loop ((i start))
|
||||
(cond ((>= i (string-length s)) #f)
|
||||
((char=? (string-ref s i) #\\) (loop (+ i 2)))
|
||||
((char=? (string-ref s i) #\") i)
|
||||
(else (loop (+ i 1))))))
|
||||
|
||||
;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
|
||||
(define (blank-or-comment? line)
|
||||
(string-null? (clean-line line)))
|
||||
;; Position des schließenden Single-Quotes ab start (oder #f);
|
||||
;; '' ist ein escaptes Quote.
|
||||
(define (closing-single-quote s start)
|
||||
(let loop ((i start))
|
||||
(cond ((>= i (string-length s)) #f)
|
||||
((char=? (string-ref s i) #\')
|
||||
(if (and (< (+ i 1) (string-length s))
|
||||
(char=? (string-ref s (+ i 1)) #\'))
|
||||
(loop (+ i 2))
|
||||
i))
|
||||
(else (loop (+ i 1))))))
|
||||
|
||||
;; Skalare Werte interpretieren
|
||||
;; \\ -> \, \" -> ", \n -> Zeilenumbruch
|
||||
(define (unescape-double s)
|
||||
(let loop ((chars (string->list s)) (acc '()))
|
||||
(cond ((null? chars) (list->string (reverse acc)))
|
||||
((and (char=? (car chars) #\\) (pair? (cdr chars)))
|
||||
(loop (cddr chars)
|
||||
(cons (if (char=? (cadr chars) #\n)
|
||||
#\newline
|
||||
(cadr chars))
|
||||
acc)))
|
||||
(else (loop (cdr chars) (cons (car chars) acc))))))
|
||||
|
||||
;; '' -> '
|
||||
(define (unescape-single s)
|
||||
(regexp-substitute/global #f "''" s 'pre "'" 'post))
|
||||
|
||||
;; Kommentar in einem unquoted Wert entfernen:
|
||||
;; # zählt nur am Anfang oder nach Leerzeichen
|
||||
(define (strip-plain-comment s)
|
||||
(let loop ((i 0))
|
||||
(cond ((>= i (string-length s)) s)
|
||||
((and (char=? (string-ref s i) #\#)
|
||||
(or (zero? i)
|
||||
(char-whitespace? (string-ref s (- i 1)))))
|
||||
(string-take s i))
|
||||
(else (loop (+ i 1))))))
|
||||
|
||||
;; Unquoted/single-quoted Werte interpretieren
|
||||
(define (interpret-plain s)
|
||||
(cond
|
||||
((member s '("{}" "[]" "null")) '())
|
||||
((string=? s "true") #t)
|
||||
((string=? s "false") #f)
|
||||
((string-match "^-?[0-9]+(\\.[0-9]+)?$" s) (string->number s))
|
||||
(else s)))
|
||||
|
||||
;; Skalar parsen; Rest hinter einem schließenden Quote wird ignoriert
|
||||
;; (darf nur ein Kommentar sein)
|
||||
(define (parse-scalar str)
|
||||
(define (strip-quotes s)
|
||||
(let ((s (string-trim-both str)))
|
||||
(cond
|
||||
((and (string-prefix? "\"" s) (string-suffix? "\"" s))
|
||||
(string-drop-right (string-drop s 1) 1))
|
||||
((and (string-prefix? "'" s) (string-suffix? "'" s))
|
||||
(string-drop-right (string-drop s 1) 1))
|
||||
(else s)))
|
||||
(let ((s (strip-quotes (string-trim str))))
|
||||
((string-null? s) "")
|
||||
((char=? (string-ref s 0) #\")
|
||||
(let ((end (closing-double-quote s 1)))
|
||||
(if end
|
||||
(unescape-double (substring s 1 end))
|
||||
(string-trim-right (strip-plain-comment s)))))
|
||||
((char=? (string-ref s 0) #\')
|
||||
(let ((end (closing-single-quote s 1)))
|
||||
(if end
|
||||
(interpret-plain (unescape-single (substring s 1 end)))
|
||||
(string-trim-right (strip-plain-comment s)))))
|
||||
(else
|
||||
(interpret-plain (string-trim-right (strip-plain-comment s)))))))
|
||||
|
||||
;; --- Struktur ----------------------------------------------------------
|
||||
|
||||
;; Erste Key-Trennstelle: ":" am Zeilenende oder gefolgt von Leerzeichen.
|
||||
;; Beginnt die Zeile mit einem gequoteten Key (oder Skalar), zaehlt ein
|
||||
;; ":" innerhalb der Quotes nicht als Trennstelle.
|
||||
(define (key-split-index s)
|
||||
(let ((start (if (string-null? s)
|
||||
0
|
||||
(case (string-ref s 0)
|
||||
((#\") (let ((end (closing-double-quote s 1)))
|
||||
(if end (+ end 1) 0)))
|
||||
((#\') (let ((end (closing-single-quote s 1)))
|
||||
(if end (+ end 1) 0)))
|
||||
(else 0)))))
|
||||
(let loop ((i start))
|
||||
(cond ((>= i (string-length s)) #f)
|
||||
((and (char=? (string-ref s i) #\:)
|
||||
(or (= i (- (string-length s) 1))
|
||||
(char=? (string-ref s (+ i 1)) #\space)))
|
||||
i)
|
||||
(else (loop (+ i 1)))))))
|
||||
|
||||
;; Key interpretieren: gequotete Keys werden entquotet (Strings bleiben
|
||||
;; Strings), unquoted Keys bleiben unveraendert
|
||||
(define (parse-key s)
|
||||
(let ((k (string-trim-both s)))
|
||||
(cond
|
||||
((string=? s "{}") '()) ;; leere Map
|
||||
((string=? s "[]") '()) ;; leere Liste
|
||||
((string-match "^[0-9]+$" s) (string->number s))
|
||||
((string=? s "true") #t)
|
||||
((string=? s "false") #f)
|
||||
((string=? s "null") '())
|
||||
(else s))))
|
||||
((string-null? k) k)
|
||||
((char=? (string-ref k 0) #\")
|
||||
(let ((end (closing-double-quote k 1)))
|
||||
(if end (unescape-double (substring k 1 end)) k)))
|
||||
((char=? (string-ref k 0) #\')
|
||||
(let ((end (closing-single-quote k 1)))
|
||||
(if end (unescape-single (substring k 1 end)) k)))
|
||||
(else k))))
|
||||
|
||||
(define (dash-line? content)
|
||||
(or (string=? content "-") (string-prefix? "- " content)))
|
||||
|
||||
;; Hilfsfunktion: Zeilen mit gleicher oder höherer Einrückung sammeln
|
||||
(define (take-indented lines min-indent)
|
||||
(let loop ((ls lines) (acc '()))
|
||||
(if (null? ls)
|
||||
(reverse acc)
|
||||
(let ((line (car ls)))
|
||||
(if (or (blank-or-comment? line)
|
||||
(>= (line-indent line) min-indent))
|
||||
(loop (cdr ls) (cons line acc))
|
||||
(reverse acc))))))
|
||||
;; Wert-String hinter "key:" bzw. "-": reiner Kommentar zählt als leer
|
||||
(define (effective-value str)
|
||||
(let ((s (string-trim-both str)))
|
||||
(if (string-prefix? "#" s) "" s)))
|
||||
|
||||
;; Hilfsfunktion: N Zeilen überspringen
|
||||
(define (drop lst n)
|
||||
(let loop ((l lst) (i n))
|
||||
(if (or (zero? i) (null? l))
|
||||
l
|
||||
(loop (cdr l) (- i 1)))))
|
||||
;; Einen Block von Items parsen; das erste Item bestimmt die Blockart
|
||||
(define (parse-block items)
|
||||
(cond
|
||||
((null? items) '())
|
||||
((dash-line? (item-content (car items))) (parse-list items))
|
||||
;; einzelne Zeile ohne Key: Skalar (z.B. eine Datei, die nur {} enthält)
|
||||
((and (null? (cdr items))
|
||||
(not (key-split-index (item-content (car items)))))
|
||||
(parse-scalar (item-content (car items))))
|
||||
(else (parse-map items))))
|
||||
|
||||
;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
|
||||
(define (parse-list lines current-indent)
|
||||
(let loop ((ls lines) (result '()))
|
||||
(if (null? ls)
|
||||
(reverse result)
|
||||
(let* ((line (clean-line (car ls))))
|
||||
(if (string-match "^-" line)
|
||||
(let* ((indent (line-indent (car ls)))
|
||||
(item-str (string-trim (string-drop line 1)))
|
||||
(next-lines (cdr ls)))
|
||||
(if (or (null? next-lines)
|
||||
(> (line-indent (car next-lines)) indent))
|
||||
;; Verschachtelter Inhalt
|
||||
(let* ((sub (take-indented next-lines (+ indent 2)))
|
||||
(parsed (if (null? sub)
|
||||
(parse-scalar item-str)
|
||||
(parse-lines sub (+ indent 2))))
|
||||
(remaining (drop next-lines (length sub))))
|
||||
(loop remaining (cons parsed result)))
|
||||
;; Einfacher Skalar
|
||||
(loop next-lines (cons (parse-scalar item-str) result))))
|
||||
;; Nicht mehr Teil der Liste
|
||||
(reverse result))))))
|
||||
;; Mapping: alle Items auf map-indent sind Keys, tiefer eingerückte
|
||||
;; Items gehören zum jeweils vorangehenden Key
|
||||
(define (parse-map items)
|
||||
(let ((map-indent (item-indent (car items))))
|
||||
(let loop ((items items) (result '()))
|
||||
(if (null? items)
|
||||
(reverse result)
|
||||
(let* ((content (item-content (car items)))
|
||||
(split (key-split-index content)))
|
||||
(if (not split)
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"YAML-Syntaxfehler: Ungültige Zeile: ~a\n" content)
|
||||
(loop (cdr items) result))
|
||||
(let ((key (parse-key (string-take content split)))
|
||||
(value-str (effective-value
|
||||
(string-drop content (+ split 1)))))
|
||||
(if (string-null? value-str)
|
||||
;; Wert steht im eingerückten Block darunter
|
||||
(receive (children rest)
|
||||
(span (lambda (it) (> (item-indent it) map-indent))
|
||||
(cdr items))
|
||||
(loop rest
|
||||
(cons (cons key (parse-block children))
|
||||
result)))
|
||||
(loop (cdr items)
|
||||
(cons (cons key (parse-scalar value-str))
|
||||
result))))))))))
|
||||
|
||||
;; Hauptparser für Key-Value oder Listen
|
||||
(define (parse-lines lines current-indent)
|
||||
(let loop ((ls lines) (result '()))
|
||||
(if (null? ls)
|
||||
(reverse result)
|
||||
(let* ((raw-line (car ls))
|
||||
(line (clean-line raw-line)))
|
||||
(cond
|
||||
;; Kommentar oder leere Zeile
|
||||
((blank-or-comment? raw-line)
|
||||
(loop (cdr ls) result))
|
||||
;; Liste: "- wert", "- key: value" (Inline-Mapping) oder "-" mit
|
||||
;; eingerücktem Block darunter
|
||||
(define (parse-list items)
|
||||
(let ((list-indent (item-indent (car items))))
|
||||
(let loop ((items items) (result '()))
|
||||
(if (null? items)
|
||||
(reverse result)
|
||||
(let ((content (item-content (car items))))
|
||||
(if (not (dash-line? content))
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"YAML-Syntaxfehler: Ungültiges Listenelement: ~a\n"
|
||||
content)
|
||||
(loop (cdr items) result))
|
||||
(receive (children rest)
|
||||
(span (lambda (it) (> (item-indent it) list-indent))
|
||||
(cdr items))
|
||||
(let* ((after-dash (string-drop content 1))
|
||||
(inline (effective-value after-dash)))
|
||||
(cond
|
||||
((and (string-null? inline) (null? children))
|
||||
(loop rest (cons '() result)))
|
||||
((string-null? inline)
|
||||
(loop rest (cons (parse-block children) result)))
|
||||
(else
|
||||
;; Inline-Inhalt: als synthetisches Item mit der
|
||||
;; Spalte des Inhalts vor die Kinder stellen, so
|
||||
;; funktioniert auch "- key: value" mit weiteren
|
||||
;; Keys auf den Folgezeilen
|
||||
(let* ((offset (- (string-length content)
|
||||
(string-length
|
||||
(string-trim after-dash))))
|
||||
(synth (cons (+ list-indent offset) inline)))
|
||||
(loop rest
|
||||
(cons (parse-block (cons synth children))
|
||||
result)))))))))))))
|
||||
|
||||
;; Liste
|
||||
((string-match "^- " line)
|
||||
(let ((list-lines (take-indented ls current-indent)))
|
||||
(let ((parsed-list (parse-list list-lines current-indent)))
|
||||
(loop (drop ls (length list-lines))
|
||||
(cons parsed-list result)))))
|
||||
|
||||
;; Key: Value
|
||||
((string-match "^[^:]+:" line)
|
||||
(let* ((kv (string-split line #\:))
|
||||
(key (string-trim (car kv)))
|
||||
(value-str (string-trim (string-join (cdr kv) ":")))
|
||||
(next-lines (cdr ls)))
|
||||
(if (string-null? value-str)
|
||||
;; Wert auf nachfolgender Einrückungsebene
|
||||
(let* ((sub (take-indented next-lines (+ current-indent 2)))
|
||||
(parsed (parse-lines sub (+ current-indent 2)))
|
||||
(remaining (drop next-lines (length sub))))
|
||||
(loop remaining
|
||||
(cons (cons key parsed) result)))
|
||||
;; Einfacher Key:Value
|
||||
(loop next-lines
|
||||
(cons (cons key (parse-scalar value-str)) result)))))
|
||||
|
||||
;; Fehlerhafte Zeile
|
||||
(else
|
||||
;; Vermeide Fehlermeldung für Leerzeilen oder leere Objekte
|
||||
(if (or (string-null? (string-trim line))
|
||||
(member line '("{}" "[]")))
|
||||
(loop (cdr ls) result)
|
||||
(begin
|
||||
(format (current-error-port)
|
||||
"Syntaxfehler: Ungültige Zeile: ~a\n" raw-line)
|
||||
(loop (cdr ls) result))))
|
||||
)))))
|
||||
|
||||
(let ((lines (read-lines filename)))
|
||||
(parse-lines lines 0)))
|
||||
(parse-block (read-items filename)))
|
||||
|
||||
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
|
||||
|
||||
Reference in New Issue
Block a user