branch: master
commit 0c3408a063770adc14e0a161beb1aadbaed82b2b
Author: Junpeng Qiu <qjpchm...@gmail.com>
Commit: Junpeng Qiu <qjpchm...@gmail.com>
Init commit
---
parsec.el | 210 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 210 insertions(+)
diff --git a/parsec.el b/parsec.el
new file mode 100644
index 0000000..81a4a0d
--- /dev/null
+++ b/parsec.el
@@ -0,0 +1,210 @@
+;;; parsec.el --- Emacs Lisp fork of Haskell's Parsec library -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2016 Junpeng Qiu
+
+;; Author: Junpeng Qiu <qjpchm...@gmail.com>
+;; Keywords: extensions
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General 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 General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defun csv-file ()
+ (pl-many (csv-line)))
+
+(defun csv-line ()
+ (prog1 (csv-cells)
+ (csv-eol)))
+
+(defun csv-eol ()
+ (pl-or (pl-str "\n\r")
+ (pl-str "\r\n")
+ (pl-str "\n")
+ (pl-str "\r")
+ (pl-eob)))
+
+(defun csv-cells ()
+ (cons (csv-cell-content) (csv-remaining-cells)))
+
+(defun csv-cell-content ()
+ (pl-many-as-string (pl-re "[^,\n]")))
+
+(defun csv-remaining-cells ()
+ (pl-or (pl-and (pl-ch ?,) (csv-cells))
+ nil))
+
+(defun pl-ch (ch &rest args)
+ (if (and (not (eobp))
+ (char-equal (char-after) ch))
+ (prog1
+ (cond
+ ((memq :nil args) nil)
+ ((memq :beg args)
+ (point))
+ ((memq :end args)
+ (1+ (point)))
+ (t
+ (char-to-string ch)))
+ (forward-char 1))
+ (throw 'failed nil)))
+
+(require 'cl-lib)
+
+(defgroup pl nil
+ "Combinator parsing library for Emacs, similar to Haskell's Parsec"
+ :group 'development)
+
+(defun pl-re (regexp &rest args)
+ (if (looking-at regexp)
+ (prog1
+ (cond
+ ((memq :nil args) nil)
+ ((memq :beg args)
+ (match-beginning 0))
+ ((memq :end args)
+ (match-end 0))
+ ((memq :group args)
+ (let ((group
+ (loop named outer for arg on args
+ when (eq (car arg) :group) do
+ (return-from outer (cadr arg)))))
+ (if group
+ (match-string group)
+ (error "Unexpected regexp :group %s" group))))
+ (t
+ (match-string 0)))
+ (goto-char (match-end 0)))
+ (throw 'failed nil)))
+
+(defsubst pl-str (str &rest args)
+ (pl-re (regexp-quote str)))
+
+(defsubst pl-num (num &rest args)
+ (pl-re (regexp-quote (number-to-string num))))
+
+(defmacro pl-or (&rest parsers)
+ (let ((outer-sym (make-symbol "outer"))
+ (parser-sym (make-symbol "parser"))
+ (error-sym (make-symbol "error-message")))
+ `(loop named ,outer-sym for ,parser-sym in ',parsers
+ finally (throw 'failed nil) do
+ (when (setq ,error-sym
+ (catch 'failed
+ (return-from ,outer-sym (eval ,parser-sym))))
+ (error ,error-sym)))))
+
+(defmacro pl-try (&rest forms)
+ `(catch 'failed ,@forms))
+
+(defalias 'pl-and 'progn)
+(defalias 'pl-parse 'pl-try)
+
+(defmacro pl-until (parser &optional &key skip)
+ `(catch 'done
+ (while (not (eobp))
+ (catch 'failed
+ (throw 'done ,parser))
+ ,(if skip
+ `(,skip 1)
+ `(forward-char 1)))))
+(defun pl-eob ()
+ (unless (eobp)
+ (throw 'failed nil)))
+
+(defmacro pl-many (parser)
+ (let ((res (make-symbol "results"))
+ (msg (make-symbol "error-message")))
+ `(let (,res ,msg)
+ (when (setq ,msg (pl-try
+ (while (not (eobp))
+ (push ,parser ,res))))
+ (error ,msg))
+ (nreverse ,res))))
+
+(defmacro pl-many-as-string (parser)
+ `(mapconcat #'identity (pl-many ,parser) ""))
+
+(defun pl-list-to-string (l)
+ (mapconcat #'identity l ""))
+
+(defmacro pl-endby (parser end)
+ `(pl-many (prog1 ,parser
+ ,end)))
+
+(defmacro pl-sepby (parser separator)
+ `(pl-or
+ (cons ,parser (pl-many (pl-and ,separator ,parser)))
+ nil))
+
+(defmacro pl-failed (parser msg)
+ `(pl-or ,parser
+ (throw 'failed ,msg)))
+
+(defmacro pl-or (&rest parsers)
+ (let ((outer-sym (make-symbol "outer"))
+ (parser-sym (make-symbol "parser"))
+ (error-sym (make-symbol "error-message")))
+ `(loop named ,outer-sym for ,parser-sym in ',parsers
+ finally (throw 'failed nil) do
+ (when (setq ,error-sym (catch 'failed
+ (return-from ,outer-sym (eval
,parser-sym))))
+ (error ,error-sym)))))
+
+(defun csv-file1 ()
+ (pl-endby (csv-line1) (csv-eol)))
+
+(defun csv-line1 ()
+ (pl-sepby (csv-cell2) (pl-ch ?,)))
+
+(defun csv-cell1 ()
+ (pl-many-as-string (pl-re "[^,\r\n]")))
+
+(defun csv-cell2 ()
+ (pl-or (csv-quoted-cell) (pl-many (pl-re "[^,\n\r]"))))
+
+(defun csv-quoted-cell ()
+ (pl-ch ?\")
+ (prog1 (pl-many (csv-quoted-char))
+ (pl-failed (pl-ch ?\") "quote at end of cell")))
+
+(defun csv-quoted-char ()
+ (pl-or (pl-re "[^\"]")
+ (pl-and (pl-str "\"\"")
+ "\"")))
+
+(defun parse-csv1 (input)
+ (with-temp-buffer
+ (insert input)
+ (goto-char (point-min))
+ (csv-file1)))
+(parse-csv1 "\"a,1,s,b,\r\nd,e,f")
+
+(defun parse-csv (input)
+ (with-temp-buffer
+ (insert input)
+ (goto-char (point-min))
+ (csv-file)))
+
+(parse-csv "a1s,b,\n\nd,e,f")
+(with-temp-buffer
+ (insert "a,b,")
+ (goto-char (point-min))
+ (csv-line))
+
+(provide 'parsec)
+;;; parsec.el ends here
