tests/Tests/FromPTerm.idr

@@ -16,11 +16,14 @@ import Derive.Prelude
 %hide TParser.Failure
 %hide TParser.ExpectedFail
 
+PError  = Parser.Error
+FPError = FromParser.Error
+
 public export
 data Failure =
-    ParseError Parser.Error
+    ParseError   PError
-  | FromParser FromParser.Error
+  | FromParser   FPError
-  | WrongResult String
+  | WrongResult  String
   | ExpectedFail String
 
 %runElab derive "FileError" [Show]
@@ -39,42 +42,33 @@ ToInfo Failure where
 
 parameters {c : Bool} {auto _ : Show b}
            (grm : FileName -> Grammar c a)
-           (fromP : a -> Either FromParser.Error b)
+           (fromP : a -> Either FPError b)
            (inp : String)
-  parameters {default (ltrim inp) label : String}
+  parsesWith : String -> (b -> Bool) -> Test
-    parsesWith : (b -> Bool) -> Test
+  parsesWith label p = test label $ do
-    parsesWith p = test label $ do
+    pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
-      pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
+    res  <- mapFst FromParser $ fromP pres
-      res  <- mapFst FromParser $ fromP pres
+    unless (p res) $ Left $ WrongResult $ show res
-      unless (p res) $ Left $ WrongResult $ show res
 
-    parses : Test
+  %macro
-    parses = parsesWith $ const True
+  parseMatch : {default (ltrim inp) label : String} -> TTImp -> Elab Test
+  parseMatch {label} pat =
+    parsesWith label <$> check `(\case ~(pat) => True; _ => False)
 
-    %macro
+  parseFails : {default "\{ltrim inp}  # fails" label : String} -> Test
-    parseMatch : TTImp -> Elab Test
+  parseFails {label} = test label $ do
-    parseMatch pat =
+    pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
-      parsesWith <$> check `(\case ~(pat) => True; _ => False)
+    either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
-
-    parsesAs : Eq b => b -> Test
-    parsesAs exp = parsesWith (== exp)
-
-  parameters {default "\{ltrim inp}  # fails" label : String}
-    parseFails : Test
-    parseFails = test label $ do
-      pres <- mapFst ParseError $ lexParseWith (grm "‹test›") inp
-      either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
 
 
-runFromParser : {default empty defs : Definitions} ->
+runFromParser : Definitions -> Eff FromParserPure a -> Either FPError a
-                Eff FromParserPure a -> Either FromParser.Error a
+runFromParser defs = map val . fromParserPure [<] 0 defs initStack
-runFromParser = map val . fromParserPure [<] 0 defs initStack
 
 export
 tests : Test
 tests = "PTerm → Term" :- [
   "dimensions" :-
-  let fromPDim = runFromParser . fromPDimWith [< "𝑖", "𝑗"]
+  let fromPDim = runFromParser empty . fromPDimWith [< "𝑖", "𝑗"]
   in [
     note "dim ctx: [𝑖, 𝑗]",
     parseMatch dim fromPDim "𝑖" `(B (VS VZ) _),
@@ -87,7 +81,7 @@ tests = "PTerm → Term" :- [
   "terms" :-
   let defs = fromList [("f", mkDef GAny (^NAT) (^Zero))]
         -- doesn't have to be well typed yet, just well scoped
-      fromPTerm = runFromParser {defs} .
+      fromPTerm = runFromParser defs .
                   fromPTermWith [< "𝑖", "𝑗"] [< "A", "x", "y", "z"]
   in [
     note "dim ctx: [𝑖, 𝑗]; term ctx: [A, x, y, z]",