source: tags/dso-csv-0.1/csv.lisp

;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-

(defpackage #:dso-csv
  (:use #:cl #:dso-lex #:dso-parse)
  ;; TODO
  (:import-from #:dso-parse #:substring)
  (:export #:lex-all-csv
           #:file
           #:row
           #:read-csv))

(in-package #:dso-csv)



(flet ((trim (s) (substring s :start 1 :length (- (length s) 2))))
  (defun un-squote (s)
    (cl-ppcre:regex-replace-all "''" (trim s) "'"))
  (defun un-dquote (s)
    (cl-ppcre:regex-replace-all "\"\"" (trim s) "\"")))

(deflexer lex-csv
  ("," comma)
  ("\\r\\n?|\\n" newline)
  ("'(?:[^']|'')*'" value un-squote)
  ("\"(?:[^\"]|\"\")*\"" value un-dquote)
  ("[^,'\"\\n\\r]+" value)
  ("." illegal))

(defun lex-all-csv (input)
  (labels ((lex-all (start tokens)
             (multiple-value-bind (class image next-offset)
                 (lex-csv input start)
               (cond
                 ((and class (eq class 'illegal))
                  (error "Illegal input"))
                 (class
                  (lex-all next-offset (cons (cons class image) tokens)))
                 (t
                  (nreverse tokens))))))
    (setf input (coerce input 'simple-string))
    (lex-all 0 nil)))

(defmacro defmatcher (class)
  (let ((fn-sym (intern (concatenate 'string "T-" (symbol-name class)))))
    `(defun ,fn-sym (token-list)
      (when token-list
        (destructuring-bind (class . image) (first token-list)
          (when (eq class ',class)
            (values t (rest token-list) (list image))))))))

(defmatcher comma)
(defmatcher newline)
(defmatcher value)



(defgrammar ()
  (file (+ row))
  (row (t-value (* row-rest) (= t-newline))
       (lambda (row) (cons (caar row) (mapcar #'second (second row)))))
  (row-rest ((= t-comma) t-value) car))



(defun read-csv (input)
  (let ((tokens (lex-all-csv input)))
    (file tokens)))