blob: c17da40cc8c03f056bcd837d2eae77580935e4d8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
#!/usr/bin/guile \
-e main -s
!#
(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)
(srfi srfi-9)
(srfi srfi-26)
(ice-9 rdelim)
(ice-9 peg)
(patterns)
(macros arrow))
;; 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))
(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)))
|
