quox/tests/Tests/FromPTerm.idr

module Tests.FromPTerm

import Quox.Parser.Syntax
import Quox.Parser
import TermImpls
import Tests.Parser as TParser
import TAP

import Derive.Prelude
%language ElabReflection

%hide TParser.Failure
%hide TParser.ExpectedFail

public export
data Failure =
    ParseError (Parser.Error)
  | FromParserError FromParserError
  | WrongResult String
  | ExpectedFail String

%runElab derive "FromParser.FromParserError" [Show]

export
ToInfo Failure where
  toInfo (ParseError err) = toInfo err
  toInfo (FromParserError err) =
    [("type", "FromParserError"),
     ("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)
           (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
      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

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
  ]
]