Rename csv-simple to util-csv.

src/util-csv.scm

@@ -0,0 +1,151 @@
+;;
+;; util-csv.scm
+;;
+;; Simple, incomplete and incorrect but fast CSV loader.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; Permission to use, copy, modify, and/or distribute this software
+;; for any purpose with or without fee is hereby granted, provided
+;; that the above copyright notice and this permission notice appear
+;; in all copies.
+;; 
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(declare (unit util-csv))
+
+(module
+ csv-simple
+ (
+  csv-parse
+  csv-split-header
+  csv-simple-tests!
+  )
+
+ (import scheme
+	 (chicken base)
+	 (chicken keyword)
+	 (chicken irregex)
+	 (chicken condition)
+	 testing
+	 progress
+	 util-io)
+
+  ;; Curry version of line parser with configurable cell separator and
+ ;; string delimiter. Returns a list of lists of strings.
+ (define ((make-csv-line-parser separator string-delimiter) line)
+   (let loop ((tokens (string->list line))
+	      (res '())
+	      (state 1))
+     (if (null? tokens)
+	 (reverse
+	  (map
+	   (lambda (cell)
+	     (list->string (reverse cell)))
+	   res))
+	 (let ((token (car tokens)))
+	   (case state
+	     ((0) ; Parsing regular unquoted cell data - separator creates new cell
+	      (if (eq? token separator)
+		  (loop (cdr tokens)
+			res
+			1) ; Start a new cell
+		  (loop (cdr tokens)
+			(cons (cons token (car res)) (cdr res))
+			0)))
+	     ((1) ; Starting a new cell - check for string delimiter
+	      (if (eq? token string-delimiter)
+		  (loop (cdr tokens)
+			(cons '() res) ; If it is quoted, keep even empty strings there
+			2)
+		  (if (eq? token separator)
+		      (loop (cdr tokens)
+			    (cons '() res) ; This was an empty cell
+			    1) ; Another new cell awaiting
+		      (loop (cdr tokens)
+			    (cons (list token) res) ; first token of regular new cell
+			    0))))
+	     ((2) ; Parsing quoted cell data - no support for escaping string delimiter!
+	      (if (eq? token string-delimiter)
+		  (loop (cdr tokens)
+			res
+			0) ; There shouldn't be anything more, but it is safe to append the rest as normal unquoted data
+		  (loop (cdr tokens)
+			(cons (cons token (car res)) (cdr res))
+			2)))))))) ; Continue inside quoted data
+ ;; Parses given CSV lines list
+ (define (csv-parse-lines lines . args)
+   (let* ((separator (get-keyword #:separator args (lambda () #\;)))
+	  (string-delimiter (get-keyword #:string-delimiter args (lambda () #\")))
+	  (csv-parse-line (make-csv-line-parser separator string-delimiter))
+	  (total (max (sub1 (length lines)) 1)))
+     (let loop ((lines lines)
+		(idx 0)
+		(res '()))
+       (if (null? lines)
+	   (reverse res)
+	   (let ((line (car lines)))
+	     (progress%-advance (/ idx total))
+	     (loop (cdr lines)
+		   (add1 idx)
+		   (cons (csv-parse-line line)
+			 res)))))))
+ 
+ ;; Loads given CSV file and parses its lines into lists
+ (define (csv-parse fn . args)
+   (call/cc
+    (lambda (ret)
+      (with-exception-handler
+       (lambda (ex)
+	 (ret #f))
+       (lambda ()
+	 (let ((lines (read-lines/no-bom (open-input-file fn))))
+	   (apply csv-parse-lines lines args)))))))
+
+ ;; Splits CSV into header and body based on the first empty row.
+ (define (csv-split-header csv)
+   (let loop ((body csv)
+	      (rhead '()))
+     (if (null? body)
+	 (list (reverse rhead) '())
+	 (let ((row (car body)))
+	   (if (null? row)
+	       (list (reverse rhead)
+		     (cdr body))
+	       (loop (cdr body)
+		     (cons row rhead)))))))
+
+ ;; Module self-tests
+ (define (csv-simple-tests!)
+   (run-tests
+    csv-simple
+    (test-equal? csv-parse-line
+		 ((make-csv-line-parser #\; #\") "test;2;3")
+		 '("test" "2" "3"))
+    (test-equal? csv-parse-line
+		 ((make-csv-line-parser #\; #\") "test;\"2;quoted\";3")
+		 '("test" "2;quoted" "3"))
+    (test-equal? csv-split-header
+		 (csv-split-header '((1 2) () (3 4)))
+		 '(((1 2)) ((3 4))))
+    (test-equal? csv-split-header
+		 (csv-split-header '((1 2) (5 6) (3 4)))
+		 '(((1 2) (5 6) (3 4)) ()))
+    (test-equal? csv-parse-lines
+		 (csv-parse-lines '("a;b;c" "1;2"))
+		 '(("a" "b" "c") ("1" "2")))
+    ))
+
+ )
+