{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Test.Streaming.ProducerSpec where import Data.Foldable import Data.Functor.Identity import qualified Data.List as DL import Data.Proxy import Prelude hiding (drop, filter, take) import Streaming.Producer import Test.QuickCheck.Arbitrary import Test.QuickCheck.Checkers import Test.QuickCheck.Classes import Test.QuickCheck.Gen import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.Extensions import Test.Tasty.HUnit as H import Test.Tasty.QuickCheck as QC test_show = prop "show" $ \(p :: ProducerInt) -> show p == show (runList p) test_append = testGroup "append" [ eg "sanity check - runList done" $ null $ run done , eg "append done - done" $ null $ run $ append done done , prop "append 2 producers" $ \(p1, p2) -> run (append p1 p2) == (run p1 ++ run p2) ] test_filter = testGroup "filter" [ prop "filter ints with tight predicate" $ \p -> let f = (== 0) in run (filter f p) == DL.filter f (run p) , prop "filter ints with more accepting predicate" $ \p -> let f = (> 0) in run (filter f p) == DL.filter f (run p) ] test_take = testGroup "take, drop, chunk" [ prop "take values" $ \(p, n) -> run (take n p) == DL.take n (run p) , prop "drop values" $ \(p, n) -> run (drop n p) == DL.drop n (run p) , prop "chunk values returns all values" $ \(p, n) -> run (chunk n p) == run p , minTestsOk 1000 $ prop "chunk values returns chunks of size == n, excepted possibly for the last one" $ \(p, n) -> n <= 1 || size p < n || if n `rem` size p == 0 then all (\c -> n == length c) (runC (chunk n p)) else all (\c -> n == length c) (dropLast (runC (chunk n p))) , prop "chunk values for a producer with no elements" $ \n -> null $ runC (chunk n done) , prop "chunk values for a producer with one element" $ \(n, a) -> runC (chunk n (one a)) == [[a]] ] test_monad = testGroup "laws" [ functorLaws (Proxy :: Proxy ProducerIntIntInt) , applicativeLaws (Proxy :: Proxy ProducerIntIntInt) , monadLaws (Proxy :: Proxy ProducerIntIntInt) ] -- HELPERS instance Arbitrary ProducerInt where arbitrary = oneof [ elements [done, one 1], more <$> arbitrary <*> arbitrary ] instance Arbitrary (Producer Identity (Int -> Int)) where arbitrary = oneof [ elements [done, one (+1), one (* 2)], more <$> arbitrary <*> arbitrary ] instance Arbitrary ProducerIntIntInt where arbitrary = do a <- arbitrary b <- arbitrary c <- arbitrary oneof [ elements [done, one (a :: Int, b :: Int, c :: Int)], more <$> arbitrary <*> arbitrary ] run :: ProducerInt -> [Int] run = runIdentity . runList size :: ProducerInt -> Int size = length . run empty :: ProducerInt -> Bool empty p = size p == 0 dropLast :: [a] -> [a] dropLast [] = [] dropLast [_] = [] dropLast (a:as) = a : dropLast as runC :: ProducerInt -> [[Int]] runC = runIdentity . runChunks type ProducerInt = Producer Identity Int type ProducerIntIntInt = Producer Identity (Int, Int, Int) instance Eq ProducerInt where (==) p1 p2 = runList p1 == runList p2 instance EqProp ProducerInt where (=-=) = eq