quox/tests/Tests/FromPTerm.idr

91 lines
2.5 KiB
Idris
Raw Normal View History

2023-03-10 15:52:29 -05:00
module Tests.FromPTerm
import Quox.Parser.Syntax
import Quox.Parser
import TermImpls
import Tests.Parser as TParser
2023-03-10 15:52:29 -05:00
import TAP
import Derive.Prelude
%language ElabReflection
%hide TParser.Failure
%hide TParser.ExpectedFail
2023-03-10 15:52:29 -05:00
public export
data Failure =
ParseError (Parser.Error)
| FromParserError FromParserError
2023-03-10 15:52:29 -05:00
| WrongResult String
| ExpectedFail String
%runElab derive "FromParser.FromParserError" [Show]
2023-03-10 15:52:29 -05:00
export
ToInfo Failure where
toInfo (ParseError err) = toInfo err
toInfo (FromParserError err) =
[("type", "FromParserError"),
2023-03-10 15:52:29 -05:00
("got", show err)]
toInfo (WrongResult got) =
[("type", "WrongResult"), ("got", got)]
toInfo (ExpectedFail got) =
[("type", "ExpectedFail"), ("got", got)]
parameters {c : Bool} {auto _ : Show b}
(grm : Grammar c a) (fromP : a -> Either FromParserError b)
2023-03-10 15:52:29 -05:00
(inp : String)
parameters {default (ltrim inp) label : String}
parsesWith : (b -> Bool) -> Test
parsesWith p = test label $ do
pres <- mapFst ParseError $ lexParseWith grm inp
res <- mapFst FromParserError $ fromP pres
2023-03-10 15:52:29 -05:00
unless (p res) $ Left $ WrongResult $ show res
parses : Test
parses = parsesWith $ const True
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 inp
2023-03-10 15:52:29 -05:00
either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
FromString BName where fromString = Just . fromString
export
tests : Test
tests = "PTerm → Term" :- [
"dimensions" :-
let fromPDim = fromPDimWith [< "𝑖", "𝑗"]
in [
note "dim ctx: [𝑖, 𝑗]",
parsesAs dim fromPDim "𝑖" (BV 1),
parsesAs dim fromPDim "𝑗" (BV 0),
parseFails dim fromPDim "𝑘",
parsesAs dim fromPDim "0" (K Zero),
parsesAs dim fromPDim "1" (K One)
],
"terms" :-
let fromPTerm' = fromPTermWith [< "𝑖", "𝑗"] [< "A", "x", "y", "z"]
in [
note "dim ctx: [𝑖, 𝑗]; term ctx: [A, x, y, z]",
parsesAs term fromPTerm' "x" $ BVT 2,
parseFails term fromPTerm' "𝑖",
parsesAs term fromPTerm' "f" $ FT "f",
parsesAs term fromPTerm' "λ w ⇒ w" $ ["w"] :\\ BVT 0,
parsesAs term fromPTerm' "λ w ⇒ x" $ ["w"] :\\ BVT 3,
parsesAs term fromPTerm' "λ x ⇒ x" $ ["x"] :\\ BVT 0,
parsesAs term fromPTerm' "λ a b ⇒ f a b" $
["a", "b"] :\\ E (F "f" :@@ [BVT 1, BVT 0]),
parsesAs term fromPTerm' "f @𝑖" $
E $ F "f" :% BV 1
]
]