@@ -0,0 +1,290 @@
1+module Main (main) where
3+import Control.Monad (when)
4+import Control.Applicative (ZipList(..))
5+import Control.Monad (replicateM)
6+import Data.List (sort)
7+import GHC.Word (Word8)
9+import Test.Hspec (hspec, Spec)
10+import Test.Hspec.QuickCheck (prop)
11+import Test.QuickCheck (counterexample, Property)
12+import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)
15+import qualified Streamly.Prelude as A
19+ => (a -> a -> Bool) -> a -> a -> PropertyM m ()
20+equals eq stream list = do
21+ when (not $ stream `eq` list) $
24+ "stream " ++ show stream ++ " /= list " ++ show list)
25+ assert (stream `eq` list)
27+constructWithReplicateM
29+ => (t IO Int -> t IO Int)
32+constructWithReplicateM op len =
34+ let x = return (1 :: Int)
35+ stream <- run $ (A.toList . op) (A.replicateM (fromIntegral len) x)
36+ list <- run $ replicateM (fromIntegral len) x
37+ equals (==) stream list
41+ => ([Int] -> t IO Int)
43+ -> (t IO Int -> t IO Int)
46+transformFromList constr listOp op a =
48+ stream <- run ((A.toList . op) (constr a))
50+ equals (==) stream list
54+ => ([Int] -> t IO Int)
55+ -> (t IO Int -> t IO Int)
58+foldFromList constr op a = transformFromList constr id op a
61+ :: (Streaming t, Show a, Eq a)
63+ -> (t IO Int -> IO a)
66+eliminateOp listOp op a =
68+ stream <- run $ op (A.each a)
70+ equals (==) stream list
74+ => (t IO Word8 -> t IO Word8)
75+ -> (Word8 -> t IO Word8 -> IO Bool)
76+ -> (Word8 -> [Word8] -> Bool)
79+elemOp op streamOp listOp (x, xs) =
81+ stream <- run $ (streamOp x . op) (A.each xs)
82+ let list = listOp x xs
83+ equals (==) stream list
87+ => ([Int] -> [Int]) -> (t IO Int -> t IO Int) -> [Int] -> Property
88+transformOp = transformFromList (A.each)
91+ :: (Streaming t, Functor (t IO))
92+ => String -> (t IO Int -> t IO Int) -> Spec
93+functorOps desc t = do
94+ prop (desc ++ " id") $ transformOp id $ t
95+ prop (desc ++ " fmap (+1)") $ transformOp (fmap (+1)) $ t . (fmap (+1))
99+ => String -> (t IO Int -> t IO Int) -> Spec
103+ prop (desc ++ " filter False") $
104+ transformOp (filter (const False)) $ t . (A.filter (const False))
105+ prop (desc ++ " filter True") $
106+ transformOp (filter (const True)) $ t . (A.filter (const True))
107+ prop (desc ++ " filter even") $
108+ transformOp (filter even) $ t . (A.filter even)
110+ prop (desc ++ " take maxBound") $
111+ transformOp (take maxBound) $ t . (A.take maxBound)
112+ prop (desc ++ " take 0") $ transformOp (take 0) $ t . (A.take 0)
113+ prop (desc ++ " take 1") $ transformOp (take 1) $ t . (A.take 1)
114+ prop (desc ++ " take 10") $ transformOp (take 10) $ t . (A.take 10)
116+ prop (desc ++ " takeWhile True") $
117+ transformOp (takeWhile (const True)) $ t . (A.takeWhile (const True))
118+ prop (desc ++ " takeWhile False") $
119+ transformOp (takeWhile (const False)) $ t . (A.takeWhile (const False))
120+ prop (desc ++ " takeWhile > 0") $
121+ transformOp (takeWhile (> 0)) $ t . (A.takeWhile (> 0))
123+ prop (desc ++ " drop maxBound") $
124+ transformOp (drop maxBound) $ t . (A.drop maxBound)
125+ prop (desc ++ " drop 0") $ transformOp (drop 0) $ t . (A.drop 0)
126+ prop (desc ++ " drop 1") $ transformOp (drop 1) $ t . (A.drop 1)
127+ prop (desc ++ " drop 10") $ transformOp (drop 10) $ t . (A.drop 10)
129+ prop (desc ++ " dropWhile True") $
130+ transformOp (dropWhile (const True)) $ t . (A.dropWhile (const True))
131+ prop (desc ++ " dropWhile False") $
132+ transformOp (dropWhile (const False)) $ t . (A.dropWhile (const False))
133+ prop (desc ++ " dropWhile > 0") $
134+ transformOp (dropWhile (> 0)) $ t . (A.dropWhile (> 0))
135+ prop (desc ++ " scan") $ transformOp (scanl (+) 0) $ t . (A.scan (+) 0 id)
138+ prop (desc ++ " foldl") $
139+ eliminateOp (foldl (+) 0) $ (A.foldl (+) 0 id) . t
140+ prop (desc ++ " all") $ eliminateOp (all even) $ (A.all even) . t
141+ prop (desc ++ " any") $ eliminateOp (any even) $ (A.any even) . t
142+ prop (desc ++ " length") $ eliminateOp length $ A.length . t
143+ prop (desc ++ " sum") $ eliminateOp sum $ A.sum . t
144+ prop (desc ++ " sum") $ eliminateOp product $ A.product . t
151+ prop (desc ++ " head") $ eliminateOp (wrap head) $ A.head . t
152+ prop (desc ++ " last") $ eliminateOp (wrap last) $ A.last . t
153+ prop (desc ++ " maximum") $ eliminateOp (wrap maximum) $ A.maximum . t
154+ prop (desc ++ " minimum") $ eliminateOp (wrap minimum) $ A.minimum . t
158+ => String -> (t IO Word8 -> t IO Word8) -> Spec
159+transformOpsWord8 desc t = do
160+ prop (desc ++ " elem") $ elemOp t A.elem elem
161+ prop (desc ++ " elem") $ elemOp t A.notElem notElem
164+ :: (Streaming t, Monad (t IO), Semigroup (t IO Int), Alternative (t IO))
165+ => String -> (t IO Int -> t IO Int) -> Spec
166+semigroupOps desc t = do
167+ prop (desc ++ " <>") $ foldFromList (foldMapWith (<>) return) t
168+ prop (desc ++ " <=>") $ foldFromList (foldMapWith (<=>) return) t
169+ -- XXX equality should be multiset equality
170+ prop (desc ++ " <|>") $ foldFromList (foldMapWith (<|>) return) t
171+ prop (desc ++ " <|") $ foldFromList (foldMapWith (<|) return) t
174+ :: (Streaming t, Applicative (t IO))
175+ => (t IO (Int, Int) -> t IO (Int, Int))
176+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
179+applicativeOps t eq (a, b) = monadicIO $ do
180+ stream <- run ((A.toList . t) ((,) <$> (A.each a) <*> (A.each b)))
181+ let list = (,) <$> a <*> b
182+ equals eq stream list
185+ :: (Streaming t, Applicative (t IO))
186+ => (t IO (Int, Int) -> t IO (Int, Int))
187+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
190+zipApplicative t eq (a, b) = monadicIO $ do
191+ stream1 <- run ((A.toList . t) ((,) <$> (A.each a) <*> (A.each b)))
192+ stream2 <- run ((A.toList . t) (pure (,) <*> (A.each a) <*> (A.each b)))
193+ stream3 <- run ((A.toList . t) (A.zipWith (,) (A.each a) (A.each b)))
194+ let list = getZipList $ (,) <$> ZipList a <*> ZipList b
195+ equals eq stream1 list
196+ equals eq stream2 list
197+ equals eq stream3 list
200+ :: (Streaming t, Monad (t IO))
201+ => (t IO (Int, Int) -> t IO (Int, Int))
202+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
205+zipMonadic t eq (a, b) =
210+ (A.zipWithM (\x y -> return (x, y)) (A.each a) (A.each b)))
211+ let list = getZipList $ (,) <$> ZipList a <*> ZipList b
212+ equals eq stream list
215+ :: (Streaming t, Monad (t IO))
216+ => (t IO Int -> t IO Int)
217+ -> ([Int] -> [Int] -> Bool)
220+monadThen t eq (a, b) = monadicIO $ do
221+ stream <- run ((A.toList . t) ((A.each a) >> (A.each b)))
223+ equals eq stream list
226+ :: (Streaming t, Monad (t IO))
227+ => (t IO Int -> t IO Int)
228+ -> ([Int] -> [Int] -> Bool)
231+monadBind t eq (a, b) =
236+ ((A.each a) >>= \x -> (A.each b) >>= return . (+ x)))
237+ let list = a >>= \x -> b >>= return . (+ x)
238+ equals eq stream list
242+ prop "serially replicateM" $ constructWithReplicateM serially
244+ functorOps "serially" serially
245+ functorOps "interleaving" interleaving
246+ functorOps "zipping" zipping
247+ functorOps "asyncly" asyncly
248+ functorOps "parallely" parallely
249+ functorOps "zippingAsync" zippingAsync
251+ semigroupOps "serially" serially
252+ semigroupOps "interleaving" interleaving
254+ -- The tests using sorted equality are weaker tests
255+ -- We need to have stronger unit tests for all those
256+ -- XXX applicative with three arguments
257+ let sortEq a b = sort a == sort b
258+ prop "serially applicative" $ applicativeOps serially (==)
259+ prop "interleaving applicative" $ applicativeOps interleaving sortEq
260+ prop "asyncly applicative" $ applicativeOps asyncly sortEq
261+ prop "parallely applicative" $ applicativeOps parallely sortEq
262+ prop "zipping applicative" $ zipApplicative zipping (==)
264+ -- prop "zippingAsync applicative" $ zipApplicative zippingAsync (==)
265+ prop "zip monadic serially" $ zipMonadic serially (==)
266+ prop "zip monadic interleaving" $ zipMonadic interleaving (==)
267+ prop "zip monadic asyncly" $ zipMonadic asyncly (==)
268+ prop "zip monadic parallely" $ zipMonadic parallely (==)
270+ prop "serially monad then" $ monadThen serially (==)
271+ prop "interleaving monad then" $ monadThen interleaving sortEq
272+ prop "asyncly monad then" $ monadThen asyncly sortEq
273+ prop "parallely monad then" $ monadThen parallely sortEq
275+ prop "serially monad bind" $ monadBind serially (==)
276+ prop "interleaving monad bind" $ monadBind interleaving sortEq
277+ prop "asyncly monad bind" $ monadBind asyncly sortEq
278+ prop "parallely monad bind" $ monadBind parallely sortEq
280+ transformOps "serially" serially
281+ transformOps "interleaving" interleaving
282+ transformOps "zipping" zipping
283+ transformOps "asyncly" asyncly
284+ transformOps "parallely" parallely
286+ transformOpsWord8 "serially" serially
287+ transformOpsWord8 "interleaving" interleaving
288+ transformOpsWord8 "zipping" zipping
289+ transformOpsWord8 "asyncly" asyncly
290+ transformOpsWord8 "parallely" parallely