#!/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)))))