1 files changed, 103 insertions, 0 deletions
diff --git a/parse.scm b/parse.scm
new file mode 100755
index 0000000..8c8287a
--- /dev/null
+++ b/parse.scm
@@ -0,0 +1,103 @@
+#!/usr/bin/guile \
+-e main -s
+!#
+
+(add-to-load-path (dirname (current-filename)))
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-8)
+             (srfi srfi-9)
+             (srfi srfi-26)
+
+             (ice-9 rdelim)
+             (ice-9 peg)
+
+             (patterns))
+
+
+;; var is the field to test
+;; symb is the expected value
+(define-syntax-rule (ensure-symbol var symb)
+  (unless (eqv? var symb)
+    (throw 'symbol-not-equal "Expected ~s, got ~s~%" symb var)))
+
+(define (load-csv filename)
+  (with-input-from-file filename
+    (lambda ()
+      (let* ((rawstr (read-delimited ""))
+             (match (match-pattern file rawstr))
+             (tree (keyword-flatten '(line)
+                                    (peg:tree match))))
+        tree))))
+
+;;; TODO sometimes part is a symbol instead of a list,
+;;; somehow an earlier part got consed on? or something?
+(define (get-part-data part)
+  (if (symbol? part)
+      (format #t "ERR: ~s~%" part)
+      (begin
+        (ensure-symbol (car part) 'field-part)
+        (cadr part))))
+
+;; ('line ('field ('field-part data) ...) ...) -> ({(data ...) | data} ...)
+(define (clean-peg-tree tree)
+  (map (lambda (line)
+         (ensure-symbol (car line) 'line)
+         (let ((fields (cdr line)))
+           (map (lambda (field)
+                  (if (symbol? field)
+                      #f
+                      (begin (ensure-symbol (car field) 'field)
+                             (map get-part-data (cdr field)))))
+                fields)))
+       tree))
+
+;; record-name should be a symbol
+(define (create-csv-type record-name first-line)
+  (let ((strname (string-append
+                  "csv:"
+                  (symbol->string record-name)))
+        (l (car first-line))
+        (rawfields (cdr first-line)))
+    (ensure-symbol l 'line)
+    (let ((fields
+           (map (lambda (field)
+                  (ensure-symbol (car field) 'field)
+                  (let ((rest (cadr field)))
+                    (ensure-symbol (car rest) 'field-part)
+                    (string->symbol (cadr rest))))
+                rawfields)))
+      (let* ((record-type (make-record-type strname fields))
+             (make-record (record-constructor record-type fields))
+             (predicate record-type))
+        (values record-type make-record predicate)))))
+
+
+(define (flatten-1 lst)
+  "If list is of length one return the first element,
+otherwise return the full list"
+  (if (= 1 (length lst))
+      (car lst)
+      lst))
+
+(define (get-db filename)
+  (let ((doc (load-csv filename)))
+    (receive (book make-book book?)
+        (create-csv-type 'book (car doc))
+      (map (lambda (line) ; returns a record
+             (ensure-symbol (car line) 'line)
+             (apply make-book
+                    (map (lambda (field) ; returns a list or #f
+                           (if (symbol? field)
+                               #f
+                               (begin
+                                 (ensure-symbol (car field) 'field)
+                                 (flatten-1
+                                  (map (lambda (part) ; returns [string]
+                                         (ensure-symbol (car part) 'field-part)
+                                         (cadr part))
+                                       (cdr field)))))
+                           #; (cadr field)
+                           )
+                         (cdr line))))
+           (cdr doc)))))