{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Test.Attoparsec (tests) where

import           Control.Monad
import           Pipes
import qualified Pipes.Lift                         as P
import qualified Pipes.Prelude                      as P
import           Control.Monad.Trans.Error          (runErrorT)
import           Control.Monad.Trans.Writer.Strict  (runWriterT, tell)
import           Pipes.Attoparsec                   (parseMany)
import qualified Data.Attoparsec.Text               as AT
import           Data.Functor.Identity              (runIdentity)
import qualified Data.Text                          as T
import           Test.Framework.Providers.HUnit     (testCase)
import           Test.HUnit                         (Assertion, assert)

-- | 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, [T.Text], [Char], [T.Text])


assertFoursTest :: ParseTest -> Assertion
assertFoursTest (ok, _title, input, output, mlo) = assert . runIdentity $ do
  (e,res) <- runWriterT . runErrorT . P.toListM $
                for (P.errorP $ parseMany four $ each input)
                    (\a -> lift . lift $ tell [snd a])
  let (okErr,mlo') = case e of
       Left (_, pmlo') -> (not ok, P.toList . fmap fst $ P.runWriterP pmlo')
       Right _         -> (ok, [])
  let okMlo = mlo' == mlo
      okRes = res == output
  return $ okMlo && okErr && okRes

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']     ,[])
  , (False ,"1 chunk: Wrong"            ,["aaxbb"]          ,[]        ,["xbb"])
  , (False ,"1 chunk: One then wrong"   ,["aaaavz"]         ,['a']     ,["z"])
  , (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"]    ,[]        ,["bcd","efgh"])
  , (False ,"2 chunk: One then wrong"   ,["aaaab","bxz"]    ,['a']     ,["xz"])
  , (True  ,"3 chunk: One"              ,["a","a","aa"]     ,['a']     ,[])
  ]

testCaseFoursTest ft@(_,name,_,_,_) =
  testCase ("Fours." ++ name) $ assertFoursTest ft

tests = map testCaseFoursTest foursTests