Add better reporting and new features

Units report expected results on end of input.
Opposite parser helps with the complexity explosion
on unit parsers.
Input and error printing has context.

5 files changed, 30 insertions, 15 deletions

diff --git a/core.lisp b/core.lisp
index 2cd0120..3b06936 100644
--- a/core.lisp
+++ b/core.lisp
@@ -1,5 +1,14 @@
 (in-package #:monparser)
 
+(defun opposite (p)
+  (lambda (input &key lazy)
+    (let ((result (funcall p input)))
+      (cond ((parsing-p result)
+             (make-failure :place input :message "Unexpected match."))
+            ((failure-p result)
+             (make-parsing :tree nil :left input))
+            (t (error "Unexpected result type."))))))
+
 (defun fail (message)
   (lambda (input &key lazy)
     (make-failure :place input :message message)))
@@ -28,7 +37,8 @@
            (make-parsing :tree it :left (advance input))
            (make-failure :place input
                          :message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
-       (make-failure :place input :message "Reached end of input."))))
+       (make-failure :place input
+                     :message (format nil "Reached end of input. Expected: ~a" ',predicate)))))
 
 (defun lazily-select-parser (input parsers)
   (let ((intermediate-parsers '())
@@ -46,8 +56,7 @@
                             (input-cursor (parsing-left result))))
                  (setf result r)))
               ((failure-p r)
-               (when (or (failure-p result)
-                         (= (length parsers) 1))
+               (when (failure-p result)
                  (setf result r)))
               (t (error (format nil "Invalid return value: ~a" r))))))
     (if intermediate-parsers
diff --git a/extra.lisp b/extra.lisp
index b738da7..9451ce8 100644
--- a/extra.lisp
+++ b/extra.lisp
@@ -21,10 +21,8 @@
 
 (defun many (p)
   (comp ((x p)
-         (xs (if x
-               (optional (many p))
-               (fail "Parsing result is empty."))))
-        (cons x xs)))
+         (xs (optional (many p))))
+        (if x (cons x xs) xs)))
 
 (defun repeat (p min &optional (max 0))
   (if (> min 0)
diff --git a/input.lisp b/input.lisp
index 55a72cb..5d6a162 100644
--- a/input.lisp
+++ b/input.lisp
@@ -28,10 +28,17 @@
     (values line column)))
 
 (defmethod print-object ((obj parser-input) stream)
-  (let ((context-length 10))
+  (let ((context-length 20))
     (let ((begin (max (- (input-cursor obj) context-length) 0))
           (end (min (+ (input-cursor obj) context-length) (length (input-data obj)))))
-      (format stream "...~a~a~a..."
-              (substitute #\¶ #\Newline (subseq (input-data obj) begin (input-cursor obj)))
-              (substitute #\¶ #\Newline (subseq (input-data obj) (input-cursor obj) (1+ (input-cursor obj))))
-              (substitute #\¶ #\Newline (subseq (input-data obj) (1+ (input-cursor obj)) end))))))
+      (when (< 0 begin)
+        (format stream "..."))
+      (format stream "~a"
+              (substitute #\↲ #\Newline (subseq (input-data obj) begin (input-cursor obj))))
+      (if (< (input-cursor obj) (length (input-data obj)))
+        (format stream "~a~a"
+                (substitute #\↲ #\Newline (subseq (input-data obj) (input-cursor obj) (1+ (input-cursor obj))))
+                (substitute #\↲ #\Newline (subseq (input-data obj) (1+ (input-cursor obj)) end)))
+        (format stream "¬"))
+        (when (< end (length (input-data obj)))
+          (format stream "...")))))
diff --git a/main.lisp b/main.lisp
index c0fd49c..197f1b2 100644
--- a/main.lisp
+++ b/main.lisp
@@ -6,9 +6,9 @@
                                          :data data))))
     (if (parsing-p result)
       (let ((finished? (not (has-data? (parsing-left result)))))
-        (values (parsing-tree result) finished?))
-      (error (format nil "~a" result)))))
+        (values result finished?))
+      result)))
 
 (defmethod print-object ((obj failure) stream)
   (multiple-value-bind (line column) (line-and-column (failure-place obj))
-    (format stream "~a:~a: ~a" line column (failure-message obj))))
+    (format stream "~a:~a: ~a~&~a" line column (failure-message obj) (failure-place obj))))
diff --git a/package.lisp b/package.lisp
index 2b64c6f..a20934f 100644
--- a/package.lisp
+++ b/package.lisp
@@ -10,6 +10,7 @@
            #:one-of
            #:unit
            #:fail
+           #:opposite
            #:literal
            #:nothing
            #:optional