{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import qualified Test.Tasty                       as Tasty
import           Test.Tasty.HUnit                 (testCase, (@=?))
import qualified Test.Tasty.Runners               as Tasty
import           Test.Tasty.SmallCheck            (forAll, testProperty)


import           Control.Monad
import           Control.Monad.Trans.Maybe
import           Control.Monad.Trans.State.Strict (StateT, evalStateT,
                                                   runStateT)
import qualified Data.Binary                      as Bin
import qualified Data.ByteString                  as B
import qualified Data.ByteString.Lazy             as BL
import           Data.Functor.Identity            (runIdentity)
import           Data.Maybe
import           Lens.Family.State.Strict         (zoom)
import           Pipes
import qualified Pipes.Binary                     as PBin
import qualified Pipes.Parse                      as PP
import qualified Pipes.Prelude                    as P

--------------------------------------------------------------------------------

main :: IO ()
main =  Tasty.defaultMainWithIngredients
  [ Tasty.consoleTestReporter
  , Tasty.listingTests
  ] tests


tests :: Tasty.TestTree
tests = Tasty.testGroup "root"
  [ testFunctorLaws
  , testPipesBinary
  ]


testFunctorLaws :: Tasty.TestTree
testFunctorLaws = Tasty.testGroup "Functor laws (sample test)"
  [ testCase "fmap id Nothing = Nothing" $ do
      fmap id Nothing @=? (Nothing :: Maybe ())
  , testProperty "fmap id = id" $ do
      forAll $ \(x :: [Int]) ->
        fmap id x == id x
  , testCase "fmap (f . g) Nothing = (fmap f . fmap g) Nothing" $ do
      fmap (not . not) Nothing @=? (fmap not . fmap not) (Nothing :: Maybe Bool)
  , testProperty "fmap (f . g) = fmap f . fmap g" $ do
      forAll $ \(x :: [Int]) ->
        fmap (odd . succ) x == (fmap odd . fmap succ) x
  ]

-- Just an arbitrary type that can be generated by SmallCheck.
type FunnyType = (String, (Double, (Int, (Maybe Int, Either Bool Int))))

testPipesBinary :: Tasty.TestTree
testPipesBinary = Tasty.testGroup "pipes-binary"
  [ testProperty "Pipes.Binary.encode ~ Data.Binary.encode" $ do
      forAll $ \(x :: FunnyType) ->
         BL.toStrict (Bin.encode x) == B.concat (P.toList (PBin.encode x))

  , testProperty "Pipes.Binary.decodeL ~ Data.Binary.decode" $ do
      forAll $ \(x :: FunnyType) ->
         let bl = Bin.encode x
             bs = BL.toStrict bl
             o1 = Bin.decodeOrFail bl
             (o2,s2) = fmap (B.concat . P.toList)
                            (runIdentity $ runStateT PBin.decodeL (yield bs))
         in case (o1, o2) of
              (Left (s1,n1,_), Left (PBin.DecodingError n2 _)) ->
                  n1 == n2 && BL.toStrict s1 == s2
              (Right (s1,n1,a1), Right (n2,a2)) ->
                  n1 ==  n2 && BL.toStrict s1 == s2 && a1 == (a2 :: FunnyType)
              _ -> False

  , testProperty "Pipes.Binary.decodeL ~ Pipes.Binary.decode" $ do
      forAll $ \(x :: FunnyType) ->
         let bs = BL.toStrict $ Bin.encode x
             o1 = runIdentity $ evalStateT PBin.decodeL (yield bs)
             o2 = runIdentity $ evalStateT PBin.decode  (yield bs)
         in fmap snd o1 == (o2 :: Either PBin.DecodingError FunnyType)

  , testProperty "Pipes.Binary.decoded zoom" $ do
      forAll $ \amx0 amx1 amx2 amx3 amx4 amx5 amx6 ->
         let xs :: [FunnyType] -- I get more tests cases this way.
             xs = [amx0, amx1, amx2, amx3, amx4, amx5, amx6] >>= maybe [] id
             dec0 :: Monad m => MaybeT (StateT (Producer B.ByteString m a) m) ()
             dec0 = do
               case xs of
                 [] -> do
                   mx0' <- lift $ zoom PBin.decoded PP.draw
                   guard $ isNothing (mx0' :: Maybe FunnyType)
                   rest <- lift $ zoom PBin.decoded PP.drawAll
                   guard $ null (rest :: [FunnyType])
                 (x0:x1:x2:xrest) -> do
                   x0x1' <- lift $ zoom (PBin.decoded . PP.splitAt 2) PP.drawAll
                   guard $ [x0,x1] == x0x1'
                   ex2' <- lift $ PBin.decode
                   guard $ Right x2 == ex2'
                   mx3' <- lift $ zoom PBin.decoded PP.draw
                   case (mx3', xrest) of
                     (Nothing,  []) -> return ()
                     (Just x3', (x3:rest))
                         | x3' == x3 -> do
                               rest' <- lift $ zoom PBin.decoded PP.drawAll
                               guard $ rest == rest'
                     _ -> mzero
                 (x0:xrest) -> do
                   mx0' <- lift $ zoom PBin.decoded PP.draw
                   guard $ Just x0 == mx0'
                   xrest' <- lift $ zoom PBin.decoded PP.drawAll
                   guard $ xrest == xrest'
             p0 = for (each xs) PBin.encode
         in isJust $ runIdentity $ evalStateT (runMaybeT dec0) p0
  ]