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 [

  ]
]