[elpa] master 0c3408a 01/60: Init commit

[Junpeng Qiu]

branch: master
commit 0c3408a063770adc14e0a161beb1aadbaed82b2b
Author: Junpeng Qiu <address@hidden>
Commit: Junpeng Qiu <address@hidden>

    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 <address@hidden>
+;; 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