{-# LANGUAGE ScopedTypeVariables #-}

module Test.HUnit.Parsec where


import Test.HUnit
import Text.ParserCombinators.Parsec
import Text.Printf


data ParsecTest tok st t = ParsecTest {
  parser :: GenParser tok st t, 
  initState :: st,
  positiveCases :: [(t, [[tok]])], -- Multiple inputs with the same expected value.
  negativeCases :: [[tok]]
  }


instance (Show tok, Eq t, Show t) => Testable (ParsecTest tok st t) where

  test (ParsecTest (parser :: GenParser tok st t) st posCases negCases) = 
    test [test (map posTest posCases), 
          test (map negTest negCases)]

    where posTest (expected, inputs) = test (map testInput inputs)
            where testInput input = 
                    assertEqual (describe input parsed) (Just expected) (maybify parsed)
                    where parsed = testParse input
                          maybify :: Either l r -> Maybe r
                          maybify = either (const Nothing) Just

          negTest input = assertBool (describe input result) (isError result)
            where result = testParse input
                  isError = either (const True) (const False)

          testParse :: [tok] -> Either ParseError t
          testParse = runParser eofParser st "<test input>"

          eofParser :: GenParser tok st t
          eofParser =
            do v <- parser
               eof
               return v

          describe :: [tok] -> Either ParseError t -> String
          describe input parsed =
            printf "Input %s\nParsed:\n%s" (show input) (show parsed)