78 lines
1.8 KiB
Idris
78 lines
1.8 KiB
Idris
|
module Tests.Parser
|
||
|
|
||
|
import Quox.Syntax
|
||
|
import Quox.Parser
|
||
|
import Quox.Lexer
|
||
|
import Tests.Lexer
|
||
|
|
||
|
import Data.SnocVect
|
||
|
import Text.Parser
|
||
|
import TAP
|
||
|
|
||
|
|
||
|
export
|
||
|
Show tok => ToInfo (ParsingError tok) where
|
||
|
toInfo (Error msg Nothing) = [("msg", msg)]
|
||
|
toInfo (Error msg (Just loc)) = [("loc", show loc), ("msg", msg)]
|
||
|
|
||
|
|
||
|
numberErrs : List1 Info -> Info
|
||
|
numberErrs (head ::: []) = head
|
||
|
numberErrs (head ::: tail) = go 0 (head :: tail) where
|
||
|
number1 : Nat -> Info -> Info
|
||
|
number1 n = map $ \(k, v) => (show n ++ k, v)
|
||
|
|
||
|
go : Nat -> List Info -> Info
|
||
|
go k [] = []
|
||
|
go k (x :: xs) = number1 k x ++ go (S k) xs
|
||
|
|
||
|
export
|
||
|
ToInfo Parser.Error where
|
||
|
toInfo (Lex err) = toInfo err
|
||
|
toInfo (Parse errs) = numberErrs $ map toInfo errs
|
||
|
toInfo (Leftover toks) = toInfo [("leftover", toks)]
|
||
|
|
||
|
|
||
|
RealError = Quox.Parser.Error
|
||
|
%hide Lexer.RealError
|
||
|
%hide Quox.Parser.Error
|
||
|
|
||
|
data Error a
|
||
|
= Parser RealError
|
||
|
| Unexpected a a
|
||
|
| ShouldFail a
|
||
|
|
||
|
export
|
||
|
Show a => ToInfo (Error a) where
|
||
|
toInfo (Parser err) = toInfo err
|
||
|
toInfo (Unexpected exp got) = toInfo $
|
||
|
[("expected", exp), ("received", got)]
|
||
|
toInfo (ShouldFail got) = toInfo [("success", got)]
|
||
|
|
||
|
|
||
|
parameters {c : Bool} (grm : Grammar c a) (input : String)
|
||
|
parses : (Show a, Eq a) => a -> Test
|
||
|
parses exp = test input $ delay $
|
||
|
case lexParseAll grm input of
|
||
|
Right got => if got == exp then Right ()
|
||
|
else Left $ Unexpected exp got
|
||
|
Left err => Left $ Parser err
|
||
|
|
||
|
rejects : Show a => Test
|
||
|
rejects = test input $ do
|
||
|
case lexParseAll grm input of
|
||
|
Left err => Right ()
|
||
|
Right val => Left $ ShouldFail val
|
||
|
|
||
|
tests = "parser" :- [
|
||
|
"numbers" :- let parses = parses number in [
|
||
|
parses "0" 0,
|
||
|
parses "1" 1,
|
||
|
parses "1000" 1000
|
||
|
],
|
||
|
|
||
|
"bound vars" :- let parses = parses (bound [< "x", "y", "z"]) in [
|
||
|
|
||
|
]
|
||
|
]
|