{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module TestSerialize where

import           Control.Applicative
import           Control.DeepSeq (NFData)
import           Control.Lens hiding (each)
import           Control.Monad
-- import           Criterion.Extended
import           Data.Attoparsec.ByteString.Char8 as AC
import           Data.Binary
import           Data.ByteString (ByteString)
import           Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import           Data.ByteString.Lazy (toStrict)
import           Data.Char (chr)
-- import           Data.DeriveTH (derive, makeArbitrary)
import           GHC.Generics (Generic)
import           MVC.Extended
import qualified MVC.Prelude as MVC
-- import qualified Pipes.Binary as PB
import           Pipes.Extended
import qualified Pipes.Prelude as Pipes
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.HUnit

-- sum test type
data TestF
  = A 
  | B ByteString
  deriving (Show,Eq,Read,Generic)

instance Arbitrary TestF where
  arbitrary = frequency
      [ ( 1, pure A)
      , ( 1, B <$> arbitrary)
      ]

instance Binary TestF

makePrisms ''TestF

-- derive makeArbitrary ''TestF

instance Arbitrary ByteString where
  arbitrary = 
    C.pack <$>
    (arbitrary `suchThat` (delim `Prelude.notElem`) :: Gen String)

delim :: Char
delim = chr 30

-- | parser
pTestF :: AC.Parser TestF
pTestF = 
  ("A" *>
   return A <*
   AC.char delim) <|>
  ("B " *>
   (B <$>
    AC.takeWhile (/= delim)) <*
   AC.char delim)

-- | builder
bTestF :: Char -> TestF -> Builder
bTestF delim' x = 
  case x of
    A -> 
      B.stringUtf8 "A" <>
      B.charUtf8 delim'
    B x' -> 
      B.stringUtf8 "B " <>
      B.byteString x' <>
      B.charUtf8 delim'

isoPipe :: (Show a,Eq a,Arbitrary a)
        => Int -> (a -> Builder) -> AC.Parser a -> IO ()
isoPipe n b p = 
  do bs <- 
       replicateM n
                  (generate arbitrary)
     let bs' = 
           Pipes.toList $ each bs >->
           Pipes.map (toStrict . B.toLazyByteString . b) >->
           parseP p >->
           Pipes.Extended.eitherP
     bs @=? bs'

isoTestF :: Int -> IO ()
isoTestF n = isoPipe n (bTestF delim) pTestF

-- | testing
isoVCArbitrary :: (Show a,Eq a,Arbitrary a)
               => Int -> Managed (View a) -> Managed (Controller a) -> IO ()
isoVCArbitrary n v c = 
  do bs <- 
       replicateM n
                  (generate arbitrary)
     toView n bs v
     bs' <- fromController n c
     bs @=? bs'

-- assumes files exist
isoVC :: (Show a,Eq a,Arbitrary a)
      => Int -> Managed (View a) -> Managed (Controller a) -> IO ()
isoVC n v c = 
  do as <- fromController n c
     toView n as v

{-
debugBinaryTestF :: (Binary b,Foldable f)
                 => f b -> IO ()
debugBinaryTestF ins = 
  do r <- 
       runEffect $
       (view PB.decoded
             (each ins >->
              for cat PB.encode) :: Producer TestF IO (Either (PB.DecodingError,Producer ByteString IO ()) ())) >->
       Pipes.print
     case r of
       Left (e,p) -> 
         do print e
            runEffect $ p >-> Pipes.print
       Right () -> return ()
-}

unitTests :: TestTree
unitTests = 
  Test.Tasty.testGroup 
    "TestSerialize - unit tests"
    [testCase "isoVCArbitrary read/show" $
     isoVCArbitrary 1000
                    (MVC.outShow "test/vc.read")
                    (MVC.inRead "test/vc.read" :: Managed (Controller TestF))
{-
    ,testCase "isoVCArbitrary parse/build" $
     isoVCArbitrary 1000
                    (outBuild "test/vc.parse" (bTestF delim))
                    (inBuild "test/vc.parse" pTestF)
-}
    ]

instance NFData TestF

showRead :: Int -> IO ()
showRead n = 
  isoVC n
        (MVC.outShow "test/vc.read2")
        (MVC.inRead "test/vc.read" :: Managed (Controller TestF))

buildParse :: Int -> IO ()
buildParse n = 
  isoVC n
        (outBuild "test/vc.parse2" (bTestF delim))
        (inBuild "test/vc.parse" pTestF)

setupFiles :: Int -> IO ()
setupFiles n = 
  do ins <- 
       replicateM n
                  (generate arbitrary)
     toView n ins (MVC.outShow "test/vc.read")
     toView n ins (outBuild "test/vc.parse" (bTestF delim))
     -- toView n ins (outBinary "test/vc.binary")
