Initial importv0.1.0

1 files changed, 60 insertions, 0 deletions

diff --git a/src/csv.lisp b/src/csv.lisp
new file mode 100644
index 0000000..4c6297b
--- /dev/null
+++ b/src/csv.lisp
@@ -0,0 +1,60 @@
+(in-package #:cepis)
+
+(defun parse-csv (text)
+  "Parse TEXT as RFC 4180 CSV and return a list of rows, each a list of strings.
+
+Values may be double-quoted, in which case they may contain commas, newlines
+and doubled quotes; that is why the batch endpoint cannot be read by splitting
+on commas. A byte order mark and CRLF line endings are both tolerated."
+  (let ((rows '())
+        (row '())
+        (buffer (make-string-output-stream))
+        (in-quotes nil)
+        (dirty nil)
+        (index 0)
+        (end (length text)))
+    (labels ((flush-field ()
+               (push (get-output-stream-string buffer) row))
+             (flush-row ()
+               (flush-field)
+               (push (nreverse row) rows)
+               (setf row '()
+                     dirty nil)))
+      (when (and (plusp end) (char= (char text 0) (code-char #xFEFF)))
+        (incf index))
+      (loop while (< index end)
+            do (let ((character (char text index)))
+                 (cond (in-quotes
+                        (cond ((not (char= character #\"))
+                               (write-char character buffer))
+                              ((and (< (1+ index) end) (char= (char text (1+ index)) #\"))
+                               (write-char #\" buffer)
+                               (incf index))
+                              (t (setf in-quotes nil))))
+                       ((char= character #\")
+                        (setf in-quotes t
+                              dirty t))
+                       ((char= character #\,)
+                        (flush-field)
+                        (setf dirty t))
+                       ((char= character #\Newline)
+                        (flush-row))
+                       ((char= character #\Return))
+                       (t
+                        (write-char character buffer)
+                        (setf dirty t))))
+               (incf index))
+      (when (or dirty row)
+        (flush-row))
+      (nreverse rows))))
+
+(defun csv-row-table (header row)
+  "Zip HEADER and ROW into a hash table, so a CSV row reads like a JSON object.
+
+Columns the row does not reach are filled with the empty string, which is what
+the API sends for a field it does not have."
+  (let ((table (make-hash-table :test #'equal)))
+    (loop for column in header
+          for rest = row then (cdr rest)
+          do (setf (gethash column table) (or (car rest) "")))
+    table))