Added (csv->sxml), also added custom record naming

master
Brady McDonough 5 years ago
parent cbfe15dd0a
commit c2b8ee9262

@ -23,7 +23,7 @@
(define-module (csv csv) (define-module (csv csv)
#:use-module (ice-9 optargs) #:use-module (ice-9 optargs)
#:use-module (sxml simple) #:use-module (sxml simple)
#:export (make-csv-reader csv->xml sxml->csv csv-write)) #:export (make-csv-reader csv->xml csv->sxml sxml->csv csv-write))
;;; FIXME: rewrite with some kind of parser generator? functional, of ;;; FIXME: rewrite with some kind of parser generator? functional, of
;;; course :-) Based on code from Ken Anderson <kanderson bbn com>, from ;;; course :-) Based on code from Ken Anderson <kanderson bbn com>, from
@ -79,7 +79,10 @@
(csv-read port delimiter new-row have-cell have-row init-seed)))) (csv-read port delimiter new-row have-cell have-row init-seed))))
;; read csv file and convert to sxml ;; read csv file and convert to sxml
(define* (csv->xml port #:key (delimiter #\,)) (define* (csv->sxml port
#:key
(delimiter #\,)
(record-sym (lambda(n)(format #f "record-~a" n))))
(define reader (make-csv-reader delimiter (define reader (make-csv-reader delimiter
#:have-row (lambda (row rows) #:have-row (lambda (row rows)
(cons (reverse row) rows)))) (cons (reverse row) rows))))
@ -87,13 +90,32 @@
(header (map string->symbol (car csv))) (header (map string->symbol (car csv)))
(contents (cdr csv))) (contents (cdr csv)))
(let lp((rest contents) (result '()) (n 1)) (let lp((rest contents) (result '()) (n 1))
(cond (cond
((null? rest)
(reverse result))
(else
(let* ((line (map list header (car rest)))
(r (string->symbol (record-sym n))))
(lp (cdr rest) (cons (list r line) result) (1+ n))))))))
(define* (csv->xml port
#:key
(delimiter #\,)
(record-sym (lambda (n) (format #f "record-~a" n))))
(define reader (make-csv-reader delimiter
#:have-row (lambda (row rows)
(cons (reverse row) rows))))
(let* ((csv (reader port))
(header (map string->symbol (car csv)))
(contents (cdr csv)))
(let lp((rest contents) (result '()) (n 1))
(cond
((null? rest) ((null? rest)
(call-with-output-string (lambda (p) (call-with-output-string (lambda (p)
(sxml->xml (reverse result) p)))) (sxml->xml (reverse result) p))))
(else (else
(let* ((line (map list header (car rest))) (let* ((line (map list header (car rest)))
(r (string->symbol (format #f "record-~a" n)))) (r (string->symbol (record-sym n))))
(lp (cdr rest) (cons (list r line) result) (1+ n)))))))) (lp (cdr rest) (cons (list r line) result) (1+ n))))))))
(define* (sxml->csv sxml port #:key (delimiter #\,)) (define* (sxml->csv sxml port #:key (delimiter #\,))
@ -102,5 +124,3 @@
(for-each (lambda (l) (for-each (lambda (l)
(format port "~a~%" l)) (format port "~a~%" l))
csv))) csv)))
(define csv-write sxml->csv)

Loading…
Cancel
Save