(use-modules (ice-9 rdelim) (ice-9 regex) (ice-9 pretty-print) (srfi srfi-1)) ;; 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))) (define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))