#!/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 (read-csv port)
  "Read from port into a peg:tree."
  (let* ((rawstr (read-delimited "" port))
         (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)
  "Get data from field-part cells"
  (if (symbol? part)
      #f
      (begin
        (ensure-symbol (car part) 'field-part)
        (cadr part))))



(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))

;; ('line ('field ('field-part data) ...) ...)
;; -> ({(data ...) | data} ...)
(define (clean-peg-tree tree)
  "Clean up input from read-csv, returns a more bare bones tree"
  (map (lambda (line) ; for every line
         (ensure-symbol (car line) 'line)
         (map (lambda (field) ; for every field in line
                (and (not (symbol? field)) ; if a symbol no data is present
                     ;; else extract the data
                     (begin (ensure-symbol (car field) 'field)
                            (flatten-1 (map get-part-data (cdr field))))))
              (cdr line)))
       tree))

;;; Takes (car (clean-peg-tree csv)) 
;;; name is a string
;;; returns a record-type, a constructor, a predicate procedure,
;;; and an association list of getters
(define (create-csv-record name field-strings)
  "Creates datatypes from csv records"
  (let ((full-name (string-append "csv:" name))
        (fields (map string->symbol field-strings)))
    (let* ((record-type (make-record-type full-name fields))
           (make-record (record-constructor record-type fields))
           (predicate (record-predicate record-type))
           (accessors (map cons fields
                           (map (cut record-accessor record-type <>)
                                fields))))
      (values record-type make-record predicate accessors))))

(define (strip-extension filename)
  "TODO remove the extension from a filename"
  filename)

(define (call-with-csv csv-file-name proc)
  (let* ((csv (call-with-input-file csv-file-name read-csv))
         (tree (clean-peg-tree csv))
         (fields (car tree))
         (data (cdr tree)))
    (receive (record-type constructor predicate getters)
        (create-csv-record (strip-extension
                            (basename csv-file-name))
                           fields)
      (proc record-type constructor predicate getters
            (map (cut apply make-book <>)
                 data)))))


(define (main args)
  (call-with-csv "boklista.csv"
                 (lambda (book make-book book? accessors data)
                   (let ((get-name (assoc-ref accessors 'name)))
                     (for-each (lambda (book)
                                 (format #t "~s~%" (get-name book)))
                               data)))))