diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2018-10-24 13:33:08 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2018-10-24 13:33:08 +0200 |
commit | 532f42bb007a5a2d628ab9b89887bbb28b50cb7d (patch) | |
tree | 0a6a5ec00eac6fdc87b9ed4fb6f44443af36f5ca | |
parent | Add call-with-csv, and a main. (diff) | |
download | lyslib-532f42bb007a5a2d628ab9b89887bbb28b50cb7d.tar.gz lyslib-532f42bb007a5a2d628ab9b89887bbb28b50cb7d.tar.xz |
Replace dynammic record type creation with csv-type.
-rwxr-xr-x | parse.scm | 85 |
1 files changed, 43 insertions, 42 deletions
@@ -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))) + |