Compare commits
No commits in common. 'master' and 'guix-package' have entirely different histories.
master
...
guix-packa
@ -1,5 +0,0 @@
|
||||
.#*
|
||||
*~
|
||||
,*
|
||||
*.go
|
||||
version.scm
|
||||
@ -1,3 +1,3 @@
|
||||
This csv reader is originally wrote by Andy Wingo <wingo at pobox dot com>
|
||||
Modified and maintained by Nala Ginrut <nalaginrut@gmail.com>
|
||||
Further modified for use by Brady McDonough <echo bWVAYnJhZHltY2QuY2EK | base64 -d>
|
||||
Further modified for use by Brady McDonough <me@bradymcd.ca>
|
||||
|
||||
@ -1,29 +0,0 @@
|
||||
TARGET := $(shell guile -c "(display (%site-dir))")
|
||||
CCACHE := $(shell guile -c "(display(%site-ccache-dir))")
|
||||
OBJ := csv.go
|
||||
|
||||
.PHONY: all clean install uninstall
|
||||
all: $(OBJ)
|
||||
|
||||
%.go: csv2/%.scm
|
||||
@GUILE_AUTO_COMPILE=0 guild compile $< -o $@
|
||||
|
||||
install: $(TARGET)/csv $(CCACHE)/csv
|
||||
|
||||
$(TARGET)/csv:
|
||||
@echo "Installing source..."
|
||||
cp -fr csv2/ $(TARGET)
|
||||
@echo "Install complete."
|
||||
|
||||
$(CCACHE)/csv:
|
||||
@echo "Installing objects to cache..."
|
||||
mkdir -p $(CCACHE)/csv/
|
||||
cp -fr *.go $(CCACHE)/csv/
|
||||
@echo "Cache complete."
|
||||
|
||||
uninstall:
|
||||
rm -fr $(TARGET)/csv
|
||||
rm -fr $(CCACHE)/csv
|
||||
|
||||
clean:
|
||||
rm -f $(OBJ)
|
||||
@ -1,132 +0,0 @@
|
||||
;; guile-csv
|
||||
;; Copyright (C) 2008, 2012, 2013, 2021
|
||||
;; Andy Wingo <wingo at pobox dot com>
|
||||
;; Nala Ginrut <nalaginrut@gmail.com>
|
||||
;; Brady McDonough
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU Lesser General Public License as
|
||||
;; published by the Free Software Foundation; either version 3 of the
|
||||
;; License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful, but
|
||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;; Lesser General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU Lesser General Public
|
||||
;; License along with this program; if not, contact:
|
||||
;;
|
||||
;; Free Software Foundation, Inc. Voice: +1-617-542-5942
|
||||
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
|
||||
;; Boston, MA 02110-1301, USA gnu@gnu.org
|
||||
|
||||
(define-module (csv csv)
|
||||
#:use-module (ice-9 optargs)
|
||||
#:use-module (sxml simple)
|
||||
#:export (make-csv-reader csv->xml csv->sxml sxml->csv csv-write))
|
||||
|
||||
;;; FIXME: rewrite with some kind of parser generator? functional, of
|
||||
;;; course :-) Based on code from Ken Anderson <kanderson bbn com>, from
|
||||
;;; http://article.gmane.org/gmane.lisp.guile.user/2269.
|
||||
|
||||
(define (csv-read-row port delimiter have-cell init-seed)
|
||||
(define (!)
|
||||
(let ((c (read-char port)))
|
||||
c))
|
||||
(define (finish-cell b seed)
|
||||
(have-cell (list->string (reverse b)) seed))
|
||||
(define (next-cell b seed)
|
||||
(state-finish-cell (!) (finish-cell b seed)))
|
||||
(define (state-init c seed)
|
||||
(cond ((eqv? c delimiter) (state-init (!) (have-cell "" seed)))
|
||||
((eqv? c #\") (state-string (!) '() seed))
|
||||
((eqv? c #\newline) (have-cell "" seed))
|
||||
((eof-object? c) seed)
|
||||
(else (state-any c '() seed))))
|
||||
(define (state-finish-cell c seed)
|
||||
(cond ((eqv? c #\newline) seed)
|
||||
((eof-object? c) seed)
|
||||
(else (state-init c seed))))
|
||||
(define (state-string c b seed)
|
||||
(cond ((eqv? c #\") (state-string-quote (!) b seed))
|
||||
((eof-object? c) (error "Open double-quoted string" (list->string (reverse b))))
|
||||
(else (state-string (!) (cons c b) seed))))
|
||||
(define (state-string-quote c b seed)
|
||||
(cond ((eqv? c #\") (state-string (!) (cons c b) seed)) ; Escaped double quote.
|
||||
((eqv? c delimiter) (next-cell b seed))
|
||||
((eqv? c #\newline) (finish-cell b seed))
|
||||
((eof-object? c) (finish-cell b seed))
|
||||
(else (error "Single double quote at unexpected place." c b))))
|
||||
(define (state-any c b seed)
|
||||
(cond ((eqv? c delimiter) (next-cell b seed))
|
||||
((eqv? c #\newline) (finish-cell b seed))
|
||||
((eof-object? c) (finish-cell b seed))
|
||||
(else (state-any (!) (cons c b) seed))))
|
||||
(state-init (!) init-seed))
|
||||
|
||||
(define (csv-read port delimiter new-row have-cell have-row init-seed)
|
||||
(let lp ((seed init-seed))
|
||||
(cond
|
||||
((eof-object? (peek-char port)) seed)
|
||||
(else (lp (have-row (csv-read-row port delimiter have-cell (new-row seed))
|
||||
seed))))))
|
||||
|
||||
(define* (make-csv-reader delimiter #:key
|
||||
(new-row (lambda (rows) '()))
|
||||
(have-cell (lambda (cell row)
|
||||
(cons cell row)))
|
||||
(have-row (lambda (row rows)
|
||||
(cons (list->vector (reverse row)) rows)))
|
||||
(init-seed '()))
|
||||
(lambda (port)
|
||||
(reverse
|
||||
(csv-read port delimiter new-row have-cell have-row init-seed))))
|
||||
|
||||
;; read csv file and convert to an sxml tree
|
||||
(define* (csv->sxml 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)
|
||||
(cons '*TOP* (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))))))))
|
||||
|
||||
;; read a csv file and convert to a string of XML
|
||||
(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)
|
||||
(call-with-output-string (lambda (p)
|
||||
(sxml->xml (reverse result) p))))
|
||||
(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* (sxml->csv sxml port #:key (delimiter #\,))
|
||||
(let* ((d (string delimiter))
|
||||
(csv (map (lambda (l) (string-join l d)) sxml)))
|
||||
(for-each (lambda (l)
|
||||
(format port "~a~%" l))
|
||||
csv)))
|
||||
@ -0,0 +1,27 @@
|
||||
;; guix package definition
|
||||
(use-modules (guix packages)
|
||||
(guix download)
|
||||
(guix build-system gnu)
|
||||
(guix licenses))
|
||||
|
||||
(define repo-url "https://git.bradymcd.ca/brady/guile-csv/")
|
||||
|
||||
(package
|
||||
(name "guile-csv2")
|
||||
(version "1.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append repo-url
|
||||
"guile-csv-"
|
||||
version
|
||||
".tar.gz"))
|
||||
(sha-256
|
||||
(base-32
|
||||
;; ADD THE HASH
|
||||
))))
|
||||
(build-system gnu-build-system)
|
||||
(synopsis "A version of guile-csv. csv parsing for Guile")
|
||||
(description
|
||||
"This is a package for Guile v3. Previous versions of guile-csv were awkward to use with sxml manipulation tools. This adds convenience for that use case. If you don't want or need to use (pre-post-order) and friends on your data, prefer the original package by Nala Ginrut.")
|
||||
(home-page repo-url)
|
||||
(license lgpl3))
|
||||
Loading…
Reference in new issue