start of parser stuff

tests/quox-tests.ipkg

@@ -1,6 +1,6 @@
 package quox-tests
 
-depends = base, contrib, elab-util, sop, quox-lib
+depends = base, contrib, elab-util, sop, snocvect, quox-lib
 
 executable = quox-tests
 sourcedir = "src"

tests/src/Tests.idr

@@ -3,12 +3,14 @@ module Tests
 import Options
 import TAP
 import Tests.Lexer
+import Tests.Parser
 import Tests.Equal
 import System
 
 
 allTests = [
   Lexer.tests,
+  Parser.tests,
   Equal.tests
 ]
 

tests/src/Tests/Lexer.idr

@@ -52,7 +52,7 @@ parameters (label : String) (input : String)
 
   rejects : Test
   rejects = testThrows label (\case LexerError _ => True; _ => False) $ delay $
-            bimap LexerError (map val) $ lex {m = Either RealError} input
+            bimap LexerError (map val) $ lex input
 
 parameters (input : String) {default False esc : Bool}
   show' : String -> String

tests/src/Tests/Parser.idr

@@ -0,0 +1,77 @@
+module Tests.Parser
+
+import Quox.Syntax
+import Quox.Parser
+import Quox.Lexer
+import Tests.Lexer
+
+import Data.SnocVect
+import Text.Parser
+import TAP
+
+
+export
+Show tok => ToInfo (ParsingError tok) where
+  toInfo (Error msg Nothing)    = [("msg", msg)]
+  toInfo (Error msg (Just loc)) = [("loc", show loc), ("msg", msg)]
+
+
+numberErrs : List1 Info -> Info
+numberErrs (head ::: [])   = head
+numberErrs (head ::: tail) = go 0 (head :: tail) where
+  number1 : Nat -> Info -> Info
+  number1 n = map $ \(k, v) => (show n ++ k, v)
+
+  go : Nat -> List Info -> Info
+  go k []        = []
+  go k (x :: xs) = number1 k x ++ go (S k) xs
+
+export
+ToInfo Parser.Error where
+  toInfo (Lex      err)  = toInfo err
+  toInfo (Parse    errs) = numberErrs $ map toInfo errs
+  toInfo (Leftover toks) = toInfo [("leftover", toks)]
+
+
+RealError = Quox.Parser.Error
+%hide Lexer.RealError
+%hide Quox.Parser.Error
+
+data Error a
+= Parser RealError
+| Unexpected a a
+| ShouldFail a
+
+export
+Show a => ToInfo (Error a) where
+  toInfo (Parser err) = toInfo err
+  toInfo (Unexpected exp got) = toInfo $
+    [("expected", exp), ("received", got)]
+  toInfo (ShouldFail got) = toInfo [("success", got)]
+
+
+parameters {c : Bool} (grm : Grammar c a) (input : String)
+  parses : (Show a, Eq a) => a -> Test
+  parses exp = test input $ delay $
+    case lexParseAll grm input of
+         Right got => if got == exp then Right ()
+                                    else Left $ Unexpected exp got
+         Left  err => Left $ Parser err
+
+  rejects : Show a => Test
+  rejects = test input $ do
+    case lexParseAll grm input of
+         Left  err => Right ()
+         Right val => Left $ ShouldFail val
+
+tests = "parser" :- [
+  "numbers" :- let parses = parses number in [
+    parses "0" 0,
+    parses "1" 1,
+    parses "1000" 1000
+  ],
+
+  "bound vars" :- let parses = parses (bound [< "x", "y", "z"]) in [
+
+  ]
+]