|
|
|
@@ -1,154 +1,152 @@
|
|
|
|
|
(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1))
|
|
|
|
|
|
|
|
|
|
;; Utility: Zeile einlesen
|
|
|
|
|
(define (read-lines filename)
|
|
|
|
|
(call-with-input-file filename
|
|
|
|
|
(lambda (port)
|
|
|
|
|
(let loop ((lines '()))
|
|
|
|
|
(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))))))))))
|
|
|
|
|
|
|
|
|
|
;; 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
|
|
|
|
|
|
|
|
|
|
;; Kommentar entfernen
|
|
|
|
|
(define (strip-comment line)
|
|
|
|
|
(let ((m (string-match "#.*" line)))
|
|
|
|
|
(if m
|
|
|
|
|
(string-trim-right (string-take line (match:start m)))
|
|
|
|
|
line)))
|
|
|
|
|
|
|
|
|
|
;; Hilfsfunktion: Whitespace entfernen
|
|
|
|
|
(define (clean-line line)
|
|
|
|
|
(string-trim (strip-comment line)))
|
|
|
|
|
|
|
|
|
|
;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
|
|
|
|
|
(define (blank-or-comment? line)
|
|
|
|
|
(string-null? (clean-line line)))
|
|
|
|
|
|
|
|
|
|
;; Skalare Werte interpretieren
|
|
|
|
|
(define (parse-scalar str)
|
|
|
|
|
(define (strip-quotes s)
|
|
|
|
|
(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))))
|
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
;; Hauptparsingfunktion
|
|
|
|
|
(define (yml-file->scm filename)
|
|
|
|
|
|
|
|
|
|
;; Utility: Zeile einlesen
|
|
|
|
|
(define (read-lines filename)
|
|
|
|
|
(call-with-input-file filename
|
|
|
|
|
(lambda (port)
|
|
|
|
|
(let loop ((lines '()))
|
|
|
|
|
(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))))))))))
|
|
|
|
|
|
|
|
|
|
;; 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
|
|
|
|
|
|
|
|
|
|
;; Kommentar entfernen
|
|
|
|
|
(define (strip-comment line)
|
|
|
|
|
(let ((m (string-match "#.*" line)))
|
|
|
|
|
(if m
|
|
|
|
|
(string-trim-right (string-take line (match:start m)))
|
|
|
|
|
line)))
|
|
|
|
|
|
|
|
|
|
;; Hilfsfunktion: Whitespace entfernen
|
|
|
|
|
(define (clean-line line)
|
|
|
|
|
(string-trim (strip-comment line)))
|
|
|
|
|
|
|
|
|
|
;; Ist Zeile leer (nach Entfernen von Kommentar & Whitespace)?
|
|
|
|
|
(define (blank-or-comment? line)
|
|
|
|
|
(string-null? (clean-line line)))
|
|
|
|
|
|
|
|
|
|
;; Skalare Werte interpretieren
|
|
|
|
|
(define (parse-scalar str)
|
|
|
|
|
(define (strip-quotes s)
|
|
|
|
|
(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))))
|
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; 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))))))
|
|
|
|
|
|
|
|
|
|
;; 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)))))
|
|
|
|
|
|
|
|
|
|
;; 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))))))
|
|
|
|
|
|
|
|
|
|
;; 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
|
|
|
|
|
((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)))
|
|
|
|
|
|
|
|
|
|
;; 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))))))
|
|
|
|
|
|
|
|
|
|
;; 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)))))
|
|
|
|
|
|
|
|
|
|
;; 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))))))
|
|
|
|
|
|
|
|
|
|
;; 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
|
|
|
|
|
((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))))
|
|
|
|
|
)))))
|
|
|
|
|
|
|
|
|
|
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
|
|
|
|
|