some refactoring in tests

This commit is contained in:
rhiannon morris 2024-05-28 18:39:21 +02:00
parent 2bfe3250cf
commit 3ab8669404

View file

@ -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
| FromParser FromParser.Error
| WrongResult String
ParseError PError
| FromParser FPError
| 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 : (b -> Bool) -> Test
parsesWith p = test label $ do
pres <- mapFst ParseError $ lexParseWith (grm "test") inp
res <- mapFst FromParser $ fromP pres
unless (p res) $ Left $ WrongResult $ show res
parsesWith : String -> (b -> Bool) -> Test
parsesWith label p = test label $ do
pres <- mapFst ParseError $ lexParseWith (grm "test") inp
res <- mapFst FromParser $ fromP pres
unless (p res) $ Left $ WrongResult $ show res
parses : Test
parses = parsesWith $ const True
%macro
parseMatch : {default (ltrim inp) label : String} -> TTImp -> Elab Test
parseMatch {label} pat =
parsesWith label <$> check `(\case ~(pat) => True; _ => False)
%macro
parseMatch : TTImp -> Elab Test
parseMatch pat =
parsesWith <$> check `(\case ~(pat) => True; _ => False)
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
parseFails : {default "\{ltrim inp} # fails" label : String} -> Test
parseFails {label} = test label $ do
pres <- mapFst ParseError $ lexParseWith (grm "test") inp
either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
runFromParser : {default empty defs : Definitions} ->
Eff FromParserPure a -> Either FromParser.Error a
runFromParser = map val . fromParserPure [<] 0 defs initStack
runFromParser : Definitions -> Eff FromParserPure a -> Either FPError a
runFromParser defs = 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]",