LParse-0.2.1.0: test/Test.hs

module Main where 

import Text.LParse.Parser
import Text.LParse.Atomics
import Text.LParse.Transformers

import Control.Applicative
import Control.Monad
import Data.Either
import Data.List
import Data.Maybe
import System.Exit (exitSuccess,exitFailure)

succCases :: [(Parser r String (),String)]
succCases = [
    (noop,""),
    (eoi,""),
    (discard,"lel"),
    (discard >> eoi,"lorem ipsum"),
    (consume "prefix","prefixed"),
    (consume "", "foo"),
    (consume "", ""),
    (letter >> eoi, "b"),
    (digit >> eoi, "4"),
    (word >> eoi, "banana")
    ]

failCases :: [(Parser r String (),String)]
failCases = [
    (eoi,"foo"),
    (consume "prefix", "freepix"),
    (consume "prefix", ""),
    (letter >> eoi, "banana"),
    (digit >> eoi, "42"),
    (word >> eoi, "banana bread")
    ]

stringCases :: [(Parser r String String, String, String)]
stringCases = [
    (word,"sufficient example","sufficient")
    ]

intCases :: [(Parser r String Integer, String, Integer)]
intCases = [
    (integer,"123 is a nice number",123),
    (digit,"123 is a nice number",1),
    (sum <$> sepMany (consume " ") integer,"1 4 12 61 192",1+4+12+61+192)
    ]

runTests :: [(Parser (Either String a) t a,t)] -> [Either String a]
runTests = map (uncurry doParse)

eqTest :: (Eq a, Show a) => (Parser (Either String ()) t a, t, a) -> Either String ()
eqTest (p,i,e) = parse p i (\r -> if r == e then Right () else Left ("Expected " ++ show e ++ ", but got " ++ show r)) (const $ Left "Parser error")

succTest :: [Either String a] -> IO ()
succTest res = if all isRight res then return () else putStrLn (head $ lefts res) >> exitFailure

failTest :: [Either String a] -> IO ()
failTest res = if all isLeft res then return () else putStrLn "Fail Test Succeeded" >> exitFailure

main ::IO ()
main = do
    let sres = runTests succCases
    let fres = runTests failCases
    let seres = map eqTest stringCases
    let ieres = map eqTest intCases
    succTest sres
    failTest fres
    succTest seres
    succTest ieres
    exitSuccess