{-# LANGUAGE OverloadedStrings #-}
module Test.Attoparsec (tests) where
import Control.Monad (replicateM_)
import Control.Monad.Trans.Writer.Strict (runWriterT, tell)
import qualified Data.Attoparsec.Text as AT
import Data.Functor.Identity (runIdentity)
import Data.Text (Text)
import Pipes (each, for, lift, runEffect)
import Pipes.Attoparsec (parsed)
import Pipes.Prelude (toListM)
import Test.HUnit (Assertion, assert)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
-- | Parses a 'Char' repeated four times.
four :: AT.Parser Char
four = do
c <- AT.anyChar
replicateM_ 3 $ AT.char c
return c
type ParseTest = (Bool, String, [Text], [Char], [Text])
assertFoursTest :: ParseTest -> Assertion
assertFoursTest (ok, _title, input, output, mlo) =
assert $ res == output
&& isRight e == ok
&& mlo' == mlo
where
(e, res) = runIdentity . runWriterT . runEffect
$ for (parsed four $ each input)
(\c -> lift $ tell [c])
mlo' = case e of
Right _ -> []
Left (_,pmlo') -> fst . runIdentity
. runWriterT
$ toListM pmlo'
foursTests :: [ParseTest]
foursTests =
[ (True ,"0 chunk" ,[] ,[] ,[])
, (True ,"1 chunk: Empty" ,[] ,[] ,[])
, (True ,"1 chunk: One" ,["aaaa"] ,['a'] ,[])
, (True ,"1 chunk: One twice" ,["aaaaaaaa"] ,['a','a'] ,[])
, (True ,"1 chunk: Two" ,["aaaabbbb"] ,['a','b'] ,[])
, (True ,"1 chunk: Two between null" ,["aaaa","","bbbb"] ,['a','b'] ,[])
, (False ,"1 chunk: Partial" ,["aaaab"] ,['a'] ,["b"])
, (False ,"1 chunk: Wrong" ,["aaxbb"] ,[] ,["aaxbb"])
, (False ,"1 chunk: One then wrong" ,["aaaavz"] ,['a'] ,["vz"])
, (True ,"2 chunk: Empty" ,["",""] ,[] ,[])
, (True ,"2 chunk: Empty then one" ,["","aaaa"] ,['a'] ,[])
, (True ,"2 chunk: One" ,["a","aaa"] ,['a'] ,[])
, (True ,"2 chunk: One'" ,["aa","aa"] ,['a'] ,[])
, (True ,"2 chunk: One''" ,["aaa","a"] ,['a'] ,[])
, (True ,"2 chunk: One'''" ,["aaaa",""] ,['a'] ,[])
, (True ,"2 chunk: Two" ,["aaaa","bbbb"] ,['a','b'] ,[])
, (False ,"2 chunk: Wrong" ,["abcd","efgh"] ,[] ,["abcd","efgh"])
, (False ,"2 chunk: Wrong'" ,["a","axbb"] ,[] ,["a","axbb"])
, (False ,"2 chunk: One then wrong" ,["aaaab","bxz"] ,['a'] ,["b","bxz"])
, (True ,"3 chunk: One" ,["a","a","aa"] ,['a'] ,[])
, (False ,"3 chunk: Wrong" ,["a","a","axbb"] ,[] ,["a","a","axbb"])
]
testCaseFoursTest :: (Bool, [Char], [Text], [Char], [Text]) -> TestTree
testCaseFoursTest ft@(_,name,_,_,_) =
testCase ("Fours." ++ name) $ assertFoursTest ft
tests :: [TestTree]
tests = map testCaseFoursTest foursTests
isRight :: Either a b -> Bool
isRight (Right _) = True
isRight _ = False