|
|
|
@@ -1,10 +1,7 @@
|
|
|
|
|
(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)
|
|
|
|
|
;; Utility: Zeile einlesen
|
|
|
|
|
(define (read-lines filename)
|
|
|
|
|
(call-with-input-file filename
|
|
|
|
|
(lambda (port)
|
|
|
|
|
(let loop ((lines '()))
|
|
|
|
@@ -16,30 +13,30 @@
|
|
|
|
|
(loop lines) ;; Ignoriere "---" oder leere Zeile
|
|
|
|
|
(loop (cons line lines))))))))))
|
|
|
|
|
|
|
|
|
|
;; Einrückung bestimmen (Anzahl Leerzeichen am Anfang)
|
|
|
|
|
(define (line-indent line)
|
|
|
|
|
;; 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)
|
|
|
|
|
;; 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)
|
|
|
|
|
;; 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)
|
|
|
|
|
;; 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)
|
|
|
|
|
;; Skalare Werte interpretieren
|
|
|
|
|
(define (parse-scalar str)
|
|
|
|
|
(define (strip-quotes s)
|
|
|
|
|
(cond
|
|
|
|
|
((and (string-prefix? "\"" s) (string-suffix? "\"" s))
|
|
|
|
@@ -57,9 +54,13 @@
|
|
|
|
|
((string=? s "null") '())
|
|
|
|
|
(else s))))
|
|
|
|
|
|
|
|
|
|
;; Hauptparsingfunktion
|
|
|
|
|
(define (yml-file->scm filename)
|
|
|
|
|
(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)
|
|
|
|
|
;; 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)
|
|
|
|
@@ -69,15 +70,15 @@
|
|
|
|
|
(loop (cdr ls) (cons line acc))
|
|
|
|
|
(reverse acc))))))
|
|
|
|
|
|
|
|
|
|
;; Hilfsfunktion: N Zeilen überspringen
|
|
|
|
|
(define (drop lst n)
|
|
|
|
|
;; 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)
|
|
|
|
|
;; Listenparsing: Liest Zeilen mit `-` als Listeneinträge
|
|
|
|
|
(define (parse-list lines current-indent)
|
|
|
|
|
(let loop ((ls lines) (result '()))
|
|
|
|
|
(if (null? ls)
|
|
|
|
|
(reverse result)
|
|
|
|
@@ -100,8 +101,8 @@
|
|
|
|
|
;; Nicht mehr Teil der Liste
|
|
|
|
|
(reverse result))))))
|
|
|
|
|
|
|
|
|
|
;; Hauptparser für Key-Value oder Listen
|
|
|
|
|
(define (parse-lines lines current-indent)
|
|
|
|
|
;; Hauptparser für Key-Value oder Listen
|
|
|
|
|
(define (parse-lines lines current-indent)
|
|
|
|
|
(let loop ((ls lines) (result '()))
|
|
|
|
|
(if (null? ls)
|
|
|
|
|
(reverse result)
|
|
|
|
@@ -148,7 +149,4 @@
|
|
|
|
|
(loop (cdr ls) result))))
|
|
|
|
|
)))))
|
|
|
|
|
|
|
|
|
|
(let ((lines (read-lines filename)))
|
|
|
|
|
(parse-lines lines 0)))
|
|
|
|
|
|
|
|
|
|
(define (parse-yml-file filename) (resolve-inherits (yml-file->scm filename)))
|
|
|
|
|