;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- #| Copyright (C) 2007, 2008 David Owen This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser Public License for more details. You should have received a copy of the GNU Lesser Public License along with this program. If not, see . |# (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) (dso-parse::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 (:priority-only t) ("," comma) ("\\r\\n?|\\n" newline) ("'(?:[^']|'')*'" value un-squote) ("\"(?:[^\"]|\"\")*\"" value un-dquote) ("[^,'\"\\n\\r]+" value) ("." illegal)) (defun lex-all-csv (input) (declare (optimize (speed 2) (debug 1))) (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)) :filter (lambda (row) (cons (caar row) (mapcar #'second (second row))))) (row-rest ((= t-comma) t-value) :filter 'car)) (defun read-csv (input) (let ((tokens (lex-all-csv input))) (file tokens)))