pipes-cborg-0.1: tests/Main.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import qualified Test.Tasty as Tasty
import qualified Test.Tasty.Runners as Tasty
import qualified Test.Tasty.QuickCheck as QC

import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.State.Strict (runStateT)
import qualified Codec.CBOR.Read as CBOR
  (ByteOffset, deserialiseFromBytesWithSize)
import qualified Codec.Serialise as Ser
import qualified Data.ByteString.Lazy as BL
import qualified Pipes as P
import qualified Pipes.CBOR as Pc
import qualified Pipes.ByteString as Pb
import qualified Pipes.Prelude as P

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

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


tests :: Tasty.TestTree
tests = Tasty.testGroup "root"
  [ testPipesCborg
  ]

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

testPipesCborg :: Tasty.TestTree
testPipesCborg = Tasty.testGroup "pipes-cborg"
  [ QC.testProperty "Pipes.CBOR.serialaise ~ Codec.Serialise.serialise" $ do
      QC.forAll QC.arbitrary $ \(x :: FunnyType) ->
         Ser.serialise x == BL.fromChunks (P.toList (Pc.serialise x))

  , QC.testProperty "Pipes.CBOR.deserialise ~ Codec.Serialise.deserialise" $ do
      QC.forAll QC.arbitrary $ \(x :: FunnyType) -> QC.ioProperty $ do
         let bl :: BL.ByteString = Ser.serialise x
             o1s :: Either Ser.DeserialiseFailure
                           (BL.ByteString, CBOR.ByteOffset, FunnyType)
             o1s = CBOR.deserialiseFromBytesWithSize Ser.decode bl
         (o2,p2) <- runStateT (Pc.decode Ser.decode) (Pb.fromLazy bl)
         s2 <- BL.fromChunks <$> P.toListM p2
         pure (o1s QC.=== fmap (\(a,b) -> (s2,a,b)) o2)
  ]