From 0976d04b21679a66041a5b21a8df2604288c8fc4 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Wed, 23 Oct 2024 23:17:03 +0900
Subject: [PATCH] Adding initial CSV library.

---
 lib/chibi/csv-test.sld |  72 +++++++++++
 lib/chibi/csv.scm      | 286 +++++++++++++++++++++++++++++++++++++++++
 lib/chibi/csv.sld      |   9 ++
 3 files changed, 367 insertions(+)
 create mode 100644 lib/chibi/csv-test.sld
 create mode 100644 lib/chibi/csv.scm
 create mode 100644 lib/chibi/csv.sld

diff --git a/lib/chibi/csv-test.sld b/lib/chibi/csv-test.sld
new file mode 100644
index 00000000..3842667d
--- /dev/null
+++ b/lib/chibi/csv-test.sld
@@ -0,0 +1,72 @@
+
+(define-library (chibi csv-test)
+  (import (scheme base)
+          (srfi 227)
+          (chibi csv)
+          (chibi test))
+  (export run-tests)
+  (begin
+    (define string->csv
+      (opt-lambda (str (reader (csv-read->list)))
+        (reader (open-input-string str))))
+    (define (run-tests)
+      (test-begin "(chibi csv)")
+      (test-assert (eof-object? (string->csv "")))
+      (test '("1997" "Ford" "E350")
+          (string->csv "1997,Ford,E350"))
+      (test '("1997" "Ford" "E350")
+          (string->csv "\n1997,Ford,E350"))
+      (test '(" ")
+          (string->csv " \n1997,Ford,E350"))
+      (test '("" "")
+          (string->csv ",\n1997,Ford,E350"))
+      (test '("1997" "Ford" "E350")
+          (string->csv "\"1997\",\"Ford\",\"E350\""))
+      (test '("1997" "Ford" "E350" "Super, luxurious truck")
+          (string->csv "1997,Ford,E350,\"Super, luxurious truck\""))
+      (test '("1997" "Ford" "E350" "Super, \"luxurious\" truck")
+          (string->csv "1997,Ford,E350,\"Super, \"\"luxurious\"\" truck\""))
+      (test '("1997" "Ford" "E350" "Go get one now\nthey are going fast")
+          (string->csv "1997,Ford,E350,\"Go get one now
+they are going fast\""))
+      (test '("1997" "Ford" "E350")
+          (string->csv
+           "# this is a comment\n1997,Ford,E350"
+           (csv-read->list
+            (csv-parser (csv-grammar '((comment-chars #\#)))))))
+      (test '("1997" "Fo\"rd" "E3\"50")
+          (string->csv "1997\tFo\"rd\tE3\"50"
+                            (csv-read->list (csv-parser default-tsv-grammar))))
+      (test '#("1997" "Ford" "E350")
+          (string->csv "1997,Ford,E350" (csv-read->vector)))
+      (test '#("1997" "Ford" "E350")
+          (string->csv "1997,Ford,E350" (csv-read->fixed-vector 3)))
+      (test-error
+          (string->csv "1997,Ford,E350" (csv-read->fixed-vector 2)))
+      (let ((city-csv "Los Angeles,34°03′N,118°15′W
+New York City,40°42′46″N,74°00′21″W
+Paris,48°51′24″N,2°21′03″E"))
+        (test '(*TOP*
+                (row (col-0 "Los Angeles")
+                     (col-1 "34°03′N")
+                     (col-2 "118°15′W"))
+                (row (col-0 "New York City")
+                     (col-1 "40°42′46″N")
+                     (col-2 "74°00′21″W"))
+                (row (col-0 "Paris")
+                     (col-1 "48°51′24″N")
+                     (col-2 "2°21′03″E")))
+            ((csv->sxml) (open-input-string city-csv)))
+       (test '(*TOP*
+               (city (name "Los Angeles")
+                     (latitude "34°03′N")
+                     (longitude "118°15′W"))
+               (city (name "New York City")
+                     (latitude "40°42′46″N")
+                     (longitude "74°00′21″W"))
+               (city (name "Paris")
+                     (latitude "48°51′24″N")
+                     (longitude "2°21′03″E")))
+           ((csv->sxml 'city '(name latitude longitude))
+            (open-input-string city-csv))))
+      (test-end))))
diff --git a/lib/chibi/csv.scm b/lib/chibi/csv.scm
new file mode 100644
index 00000000..6138d36b
--- /dev/null
+++ b/lib/chibi/csv.scm
@@ -0,0 +1,286 @@
+
+;;> \section{CSV Grammars}
+
+;;> CSV is a simple and compact format for tabular data, which has
+;;> made it popular for a variety of tasks since the early days of
+;;> computing.  Unfortunately, there are many incompatible dialects
+;;> requiring a grammar to specify all of the different options.
+
+(define-record-type Csv-Grammar
+  (make-csv-grammar separator-chars quote-char escape-char record-separator comment-chars)
+  csv-grammar?
+  (separator-chars csv-grammar-separator-chars csv-grammar-separator-chars-set!)
+  (quote-char csv-grammar-quote-char csv-grammar-quote-char-set!)
+  (escape-char csv-grammar-escape-char csv-grammar-escape-char-set!)
+  (record-separator csv-grammar-record-separator csv-grammar-record-separator-set!)
+  (comment-chars csv-grammar-comment-chars csv-grammar-comment-chars-set!))
+
+;; TODO: Consider some minimal low-level parsing options.  In general
+;; this is intended to be performed by the parser, but if we can skip
+;; intermediate string generation (e.g. parsing numbers directly) it
+;; can save a considerable amount of garbage when parsing large files.
+
+;;> Creates a new CSV grammar from the given spec, an alist of symbols
+;;> to values.  The following options are supported:
+;;>
+;;> \itemlist[
+;;> \item{\scheme{'separator-chars} - A non-empty list of characters used to delimit fields, by default \scheme{'(#\,)} (comma-separated).}
+;;> \item{\scheme{'quote-char} - A single character used to quote fields containing special characters, or \scheme{#f} to disable quoting, by default \scheme{#\"} (a double-quote).}
+;;> \item{\scheme{'escape-char} - A single character used to escape characters within quoted fields, or \scheme{#f} to disable escapes, by default \scheme{#\"} (a double-quote).  If this is the same character as the \scheme{quote-char}, then the quote char can be doubled to escape, but no other characters can be escaped.}
+;;> \item{\scheme{'record-separator} - A single character used to delimit the record (row), or one of the symbols \scheme{'cr}, \scheme{'crlf}, \scheme{'lf} or \scheme{'lax}.  These correspond to sequences of carriage return and line feed, or in the case of \scheme{'lax} any of the other three sequences.  Defaults to \scheme{'lax}.}
+;;> \item{\scheme{'comment-chars} - A list of characters which if found at the start of a record indicate it is a comment, discarding all characters through to the next record-separator. Defaults to the empty list (no comments).}
+;;> ]
+(define (csv-grammar spec)
+  (let ((grammar (make-csv-grammar '(#\,) #\" #\" 'lax '())))
+    (for-each
+     (lambda (x)
+       (case (car x)
+         ((separator-chars delimiter)
+          (csv-grammar-separator-chars-set! grammar (cdr x)))
+         ((quote-char)
+          (csv-grammar-quote-char-set! grammar (cdr x)))
+         ((escape-char)
+          (csv-grammar-escape-char-set! grammar (cdr x)))
+         ((record-separator newline-type)
+          (let ((rec-sep
+                 (case (cdr x)
+                   ((crlf lax) (cdr x))
+                   ((cr) #\return)
+                   ((lf) #\newline)
+                   (else
+                    (if (char? (cdr x))
+                        (cdr x)
+                        (error "invalid record-separator, expected a char or one of 'lax or 'crlf" (cdr x)))))))
+            (csv-grammar-escape-char-set! grammar (cdr x))))
+         ((comment-chars)
+          (csv-grammar-comment-chars-set! grammar (cdr x)))
+         (else
+          (error "unknown csv-grammar spec" x))))
+     spec)
+    grammar))
+
+;;> The default CSV grammar for convenience, with all of the defaults
+;;> from \scheme{csv-grammar}, i.e. comma-delimited with \scheme{#\"}
+;;> for quoting, doubled to escape.
+(define default-csv-grammar
+  (csv-grammar '()))
+
+;;> The default TSV grammar for convenience, splitting fields only on
+;;> tabs, with no quoting or escaping.
+(define default-tsv-grammar
+  (csv-grammar '((separator-chars #\tab) (quote-char . #f) (escape-char . #f))))
+
+;;> \section{CSV Parsers}
+
+;;> Parsers are low-level utilities to perform operations on records a
+;;> field at a time.  You generally want to work with readers, which
+;;> build on this to build records into familiar data structures.
+
+;;> Parsers follow the rules of a grammar to parse a single CSV
+;;> record, possible comprised of multiple fields.  A parser is a
+;;> procedure of three arguments which performs a fold operation over
+;;> the fields of the record. The parser signature is:
+;;> \scheme{(parser kons knil in)}, where \scheme{kons} itself is
+;;> a procedure of three arguments: \scheme{(proc acc index field)}.
+;;> \scheme{proc} is called on each field of the record, in order,
+;;> along with its zero-based \scheme{index} and the accumulated
+;;> result of the last call, starting with \scheme{knil}.
+
+;;> Returns a new CSV parser for the given \var{grammar}.
+(define csv-parser
+  (opt-lambda ((grammar default-csv-grammar))
+    (lambda (kons knil in)
+      (when (pair? (csv-grammar-comment-chars grammar))
+        (let lp ()
+          (when (memv (peek-char in) (csv-grammar-comment-chars grammar))
+            (csv-skip-line in grammar)
+            (lp))))
+      (let lp ((acc knil)
+               (index 0)
+               (out (open-output-string)))
+        (define (finish-row)
+          (let ((field (get-output-string out)))
+            (if (and (zero? index) (equal? field ""))
+                ;; empty row, read again
+                (lp acc index out)
+                (kons acc index field))))
+        (let ((ch (read-char in)))
+          (cond
+           ((eof-object? ch)
+            (let ((field (get-output-string out)))
+              (if (and (zero? index) (equal? field ""))
+                  ;; no data
+                  ch
+                  (kons acc index field))))
+           ((memv ch (csv-grammar-separator-chars grammar))
+            (lp (kons acc index (get-output-string out))
+                (+ index 1)
+                (open-output-string)))
+           ((eqv? ch (csv-grammar-quote-char grammar))
+            ;; TODO: Consider a strict mode to enforce no text
+            ;; before/after the quoted text.
+            (csv-read-quoted in out grammar)
+            (lp acc index out))
+           ((eqv? ch (csv-grammar-record-separator grammar))
+            (finish-row))
+           ((and (eqv? ch #\return)
+                 (memq (csv-grammar-record-separator grammar) '(crlf lax)))
+            (cond
+             ((eqv? (peek-char in) #\newline)
+              (read-char in)
+              (finish-row))
+             ((eq? (csv-grammar-record-separator grammar) 'lax)
+              (finish-row))
+             (else
+              (write-char ch out)
+              (lp acc (+ index 1) out))))
+           ((and (eqv? ch #\newline)
+                 (eq? (csv-grammar-record-separator grammar) 'lax))
+            (finish-row))
+           (else
+            (write-char ch out)
+            (lp acc index out))))))))
+
+(define (csv-skip-line in grammar)
+  (let lp ()
+    (let ((ch (read-char in)))
+      (cond
+       ((eof-object? ch))
+       ((eqv? ch (csv-grammar-record-separator grammar)))
+       ((and (eqv? ch #\newline)
+             (eq? (csv-grammar-record-separator grammar) 'lax)))
+       ((and (eqv? ch #\return)
+             (memq (csv-grammar-record-separator grammar) '(crlf lax)))
+        (cond
+         ((eqv? (peek-char in) #\newline) (read-char in))
+         ((eq? (csv-grammar-record-separator grammar) 'lax))
+         (else (lp))))
+       (else (lp))))))
+
+(define (csv-read-quoted in out grammar)
+  (let lp ()
+    (let ((ch (read-char in)))
+      (cond
+       ((eof-object? ch)
+        (error "unterminated csv quote" (get-output-string out)))
+       ((eqv? ch (csv-grammar-quote-char grammar))
+        (when (and (eqv? ch (csv-grammar-escape-char grammar))
+                   (eqv? ch (peek-char in)))
+          (write-char (read-char in) out)
+          (lp)))
+       ((eqv? ch (csv-grammar-escape-char grammar))
+        (write-char (read-char in) out)
+        (lp))
+       (else
+        ;; TODO: Consider an option to disable newlines in quotes.
+        (write-char ch out)
+        (lp))))))
+
+;;> \section{CSV Readers}
+
+;;> A CSV reader reads a single record, returning some representation
+;;> of it.  You can either loop manually with these or pass them to
+;;> one of the high-level utilities to operate on a whole CSV file at
+;;> a time.
+
+;;> The simplest reader, simply returns the field string values in
+;;> order as a list.
+(define csv-read->list
+  (opt-lambda ((parser (csv-parser)))
+    (opt-lambda ((in (current-input-port)))
+      (let ((res (parser (lambda (ls i field) (cons field ls)) '() in)))
+        (if (pair? res)
+            (reverse res)
+            res)))))
+
+;;> The equivalent of \scheme{csv-read->list} but returns a vector.
+(define csv-read->vector
+  (opt-lambda ((parser (csv-parser)))
+    (let ((reader (csv-read->list parser)))
+      (opt-lambda ((in (current-input-port)))
+        (let ((res (reader in)))
+          (if (pair? res)
+              (list->vector res)
+              res))))))
+
+;;> The same as \scheme{csv-read->vector} but requires the vector to
+;;> be of a fixed size, and may be more efficient.
+(define csv-read->fixed-vector
+  (opt-lambda (size (parser (csv-parser)))
+    (opt-lambda ((in (current-input-port)))
+      (let ((res (make-vector size)))
+        (let ((len (parser (lambda (prev-i i field) (vector-set! res i field) i)
+                           0
+                           in)))
+          (if (zero? len)
+              eof-object
+              res))))))
+
+;;> Returns an SXML representation of the record, as a row with
+;;> multiple named columns.
+(define csv-read->sxml
+  (opt-lambda ((row-name 'row)
+               (column-names
+                (lambda (i)
+                  (string->symbol (string-append "col-" (number->string i)))))
+               (parser (csv-parser)))
+    (define (get-column-name i)
+      (if (procedure? column-names)
+          (column-names i)
+          (list-ref column-names i)))
+    (opt-lambda ((in (current-input-port)))
+      (let ((res (parser (lambda (ls i field)
+                           `((,(get-column-name i) ,field) ,@ls))
+                         (list row-name)
+                         in)))
+        (if (pair? res)
+            (reverse res)
+            res)))))
+
+;;> \section{CSV Utilities}
+
+;;> A folding operation on records.  \var{proc} is called successively
+;;> on each row and the accumulated result.
+(define csv-fold
+  (opt-lambda (proc
+               knil
+               (reader (csv-read->list))
+               (in (current-input-port)))
+    (let lp ((acc knil))
+      (let ((row (reader in)))
+        (cond
+         ((eof-object? row) acc)
+         (else (lp (proc row acc))))))))
+
+;;> An iterator which simply calls \var{proc} on each record in the
+;;> input in order.
+(define csv-for-each
+  (opt-lambda (proc
+               (reader (csv-read->list))
+               (in (current-input-port)))
+    (csv-fold (lambda (row acc) (proc row)) #f reader in)))
+
+;;> Returns a list containing the result of calling \var{proc} on each
+;;> element in the input.
+(define csv-map
+  (opt-lambda (proc
+               (reader (csv-read->list))
+               (in (current-input-port)))
+    (reverse (csv-fold (lambda (row acc) (cons (proc row) acc)) '() reader in))))
+
+;;> Returns a list of all of the read records in the input.
+(define csv->list
+  (opt-lambda ((reader (csv-read->list))
+               (in (current-input-port)))
+    (csv-map (lambda (row) row) reader in)))
+
+;;> Returns an SXML representation of the CSV.
+(define csv->sxml
+  (opt-lambda ((row-name 'row)
+               (column-names
+                (lambda (i)
+                  (string->symbol (string-append "col-" (number->string i)))))
+               (parser (csv-parser)))
+    (opt-lambda ((in (current-input-port)))
+      (cons '*TOP*
+            (csv->list (csv-read->sxml row-name column-names parser) in)))))
diff --git a/lib/chibi/csv.sld b/lib/chibi/csv.sld
new file mode 100644
index 00000000..f4df593d
--- /dev/null
+++ b/lib/chibi/csv.sld
@@ -0,0 +1,9 @@
+
+(define-library (chibi csv)
+  (import (scheme base) (srfi 227))
+  (export csv-grammar csv-parser csv-grammar?
+          default-csv-grammar default-tsv-grammar
+          csv-read->list csv-read->vector  csv-read->fixed-vector
+          csv-read->sxml
+          csv-fold csv-map csv->list csv-for-each csv->sxml)
+  (include "csv.scm"))