@@ -0,0 +1,290 @@
1+module Main (main) where
2+
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)
8+
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)
13+
14+import Streamly
15+import qualified Streamly.Prelude as A
16+
17+equals
18+ :: (Show a, Monad m)
19+ => (a -> a -> Bool) -> a -> a -> PropertyM m ()
20+equals eq stream list = do
21+ when (not $ stream `eq` list) $
22+ monitor
23+ (counterexample $
24+ "stream " ++ show stream ++ " /= list " ++ show list)
25+ assert (stream `eq` list)
26+
27+constructWithReplicateM
28+ :: (Streaming t)
29+ => (t IO Int -> t IO Int)
30+ -> Word8
31+ -> Property
32+constructWithReplicateM op len =
33+ monadicIO $ do
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
38+
39+transformFromList
40+ :: (Streaming t)
41+ => ([Int] -> t IO Int)
42+ -> ([Int] -> [Int])
43+ -> (t IO Int -> t IO Int)
44+ -> [Int]
45+ -> Property
46+transformFromList constr listOp op a =
47+ monadicIO $ do
48+ stream <- run ((A.toList . op) (constr a))
49+ let list = listOp a
50+ equals (==) stream list
51+
52+foldFromList
53+ :: (Streaming t)
54+ => ([Int] -> t IO Int)
55+ -> (t IO Int -> t IO Int)
56+ -> [Int]
57+ -> Property
58+foldFromList constr op a = transformFromList constr id op a
59+
60+eliminateOp
61+ :: (Streaming t, Show a, Eq a)
62+ => ([Int] -> a)
63+ -> (t IO Int -> IO a)
64+ -> [Int]
65+ -> Property
66+eliminateOp listOp op a =
67+ monadicIO $ do
68+ stream <- run $ op (A.each a)
69+ let list = listOp a
70+ equals (==) stream list
71+
72+elemOp
73+ :: (Streaming t)
74+ => (t IO Word8 -> t IO Word8)
75+ -> (Word8 -> t IO Word8 -> IO Bool)
76+ -> (Word8 -> [Word8] -> Bool)
77+ -> (Word8, [Word8])
78+ -> Property
79+elemOp op streamOp listOp (x, xs) =
80+ monadicIO $ do
81+ stream <- run $ (streamOp x . op) (A.each xs)
82+ let list = listOp x xs
83+ equals (==) stream list
84+
85+transformOp
86+ :: (Streaming t)
87+ => ([Int] -> [Int]) -> (t IO Int -> t IO Int) -> [Int] -> Property
88+transformOp = transformFromList (A.each)
89+
90+functorOps
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))
96+
97+transformOps
98+ :: Streaming t
99+ => String -> (t IO Int -> t IO Int) -> Spec
100+transformOps desc t
101+ = do
102+ -- Filtering
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)
109+
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)
115+
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))
122+
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)
128+
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)
136+
137+ -- Elimination
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
145+
146+ let wrap f =
147+ \x ->
148+ if x == []
149+ then Nothing
150+ else Just (f x)
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
155+
156+transformOpsWord8
157+ :: Streaming 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
162+
163+semigroupOps
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
172+
173+applicativeOps
174+ :: (Streaming t, Applicative (t IO))
175+ => (t IO (Int, Int) -> t IO (Int, Int))
176+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
177+ -> ([Int], [Int])
178+ -> Property
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
183+
184+zipApplicative
185+ :: (Streaming t, Applicative (t IO))
186+ => (t IO (Int, Int) -> t IO (Int, Int))
187+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
188+ -> ([Int], [Int])
189+ -> Property
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
198+
199+zipMonadic
200+ :: (Streaming t, Monad (t IO))
201+ => (t IO (Int, Int) -> t IO (Int, Int))
202+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
203+ -> ([Int], [Int])
204+ -> Property
205+zipMonadic t eq (a, b) =
206+ monadicIO $ do
207+ stream <-
208+ run
209+ ((A.toList . t)
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
213+
214+monadThen
215+ :: (Streaming t, Monad (t IO))
216+ => (t IO Int -> t IO Int)
217+ -> ([Int] -> [Int] -> Bool)
218+ -> ([Int], [Int])
219+ -> Property
220+monadThen t eq (a, b) = monadicIO $ do
221+ stream <- run ((A.toList . t) ((A.each a) >> (A.each b)))
222+ let list = a >> b
223+ equals eq stream list
224+
225+monadBind
226+ :: (Streaming t, Monad (t IO))
227+ => (t IO Int -> t IO Int)
228+ -> ([Int] -> [Int] -> Bool)
229+ -> ([Int], [Int])
230+ -> Property
231+monadBind t eq (a, b) =
232+ monadicIO $ do
233+ stream <-
234+ run
235+ ((A.toList . t)
236+ ((A.each a) >>= \x -> (A.each b) >>= return . (+ x)))
237+ let list = a >>= \x -> b >>= return . (+ x)
238+ equals eq stream list
239+
240+main :: IO ()
241+main = hspec $ do
242+ prop "serially replicateM" $ constructWithReplicateM serially
243+
244+ functorOps "serially" serially
245+ functorOps "interleaving" interleaving
246+ functorOps "zipping" zipping
247+ functorOps "asyncly" asyncly
248+ functorOps "parallely" parallely
249+ functorOps "zippingAsync" zippingAsync
250+
251+ semigroupOps "serially" serially
252+ semigroupOps "interleaving" interleaving
253+
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 (==)
263+ -- XXX this hangs
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 (==)
269+
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
274+
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
279+
280+ transformOps "serially" serially
281+ transformOps "interleaving" interleaving
282+ transformOps "zipping" zipping
283+ transformOps "asyncly" asyncly
284+ transformOps "parallely" parallely
285+
286+ transformOpsWord8 "serially" serially
287+ transformOpsWord8 "interleaving" interleaving
288+ transformOpsWord8 "zipping" zipping
289+ transformOpsWord8 "asyncly" asyncly
290+ transformOpsWord8 "parallely" parallely