Altered tests.lisp to use character input streams

6 files changed, 102 insertions, 25 deletions

diff --git a/examples/foo.json b/examples/foo.json
new file mode 100644
index 0000000..8a410b6
--- /dev/null
+++ b/examples/foo.json
@@ -0,0 +1,20 @@
+{"name" : "Boutade",
+ "languages" : [ {"lang" : "Common Lisp",
+                 "proficiency" : null,
+                 "lovesIt" : true }
+
+              , {"lang" : "Rust",
+                 "proficiency" : 0.8,
+                 "lovesIt" : true,
+                 "isAshamedToLoveIt" : true}
+
+              , {"lang" : "Haskell",
+                 "proficiency" : 0.5,
+                 "lovesIt" : "sometimes, in some ways"} 
+              ],
+  "pizzaOrder" : ["Tempeh Italian Sausage", "Spinach", "Mushrooms", "Red Pepper Flakes"],
+  "isCool" : false,
+  "isFunny" : false,
+  "thinksPeopleAreLaughing" : true,
+  "beHonest_thinksPeopleAreLaughing" : false
+}
diff --git a/examples/json-parser.org b/examples/json-parser.org
index 538cc93..737f5e8 100644
--- a/examples/json-parser.org
+++ b/examples/json-parser.org
@@ -120,10 +120,10 @@
 #+begin_src lisp
 ;; Assuming you have parzival available to you, e.g. via ~/quicklisp/local-projects/
 
-(defpackage "parzival-json"
+(defpackage "json-parzival"
   (:use :cl :parzival))
 
-(in-package "parzival-json")
+(in-package "json-parzival")
 
 #+end_src
 
@@ -182,39 +182,39 @@
 
 #+begin_src lisp
 ;; matching and returning a single space from a string of spaces
-|parzival-json|> (parse-string <space< "    ")    
+|json-parzival|> (parse-string <space< "    ")    
 #\ 
 T
 #<REPLAY-STREAMS:STATIC-TEXT-REPLAY-STREAM {10027DD303}>
 
 ;; failing to match a space, input starts with an #\x character
-|parzival-json|> (parse-string <space< "xyz")     
+|json-parzival|> (parse-string <space< "xyz")     
 NIL
 NIL
 #<REPLAY-STREAMS:STATIC-TEXT-REPLAY-STREAM {100287CE53}>
 
 ;; matching and returning a newline
-|parzival-json|> (parse-string (<<or <space< <newline<) "
+|json-parzival|> (parse-string (<<or <space< <newline<) "
 ")                                                
 #\Newline
 T
 #<REPLAY-STREAMS:STATIC-TEXT-REPLAY-STREAM {100298F343}>
 
 ;; failing to match either, empty string
-|parzival-json|> (parse-string (<<or <space< <newline<) "") 
+|json-parzival|> (parse-string (<<or <space< <newline<) "") 
 NIL
 NIL
 #<REPLAY-STREAMS:STATIC-TEXT-REPLAY-STREAM {1002C54CC3}>
 
 ;; finally, matching a bunch of spaces or newlines and returning them as a list
-|parzival-json|> (parse-string (<<* (<<or <space< <newline<)) "     
+|json-parzival|> (parse-string (<<* (<<or <space< <newline<)) "     
   ")
 (#\  #\  #\  #\  #\  #\Newline #\  #\ )
 T
 #<REPLAY-STREAMS:STATIC-TEXT-REPLAY-STREAM {1002D16473}>
 
 ;; equivalently, just use your newly minted <whitespace< parser
-|parzival-json|> (parse-string <whitespace< "     
+|json-parzival|> (parse-string <whitespace< "     
   ")
 (#\  #\  #\  #\  #\  #\Newline #\  #\ )
 T
@@ -441,7 +441,7 @@ any of its three arguments fails.
 T
 #<REPLAY-STREAMS:STATIC-TEXT-REPLAY-STREAM {1003BE2F33}>
 
-|parzival-json|> (parse-string (<<bind <nat<
+|json-parzival|> (parse-string (<<bind <nat<
                                       (lambda (count) (<<times count (<<char #\x))))
                                "4xxx")
 NIL
diff --git a/examples/json-parzival.lisp b/examples/json-parzival.lisp
new file mode 100644
index 0000000..e25eaf0
--- /dev/null
+++ b/examples/json-parzival.lisp
@@ -0,0 +1,47 @@
+(defpackage "json-parzival"
+  (:use :cl :parzival))
+
+(in-package "json-parzival")
+
+(defvar <json-null< (<<map (lambda (null) :null)
+                           (<<string "null")))
+
+(defvar <json-bool< (<<map (lambda (bool) (equal bool "true"))
+                           (<<plus (<<string "true") (<<string "false"))))
+
+(defvar <json-num< <real<)
+
+(defvar <json-string<
+  (<<char-brackets #\"
+                   (<<to-string (<<* (<<asat (not (eql it #\")))))
+                   #\"))
+
+(defun <json-array< (stream) (funcall <json-array< stream))
+(defun <json-object< (stream) (funcall <json-object< stream))
+
+(defvar <json-value<
+  (<<or #'<json-object< #'<json-array< <json-string< <json-num< <json-bool< <json-null<))
+
+(defvar <comma-sep< (<<strip (<<char #\,)))
+
+(defvar <json-array<
+  (<<brackets (<<strip (<<char #\[))
+              (<<sep-by <json-value< <comma-sep<)
+              (<<strip (<<char #\]))))
+
+(defvar <json-object-pair<
+  (<<bind (<<brackets <whitespace<
+                      <json-string<
+                      (<<strip (<<char #\:)))
+          (lambda (key)
+            (<<map (lambda (value) (cons key value))
+                   <json-value<))))
+
+(defvar <json-object<
+  (<<brackets (<<strip (<<char #\{))
+              (<<sep-by <json-object-pair< <comma-sep<)
+              (<<strip (<<char #\}))))
+
+
+
+
diff --git a/package.lisp b/package.lisp
index 9150608..e664515 100644
--- a/package.lisp
+++ b/package.lisp
@@ -62,6 +62,7 @@
    #:<<max-times
    #:<<sep-by
    #:<<brackets
+   #:<<char-brackets
    #:<<string
    #:<<~string
    #:<<to-string
diff --git a/parzival.lisp b/parzival.lisp
index 8981bbc..4691a07 100644
--- a/parzival.lisp
+++ b/parzival.lisp
@@ -30,6 +30,7 @@
 
 ;;; The PARSE function. Runs parsers.
 
+;; TODO refactor parse to detect how best to create a replay stream, automatically
 (defun parse (stream parser &optional string-as-stream-p)
   "Parse STREAM with PARSER. If STRING-AS-STREAM-P then STREAM can be a string."
   (if string-as-stream-p
@@ -111,12 +112,14 @@ in then. If the parse fails the combinator else is run instead."
   (lambda (stream)
     (let ((chkpt (checkpoint stream)))
       (<<if (result parser1 stream)
-            (<<result result)
+            (progn
+              (free-checkpoint stream chkpt)
+              (<<result result))
             (progn
               (rewind-to stream chkpt)
               parser2)))))
 
-
+;; I thin i see... checkpoints to the same point are being removed when they should't be
 (defun <<or (parser1 parser2 &rest parsers)
   "Tries each parser one after the other, rewinding the input stream after each
 failure, and resulting in the first successful parse."
@@ -326,18 +329,24 @@ the character C."
 
 (defun <<* (parser)
   "Runs the parser PARSER zero or more times, resulting in of list of parsed values."
-  (lambda (stream)
-    (let ((result nil)
-          (parser (<<~ parser)))
-      (labels ((rec (stream)
-                 (multiple-value-bind
-                       (res ok? stream2) (funcall parser stream)
-                   (if ok?
-                       (progn
-                         (push res result)
-                         (rec stream2))
-                       (values (nreverse result) t stream2)))))
-        (rec stream)))))
+  (<<bind (<<? parser)
+          (lambda (result)
+            (if (null result) (<<result result)
+                (<<map-cons result (<<* parser))))))
+
+
+  ;; (lambda (stream)
+  ;;   (let ((result nil)
+  ;;         (parser (<<~ parser)))
+  ;;     (labels ((rec (stream)
+  ;;                (multiple-value-bind
+  ;;                      (res ok? stream2) (funcall parser stream)
+  ;;                  (if ok?
+  ;;                      (progn
+  ;;                        (push res result)
+  ;;                        (rec stream2))
+  ;;                      (values (nreverse result) t stream2)))))
+  ;;       (rec stream)))))
 
 
 (defun <<+ (parser)
@@ -388,7 +397,6 @@ the character C."
   (<<brackets (<<char left-char) center (<<char right-char)))
 
 
-
 ;;; VALUE PARSERS. The following section contains utilities for parsing common
 ;;; values like strings or numbers.
 
diff --git a/tests.lisp b/tests.lisp
index 9a1aecf..44d0a3b 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -8,7 +8,8 @@
 
 (defmacro test-with ((var input-string) &rest tests)
   `(subtest (format nil "With the input ~s ..." ,input-string)
-     (let ((,var (make-instance 'replay-streams:static-text-replay-stream :text ,input-string)))
+     (let ((,var (make-instance 'replay-streams:character-input-replay-stream
+                                :source (make-string-input-stream ,input-string))))
        ,@tests)))
 
 (defmacro results (stream expr val)