quox/tests/Tests/FromPTerm.idr

102 lines
2.9 KiB
Idris
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Tests.FromPTerm
import Quox.Parser.FromParser
import Quox.Parser
import TermImpls
import TypingImpls
import Tests.Parser as TParser
import TAP
import Quox.EffExtra
import System.File
import Derive.Prelude
%language ElabReflection
%hide TParser.Failure
%hide TParser.ExpectedFail
public export
data Failure =
ParseError Parser.Error
| FromParser FromParser.Error
| WrongResult String
| ExpectedFail String
%runElab derive "FileError" [Show]
export
ToInfo Failure where
toInfo (ParseError err) = toInfo err
toInfo (FromParser err) =
[("type", "FromParserError"),
("got", show $ prettyError True True 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 FromParser.Error b)
(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 FromParser $ fromP pres
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
either (const $ Right ()) (Left . ExpectedFail . show) $ fromP pres
FromString BName where fromString = Just . fromString
runFromParser : {default empty defs : Definitions} ->
Eff FromParserPure a -> Either FromParser.Error a
runFromParser = map fst . fromParserPure defs
export
tests : Test
tests = "PTerm → Term" :- [
"dimensions" :-
let fromPDim = runFromParser . 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 defs = fromList [("f", mkDef gany Nat Zero)]
-- doesn't have to be well typed yet, just well scoped
fromPTerm = runFromParser {defs} .
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
],
todo "everything else"
]