[elpa] master d98e8c8 05/60: Add url-encoded string parser

[Junpeng Qiu]

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

    Add url-encoded string parser
---
 parsec.el         |   30 ++++++++++++++++++++++++--
 url-str-parser.el |   61 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 89 insertions(+), 2 deletions(-)

diff --git a/parsec.el b/parsec.el
index 7bca129..a86629d 100644
--- a/parsec.el
+++ b/parsec.el
@@ -161,16 +161,22 @@
   (let ((res (make-symbol "results")))
     `(let (,res)
        (pl-try
-        (while (not (eobp))
-          (push ,parser ,res)))
+           (while (not (eobp))
+             (push ,parser ,res)))
        (nreverse ,res))))
 
+(defmacro pl-many1 (parser)
+  `(cons ,parser (pl-many ,parser)))
+
 (defun pl-list-to-string (l)
   (mapconcat #'identity l ""))
 
 (defmacro pl-many-as-string (parser)
   `(mapconcat #'identity (pl-many ,parser) ""))
 
+(defmacro pl-many1-as-string (parser)
+  `(mapconcat #'identity (pl-many1 ,parser) ""))
+
 (defmacro pl-endby (parser end)
   `(pl-many (pl-return ,parser
               ,end)))
@@ -180,5 +186,25 @@
     (cons ,parser (pl-many (pl-and ,separator ,parser)))
     nil))
 
+
+(defun pl-just (x) (cons 'Just x))
+
+(defvar pl-nothing 'Nothing)
+
+(defun pl-maybe-p (x)
+  (or (eq x pl-nothing)
+      (and
+       (consp x)
+       (eq (car x) 'Just))))
+
+(defmacro pl-make-maybe (&rest body)
+  (let ((res (make-symbol "result")))
+    `(let ((,res (pl-try
+                     ,@body)))
+       (if (pl-msg-p ,res)
+           pl-nothing
+         (pl-just ,res)))))
+
+
 (provide 'parsec)
 ;;; parsec.el ends here
diff --git a/url-str-parser.el b/url-str-parser.el
new file mode 100644
index 0000000..fbb747e
--- /dev/null
+++ b/url-str-parser.el
@@ -0,0 +1,61 @@
+;;; url-str-parser.el --- URL-encoded query string parser using parsec.el  -*- 
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:
+
+;; Ref: http://book.realworldhaskell.org/read/using-parsec.html
+
+;;; Code:
+
+
+(defun url-str-query ()
+  (pl-sepby (url-str-pair) (pl-ch ?&)))
+
+(defun url-str-pair ()
+  (cons
+   (pl-many1-as-string (url-str-char))
+   (pl-make-maybe (pl-and (pl-ch ?=) (pl-many-as-string (url-str-char))))))
+
+(defun url-str-char ()
+  (pl-or (pl-re "[a-zA-z0-9$_.!*'(),-]")
+         (pl-and (pl-ch ?+) " ")
+         (url-str-hex)))
+
+(defun url-str-hex ()
+  (pl-and
+    (pl-ch ?%)
+    (format "%c"
+            (string-to-number (format "%s%s"
+                                      (pl-re "[0-9a-zA-z]")
+                                      (pl-re "[0-9a-zA-z]"))
+                              16))))
+
+(defun url-str-parse (input)
+  (with-temp-buffer
+    (insert input)
+    (goto-char (point-min))
+    (url-str-query)))
+
+(url-str-parse "foo=bar&a%21=b+c")
+(url-str-parse "foo=&a%21=b+c")
+(url-str-parse "foo&a%21=b+c")
+
+(provide 'url-str-parser)
+;;; url-str-parser.el ends here