diff options
-rwxr-xr-x | parse.scm | 113 |
1 files changed, 51 insertions, 62 deletions
@@ -21,56 +21,24 @@ (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)))) +(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) - (format #t "ERR: ~s~%" part) + #f (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) @@ -80,24 +48,45 @@ otherwise return the full list" (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))))) +;; ('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)))) + +;;; filename -> [book] +(define (load-data csv-file-name) + (let* ((csv (call-with-input-file csv-file-name read-csv)) + (tree (clean-peg-tree csv)) + (fields (car tree)) + (data (cdr tree))) + (receive (book make-book book? book-getters) + (create-csv-record "book" fields) + (map (cut apply make-book <>) + data)))) + + |