;; -*- Mode: Lisp; -*-
;; ---------------------------------------------------------------------------
;;     Title: A very simple CSV Reader
;;   Created: 2021-11-11
;;    Author: Gilbert Baumann
;;   License: MIT style (see below)
;; ---------------------------------------------------------------------------
;;;  (c) copyright 2021 by Gilbert Baumann

;;  Permission is hereby granted, free of charge, to any person obtaining
;;  a copy of this software and associated documentation files (the
;;  "Software"), to deal in the Software without restriction, including
;;  without limitation the rights to use, copy, modify, merge, publish,
;;  distribute, sublicense, and/or sell copies of the Software, and to
;;  permit persons to whom the Software is furnished to do so, subject to
;;  the following conditions:
;; 
;;  The above copyright notice and this permission notice shall be
;;  included in all copies or substantial portions of the Software.
;; 
;;  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 
;;  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;;  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;;  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

(defpackage :csv
  (:use :common-lisp))

(in-package :csv)

(defun read-csv (stream)
  (let* ((minimum-room 4096)
         (buffer (etypecase stream
                   ((simple-array character (*)) stream)
                   (stream
                    (make-array (* 2 minimum-room) :element-type 'character))))
         (start 0)                      ;start of our current field
         ;; fill pointer of buffer
         (fptr (if (stringp stream) (length stream) 0))
         (p -1)                         ;reading pointer
         (c #\space))                   ;lookahead
    (declare (type (simple-array character (*)) buffer)
             (type fixnum start fptr p minimum-room)
             (optimize (speed 3) (safety 0)))
    (labels ((underflow ()
               (replace buffer buffer :start2 start :end2 p)
               (decf p start)
               (decf start start)
               (cond ((stringp stream)
                      (setq fptr p))
                     (t
                      (when (<= (- (length buffer) start) minimum-room)
                        (setq buffer (adjust-array buffer (+ (length buffer) minimum-room)))
                        (setq minimum-room (* minimum-room 2)))
                      (setf fptr (read-sequence buffer stream :start p)))))
             (consume ()
               (when c
                 (incf p)
                 (when (= p fptr) (underflow)))
               (setq c (if (= p fptr) nil (char buffer p))))
             (read-field ()
               (cond ((eql #\" c)
                      (consume)
                      (read-dquote-field))
                     (t
                      (setq start p)
                      (loop until (member c '(#\, #\newline nil)) do (consume))
                      (subseq buffer start p))))
             (read-dquote-field ()
               (prog1
                   (format nil "~{~A~^\"~}"
                           (loop collect (progn
                                           (setq start p)
                                           (loop until (member c '(#\" nil)) do (consume))
                                           (subseq buffer start p))
                                 do (when (eql #\" c) (consume))
                                 while (eql #\" c) do (consume)))
                 (etypecase c ((member #\newline #\, nil)))))
             (read-row ()
               ;; Question: What is an empty line? One empty field, or no field?
               (prog1
                   (loop collect (read-field) while (eql c #\,) do (consume))
                 (ecase c ((#\newline nil)))
                 (consume))))
      (declare (inline underflow consume read-field read-row))
      (consume)
      (loop until (null c) collect (read-row)))))