From 532f42bb007a5a2d628ab9b89887bbb28b50cb7d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Wed, 24 Oct 2018 13:33:08 +0200
Subject: Replace dynammic record type creation with csv-type.

---
 parse.scm | 85 ++++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 43 insertions(+), 42 deletions(-)

diff --git a/parse.scm b/parse.scm
index 5451fc9..c17da40 100755
--- a/parse.scm
+++ b/parse.scm
@@ -3,6 +3,8 @@
 !#
 
 (add-to-load-path (dirname (current-filename)))
+(add-to-load-path (string-append (getenv "HOME")
+                                 "/lib/guile"))
 
 (use-modules (srfi srfi-1)
              (srfi srfi-8)
@@ -12,7 +14,8 @@
              (ice-9 rdelim)
              (ice-9 peg)
 
-             (patterns))
+             (patterns)
+             (macros arrow))
 
 
 ;; var is the field to test
@@ -62,44 +65,42 @@ otherwise return the full list"
               (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)))))
+(define-record-type csv
+  (make-csv data)
+  csv?
+  (data get-data))
+
+(use-modules (srfi srfi-9 gnu))
+(define (csv-printer record port)
+  (format port "#<csv data ...>"))
+(set-record-type-printer! csv csv-printer)
+
+(define (tree->vector tree)
+  (let ((fields (map string->symbol (car tree)))
+        (data (cdr tree)))
+    (list->vector
+     ;; TODO this assoc list ought to be a hash map
+     (map (cut map cons fields <>) data))))
+
+;;; This creates some form of weird object 
+(define (load-csv filename)
+  (-> (call-with-input-file filename read-csv)
+      clean-peg-tree
+      tree->vector
+      make-csv))
+
+(define-syntax-rule (ensure-csv csv)
+ (unless (csv? csv)
+    (throw 'type-error "Expected csv, got something else~%")))
+
+;;; TODO (csv? <csv-object>) sometimes returns false.
+
+(define (csv-ref csv key row)
+  #; (ensure-csv csv)
+  (assoc-ref (vector-ref (get-data csv) row)
+             key))
+
+(define (csv-length csv)
+  #; (ensure-csv csv)
+  (vector-length (get-data csv)))
+
-- 
cgit v1.2.3