git.iko.soy/streamly
on ec08681 help sign in
streamly/test/Prop.hs
839 lines 35 kB history raw
1{-# LANGUAGE CPP #-}
3module Main (main) where
5import Control.Exception (BlockedIndefinitelyOnMVar(..), catches,
6 BlockedIndefinitelyOnSTM(..), Handler(..))
7import Control.Monad (when)
8import Control.Applicative (ZipList(..))
9import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)
10import Control.Monad (replicateM, replicateM_)
11import Data.IORef (readIORef, modifyIORef, newIORef)
12import Data.List (sort, foldl', scanl')
13import Data.Maybe (mapMaybe)
14import GHC.Word (Word8)
16import Test.Hspec.QuickCheck (prop)
17import Test.QuickCheck (counterexample, Property, withMaxSuccess)
18import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)
20import Test.Hspec
22import Streamly
23import Streamly.Prelude ((.:), nil)
24import qualified Streamly.Prelude as S
26-- Coverage build takes too long with default number of tests
27maxTestCount :: Int
28#ifdef DEVBUILD
29maxTestCount = 100
30#else
31maxTestCount = 10
32#endif
34singleton :: IsStream t => a -> t m a
35singleton a = a .: nil
37sortEq :: Ord a => [a] -> [a] -> Bool
38sortEq a b = sort a == sort b
40equals
41 :: (Show a, Monad m)
42 => (a -> a -> Bool) -> a -> a -> PropertyM m ()
43equals eq stream list = do
44 when (not $ stream `eq` list) $
45 monitor
46 (counterexample $
47 "stream " ++ show stream ++ " /= list " ++ show list)
48 assert (stream `eq` list)
50constructWithReplicateM
51 :: IsStream t
52 => (t IO Int -> SerialT IO Int)
53 -> Int
54 -> Int
55 -> Word8
56 -> Property
57constructWithReplicateM op thr buf len = withMaxSuccess maxTestCount $
58 monadicIO $ do
59 let x = return (1 :: Int)
60 stream <- run $ (S.toList . op) (maxThreads thr $ maxBuffer buf $
61 S.replicateM (fromIntegral len) x)
62 list <- run $ replicateM (fromIntegral len) x
63 equals (==) stream list
65transformFromList
66 :: ([Int] -> t IO Int)
67 -> ([Int] -> [Int] -> Bool)
68 -> ([Int] -> [Int])
69 -> (t IO Int -> SerialT IO Int)
70 -> [Int]
71 -> Property
72transformFromList constr eq listOp op a =
73 monadicIO $ do
74 stream <- run ((S.toList . op) (constr a))
75 let list = listOp a
76 equals eq stream list
78mvarExcHandler :: String -> BlockedIndefinitelyOnMVar -> IO ()
79mvarExcHandler label BlockedIndefinitelyOnMVar = do
80 error $ label ++ " " ++ "BlockedIndefinitelyOnMVar\n"
82stmExcHandler :: String -> BlockedIndefinitelyOnSTM -> IO ()
83stmExcHandler label BlockedIndefinitelyOnSTM = do
84 error $ label ++ " " ++ "BlockedIndefinitelyOnSTM\n"
86dbgMVar :: String -> IO () -> IO ()
87dbgMVar label action =
88 action `catches` [ Handler (mvarExcHandler label)
89 , Handler (stmExcHandler label)
90 ]
92-- | first n actions takeMVar and the last action performs putMVar n times
93mvarSequenceOp :: MVar () -> Word8 -> Word8 -> IO Word8
94mvarSequenceOp mv n x = do
95 let msg = show x ++ "/" ++ show n
96 if x < n
97 then dbgMVar ("take mvarSequenceOp " ++ msg) (takeMVar mv) >> return x
98 else dbgMVar ("put mvarSequenceOp" ++ msg)
99 (replicateM_ (fromIntegral n) (putMVar mv ())) >> return x
101concurrentMapM
102 :: ([Word8] -> t IO Word8)
103 -> ([Word8] -> [Word8] -> Bool)
104 -> (Word8 -> MVar () -> t IO Word8 -> SerialT IO Word8)
105 -> Word8
106 -> Property
107concurrentMapM constr eq op n =
108 monadicIO $ do
109 let list = [0..n]
110 stream <- run $ do
111 mv <- newEmptyMVar :: IO (MVar ())
112 (S.toList . (op n mv)) (constr list)
113 equals eq stream list
115concurrentFromFoldable
116 :: IsStream t
117 => ([Word8] -> [Word8] -> Bool)
118 -> (t IO Word8 -> SerialT IO Word8)
119 -> Word8
120 -> Property
121concurrentFromFoldable eq op n =
122 monadicIO $ do
123 let list = [0..n]
124 stream <- run $ do
125 mv <- newEmptyMVar :: IO (MVar ())
126 (S.toList . op) (S.fromFoldableM (map (mvarSequenceOp mv n) list))
127 equals eq stream list
129sourceUnfoldrM :: IsStream t => MVar () -> Word8 -> t IO Word8
130sourceUnfoldrM mv n = S.unfoldrM step 0
131 where
132 -- argument must be integer to avoid overflow of word8 at 255
133 step :: Int -> IO (Maybe (Word8, Int))
134 step cnt = do
135 let msg = show cnt ++ "/" ++ show n
136 if cnt > fromIntegral n
137 then return Nothing
138 else do
139 dbgMVar ("put sourceUnfoldrM " ++ msg) (putMVar mv ())
140 return (Just (fromIntegral cnt, cnt + 1))
142-- Note that this test is not guaranteed to succeed, because there is no
143-- guarantee of parallelism in case of Async/Ahead streams.
144concurrentUnfoldrM
145 :: IsStream t
146 => ([Word8] -> [Word8] -> Bool)
147 -> (t IO Word8 -> SerialT IO Word8)
148 -> Word8
149 -> Property
150concurrentUnfoldrM eq op n =
151 monadicIO $ do
152 -- XXX we should test empty list case as well
153 let list = [0..n]
154 stream <- run $ do
155 -- putStrLn $ "concurrentUnfoldrM: " ++ show n
156 mv <- newEmptyMVar :: IO (MVar ())
157 cnt <- newIORef 0
158 -- since unfoldr happens in parallel with the stream processing we
159 -- can do two takeMVar in one iteration. If it is not parallel then
160 -- this will not work and the test will fail.
161 S.toList $ do
162 x <- op (sourceUnfoldrM mv n)
163 -- results may not be yielded in order, in case of
164 -- Async/WAsync/Parallel. So we use an increasing count
165 -- instead.
166 i <- S.yieldM $ readIORef cnt
167 S.yieldM $ modifyIORef cnt (+1)
168 let msg = show i ++ "/" ++ show n
169 S.yieldM $ do
170 if even i
171 then do
172 dbgMVar ("first take concurrentUnfoldrM " ++ msg)
173 (takeMVar mv)
174 if n > i
175 then do
176 dbgMVar ("second take concurrentUnfoldrM " ++ msg)
177 (takeMVar mv)
178 else return ()
179 else return ()
180 return x
181 equals eq stream list
183concurrentApplication :: Word8 -> Property
184concurrentApplication n =
185 monadicIO $ do
186 -- XXX we should test empty list case as well
187 let list = [0..n]
188 stream <- run $ do
189 -- putStrLn $ "concurrentApplication: " ++ show n
190 mv <- newEmptyMVar :: IO (MVar ())
191 -- since unfoldr happens in parallel with the stream processing we
192 -- can do two takeMVar in one iteration. If it is not parallel then
193 -- this will not work and the test will fail.
194 S.toList $ do
195 sourceUnfoldrM mv n |&
196 (S.mapM $ \x -> do
197 let msg = show x ++ "/" ++ show n
198 if even x
199 then do
200 dbgMVar ("first take concurrentApp " ++ msg)
201 (takeMVar mv)
202 if n > x
203 then dbgMVar ("second take concurrentApp " ++ msg)
204 (takeMVar mv)
205 else return ()
206 else return ()
207 return x)
208 equals (==) stream list
210sourceUnfoldrM1 :: IsStream t => Word8 -> t IO Word8
211sourceUnfoldrM1 n = S.unfoldrM step 0
212 where
213 -- argument must be integer to avoid overflow of word8 at 255
214 step :: Int -> IO (Maybe (Word8, Int))
215 step cnt = do
216 if cnt > fromIntegral n
217 then return Nothing
218 else return (Just (fromIntegral cnt, cnt + 1))
220concurrentFoldlApplication :: Word8 -> Property
221concurrentFoldlApplication n =
222 monadicIO $ do
223 -- XXX we should test empty list case as well
224 let list = [0..n]
225 stream <- run $ do
226 sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) []
227 equals (==) (reverse stream) list
229concurrentFoldrApplication :: Word8 -> Property
230concurrentFoldrApplication n =
231 monadicIO $ do
232 -- XXX we should test empty list case as well
233 let list = [0..n]
234 stream <- run $ do
235 sourceUnfoldrM1 n |&. S.foldrM (\x xs -> return (x : xs)) []
236 equals (==) stream list
238transformCombineFromList
239 :: Semigroup (t IO Int)
240 => ([Int] -> t IO Int)
241 -> ([Int] -> [Int] -> Bool)
242 -> ([Int] -> [Int])
243 -> (t IO Int -> SerialT IO Int)
244 -> (t IO Int -> t IO Int)
245 -> [Int]
246 -> [Int]
247 -> [Int]
248 -> Property
249transformCombineFromList constr eq listOp t op a b c =
250 withMaxSuccess maxTestCount $
251 monadicIO $ do
252 stream <- run ((S.toList . t) $
253 constr a <> op (constr b <> constr c))
254 let list = a <> listOp (b <> c)
255 equals eq stream list
257foldFromList
258 :: ([Int] -> t IO Int)
259 -> (t IO Int -> SerialT IO Int)
260 -> ([Int] -> [Int] -> Bool)
261 -> [Int]
262 -> Property
263foldFromList constr op eq a = transformFromList constr eq id op a
265eliminateOp
266 :: (Show a, Eq a)
267 => ([Int] -> t IO Int)
268 -> ([Int] -> a)
269 -> (t IO Int -> IO a)
270 -> [Int]
271 -> Property
272eliminateOp constr listOp op a =
273 monadicIO $ do
274 stream <- run $ op (constr a)
275 let list = listOp a
276 equals (==) stream list
278elemOp
279 :: ([Word8] -> t IO Word8)
280 -> (t IO Word8 -> SerialT IO Word8)
281 -> (Word8 -> SerialT IO Word8 -> IO Bool)
282 -> (Word8 -> [Word8] -> Bool)
283 -> (Word8, [Word8])
284 -> Property
285elemOp constr op streamOp listOp (x, xs) =
286 monadicIO $ do
287 stream <- run $ (streamOp x . op) (constr xs)
288 let list = listOp x xs
289 equals (==) stream list
291functorOps
292 :: Functor (t IO)
293 => ([Int] -> t IO Int)
294 -> String
295 -> (t IO Int -> SerialT IO Int)
296 -> ([Int] -> [Int] -> Bool)
297 -> Spec
298functorOps constr desc t eq = do
299 prop (desc ++ " id") $ transformFromList constr eq id $ t
300 prop (desc ++ " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . (fmap (+1))
302transformOps
303 :: IsStream t
304 => ([Int] -> t IO Int)
305 -> String
306 -> (t IO Int -> SerialT IO Int)
307 -> ([Int] -> [Int] -> Bool)
308 -> Spec
309transformOps constr desc t eq = do
310 let transform = transformFromList constr eq
311 -- Filtering
312 prop (desc ++ " filter False") $
313 transform (filter (const False)) $ t . (S.filter (const False))
314 prop (desc ++ " filter True") $
315 transform (filter (const True)) $ t . (S.filter (const True))
316 prop (desc ++ " filter even") $
317 transform (filter even) $ t . (S.filter even)
319 prop (desc ++ " take maxBound") $
320 transform (take maxBound) $ t . (S.take maxBound)
321 prop (desc ++ " take 0") $ transform (take 0) $ t . (S.take 0)
322 prop (desc ++ " take 1") $ transform (take 1) $ t . (S.take 1)
323 prop (desc ++ " take 10") $ transform (take 10) $ t . (S.take 10)
325 prop (desc ++ " takeWhile True") $
326 transform (takeWhile (const True)) $ t . (S.takeWhile (const True))
327 prop (desc ++ " takeWhile False") $
328 transform (takeWhile (const False)) $ t . (S.takeWhile (const False))
329 prop (desc ++ " takeWhile > 0") $
330 transform (takeWhile (> 0)) $ t . (S.takeWhile (> 0))
332 let f x = if odd x then Just (x + 100) else Nothing
333 prop (desc ++ " mapMaybe") $ transform (mapMaybe f) $ t . (S.mapMaybe f)
335 prop (desc ++ " drop maxBound") $
336 transform (drop maxBound) $ t . (S.drop maxBound)
337 prop (desc ++ " drop 0") $ transform (drop 0) $ t . (S.drop 0)
338 prop (desc ++ " drop 1") $ transform (drop 1) $ t . (S.drop 1)
339 prop (desc ++ " drop 10") $ transform (drop 10) $ t . (S.drop 10)
341 prop (desc ++ " dropWhile True") $
342 transform (dropWhile (const True)) $ t . (S.dropWhile (const True))
343 prop (desc ++ " dropWhile False") $
344 transform (dropWhile (const False)) $ t . (S.dropWhile (const False))
345 prop (desc ++ " dropWhile > 0") $
346 transform (dropWhile (> 0)) $ t . (S.dropWhile (> 0))
347 prop (desc ++ " scan") $ transform (scanl' (+) 0) $ t . (S.scanl' (+) 0)
348 prop (desc ++ " reverse") $ transform reverse $ t . S.reverse
350concurrentOps
351 :: IsStream t
352 => ([Word8] -> t IO Word8)
353 -> String
354 -> (t IO Word8 -> SerialT IO Word8)
355 -> ([Word8] -> [Word8] -> Bool)
356 -> Spec
357concurrentOps constr desc t eq = do
358 let prop1 d p = prop d $ withMaxSuccess maxTestCount p
360 prop1 (desc ++ " fromFoldableM") $ concurrentFromFoldable eq t
361 prop1 (desc ++ " unfoldrM") $ concurrentUnfoldrM eq t
362 -- we pass it the length of the stream n and an mvar mv.
363 -- The stream is [0..n]. The threads communicate in such a way that the
364 -- actions coming first in the stream are dependent on the last action. So
365 -- if the stream is not processed concurrently it will block forever.
366 -- Note that if the size of the stream is bigger than the thread limit
367 -- then it will block even if it is concurrent.
368 prop1 (desc ++ " mapM") $
369 concurrentMapM constr eq $ \n mv stream ->
370 t $ S.mapM (mvarSequenceOp mv n) stream
372-- XXX add tests for MonadReader and MonadError etc. In case an SVar is
373-- accidentally passed through them.
374transformCombineOpsCommon
375 :: (IsStream t, Semigroup (t IO Int))
376 => ([Int] -> t IO Int)
377 -> String
378 -> (t IO Int -> SerialT IO Int)
379 -> ([Int] -> [Int] -> Bool)
380 -> Spec
381transformCombineOpsCommon constr desc t eq = do
382 let transform = transformCombineFromList constr eq
383 -- Filtering
384 prop (desc ++ " filter False") $
385 transform (filter (const False)) t (S.filter (const False))
386 prop (desc ++ " filter True") $
387 transform (filter (const True)) t (S.filter (const True))
388 prop (desc ++ " filter even") $
389 transform (filter even) t (S.filter even)
391 prop (desc ++ " filterM False") $
392 transform (filter (const False)) t (S.filterM (const $ return False))
393 prop (desc ++ " filterM True") $
394 transform (filter (const True)) t (S.filterM (const $ return True))
395 prop (desc ++ " filterM even") $
396 transform (filter even) t (S.filterM (return . even))
398 prop (desc ++ " take maxBound") $
399 transform (take maxBound) t (S.take maxBound)
400 prop (desc ++ " take 0") $ transform (take 0) t (S.take 0)
402 prop (desc ++ " takeWhile True") $
403 transform (takeWhile (const True)) t (S.takeWhile (const True))
404 prop (desc ++ " takeWhile False") $
405 transform (takeWhile (const False)) t (S.takeWhile (const False))
407 prop (desc ++ " takeWhileM True") $
408 transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))
409 prop (desc ++ " takeWhileM False") $
410 transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))
412 prop (desc ++ " drop maxBound") $
413 transform (drop maxBound) t (S.drop maxBound)
414 prop (desc ++ " drop 0") $ transform (drop 0) t (S.drop 0)
416 prop (desc ++ " dropWhile True") $
417 transform (dropWhile (const True)) t (S.dropWhile (const True))
418 prop (desc ++ " dropWhile False") $
419 transform (dropWhile (const False)) t (S.dropWhile (const False))
421 prop (desc ++ " dropWhileM True") $
422 transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))
423 prop (desc ++ " dropWhileM False") $
424 transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))
426 prop (desc ++ " mapM (+1)") $
427 transform (map (+1)) t (S.mapM (\x -> return (x + 1)))
429 prop (desc ++ " scan") $ transform (scanl' (flip const) 0) t
430 (S.scanl' (flip const) 0)
431 prop (desc ++ " scanlM'") $ transform (scanl' (flip const) 0) t
432 (S.scanlM' (\_ a -> return a) 0)
433 prop (desc ++ " reverse") $ transform reverse t S.reverse
435transformCombineOpsOrdered
436 :: (IsStream t, Semigroup (t IO Int))
437 => ([Int] -> t IO Int)
438 -> String
439 -> (t IO Int -> SerialT IO Int)
440 -> ([Int] -> [Int] -> Bool)
441 -> Spec
442transformCombineOpsOrdered constr desc t eq = do
443 let transform = transformCombineFromList constr eq
444 -- Filtering
445 prop (desc ++ " take 1") $ transform (take 1) t (S.take 1)
446 prop (desc ++ " take 10") $ transform (take 10) t (S.take 10)
448 prop (desc ++ " takeWhile > 0") $
449 transform (takeWhile (> 0)) t (S.takeWhile (> 0))
451 prop (desc ++ " drop 1") $ transform (drop 1) t (S.drop 1)
452 prop (desc ++ " drop 10") $ transform (drop 10) t (S.drop 10)
454 prop (desc ++ " dropWhile > 0") $
455 transform (dropWhile (> 0)) t (S.dropWhile (> 0))
456 prop (desc ++ " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)
458wrapMaybe :: Eq a1 => ([a1] -> a2) -> [a1] -> Maybe a2
459wrapMaybe f =
460 \x ->
461 if x == []
462 then Nothing
463 else Just (f x)
465eliminationOps
466 :: ([Int] -> t IO Int)
467 -> String
468 -> (t IO Int -> SerialT IO Int)
469 -> Spec
470eliminationOps constr desc t = do
471 -- Elimination
472 prop (desc ++ " null") $ eliminateOp constr null $ S.null . t
473 prop (desc ++ " foldl") $
474 eliminateOp constr (foldl' (+) 0) $ (S.foldl' (+) 0) . t
475 prop (desc ++ " all") $ eliminateOp constr (all even) $ (S.all even) . t
476 prop (desc ++ " any") $ eliminateOp constr (any even) $ (S.any even) . t
477 prop (desc ++ " length") $ eliminateOp constr length $ S.length . t
478 prop (desc ++ " sum") $ eliminateOp constr sum $ S.sum . t
479 prop (desc ++ " product") $ eliminateOp constr product $ S.product . t
481 prop (desc ++ " maximum") $ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t
482 prop (desc ++ " minimum") $ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t
484-- head/tail/last may depend on the order in case of parallel streams
485-- so we test these only for serial streams.
486serialEliminationOps
487 :: ([Int] -> t IO Int)
488 -> String
489 -> (t IO Int -> SerialT IO Int)
490 -> Spec
491serialEliminationOps constr desc t = do
492 prop (desc ++ " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t
493 prop (desc ++ " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do
494 r <- S.tail (t x)
495 case r of
496 Nothing -> return Nothing
497 Just s -> S.toList s >>= return . Just
498 prop (desc ++ " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t
500transformOpsWord8
501 :: ([Word8] -> t IO Word8)
502 -> String
503 -> (t IO Word8 -> SerialT IO Word8)
504 -> Spec
505transformOpsWord8 constr desc t = do
506 prop (desc ++ " elem") $ elemOp constr t S.elem elem
507 prop (desc ++ " elem") $ elemOp constr t S.notElem notElem
509-- XXX concatenate streams of multiple elements rather than single elements
510semigroupOps
511 :: (IsStream t
513#if __GLASGOW_HASKELL__ < 804
514 , Semigroup (t IO Int)
515#endif
516 , Monoid (t IO Int))
517 => String
518 -> (t IO Int -> SerialT IO Int)
519 -> ([Int] -> [Int] -> Bool)
520 -> Spec
521semigroupOps desc t eq = do
522 prop (desc ++ " <>") $ foldFromList (foldMapWith (<>) singleton) t eq
523 prop (desc ++ " mappend") $ foldFromList (foldMapWith mappend singleton) t eq
525applicativeOps
526 :: Applicative (t IO)
527 => ([Int] -> t IO Int)
528 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
529 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
530 -> ([Int], [Int])
531 -> Property
532applicativeOps constr t eq (a, b) = withMaxSuccess maxTestCount $
533 monadicIO $ do
534 stream <- run ((S.toList . t) ((,) <$> (constr a) <*> (constr b)))
535 let list = (,) <$> a <*> b
536 equals eq stream list
538zipApplicative
539 :: (IsStream t, Applicative (t IO))
540 => ([Int] -> t IO Int)
541 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
542 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
543 -> ([Int], [Int])
544 -> Property
545zipApplicative constr t eq (a, b) = withMaxSuccess maxTestCount $
546 monadicIO $ do
547 stream1 <- run ((S.toList . t) ((,) <$> (constr a) <*> (constr b)))
548 stream2 <- run ((S.toList . t) (pure (,) <*> (constr a) <*> (constr b)))
549 stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))
550 let list = getZipList $ (,) <$> ZipList a <*> ZipList b
551 equals eq stream1 list
552 equals eq stream2 list
553 equals eq stream3 list
555zipMonadic
556 :: IsStream t
557 => ([Int] -> t IO Int)
558 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
559 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
560 -> ([Int], [Int])
561 -> Property
562zipMonadic constr t eq (a, b) = withMaxSuccess maxTestCount $
563 monadicIO $ do
564 stream1 <-
565 run
566 ((S.toList . t)
567 (S.zipWithM (\x y -> return (x, y)) (constr a) (constr b)))
568 stream2 <-
569 run
570 ((S.toList . t)
571 (S.zipAsyncWithM (\x y -> return (x, y)) (constr a) (constr b)))
572 let list = getZipList $ (,) <$> ZipList a <*> ZipList b
573 equals eq stream1 list
574 equals eq stream2 list
576monadThen
577 :: Monad (t IO)
578 => ([Int] -> t IO Int)
579 -> (t IO Int -> SerialT IO Int)
580 -> ([Int] -> [Int] -> Bool)
581 -> ([Int], [Int])
582 -> Property
583monadThen constr t eq (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do
584 stream <- run ((S.toList . t) ((constr a) >> (constr b)))
585 let list = a >> b
586 equals eq stream list
588monadBind
589 :: Monad (t IO)
590 => ([Int] -> t IO Int)
591 -> (t IO Int -> SerialT IO Int)
592 -> ([Int] -> [Int] -> Bool)
593 -> ([Int], [Int])
594 -> Property
595monadBind constr t eq (a, b) = withMaxSuccess maxTestCount $
596 monadicIO $ do
597 stream <-
598 run
599 ((S.toList . t)
600 ((constr a) >>= \x -> (constr b) >>= return . (+ x)))
601 let list = a >>= \x -> b >>= return . (+ x)
602 equals eq stream list
604constructionConcurrent :: Int -> Int -> Spec
605constructionConcurrent thr buf = do
606 describe (" threads = " ++ show thr ++ "buffer = " ++ show buf) $ do
607 prop "asyncly replicateM" $ constructWithReplicateM asyncly thr buf
608 prop "wAsyncly replicateM" $ constructWithReplicateM wAsyncly thr buf
609 prop "parallely replicateM" $ constructWithReplicateM parallely thr buf
610 prop "aheadly replicateM" $ constructWithReplicateM aheadly thr buf
612-- XXX test all concurrent ops for all these combinations
613concurrentAll :: String -> (Int -> Int -> Spec) -> Spec
614concurrentAll desc f = do
615 describe desc $ do
616 f 0 0 -- default
617 f 0 1 -- single buffer
618 f 1 0 -- single thread
619 f (-1) (-1) -- unbounded threads and buffer
621main :: IO ()
622main = hspec $ do
623 let folded :: IsStream t => [a] -> t IO a
624 folded = serially . (\xs ->
625 case xs of
626 [x] -> return x -- singleton stream case
627 _ -> foldMapWith (<>) return xs
628 )
629 describe "Construction" $ do
630 prop "serially replicateM" $ constructWithReplicateM serially 0 0
631 it "iterate" $
632 (S.toList . serially . (S.take 100) $ (S.iterate (+ 1) (0 :: Int)))
633 `shouldReturn` (take 100 $ iterate (+ 1) 0)
634 -- XXX test for all types of streams
635 it "iterateM" $ do
636 let addM = (\ y -> return (y + 1))
637 S.toList . serially . (S.take 100) $ S.iterateM addM (0 :: Int)
638 `shouldReturn` (take 100 $ iterate (+ 1) 0)
639 concurrentAll "Construction" constructionConcurrent
641 describe "Functor operations" $ do
642 functorOps S.fromFoldable "serially" serially (==)
643 functorOps folded "serially folded" serially (==)
644 functorOps S.fromFoldable "wSerially" wSerially (==)
645 functorOps folded "wSerially folded" wSerially (==)
646 functorOps S.fromFoldable "aheadly" aheadly (==)
647 functorOps folded "aheadly folded" aheadly (==)
648 functorOps S.fromFoldable "asyncly" asyncly sortEq
649 functorOps folded "asyncly folded" asyncly sortEq
650 functorOps S.fromFoldable "wAsyncly" wAsyncly sortEq
651 functorOps folded "wAsyncly folded" wAsyncly sortEq
652 functorOps S.fromFoldable "parallely" parallely sortEq
653 functorOps folded "parallely folded" parallely sortEq
654 functorOps S.fromFoldable "zipSerially" zipSerially (==)
655 functorOps folded "zipSerially folded" zipSerially (==)
656 functorOps S.fromFoldable "zipAsyncly" zipAsyncly (==)
657 functorOps folded "zipAsyncly folded" zipAsyncly (==)
659 describe "Semigroup operations" $ do
660 semigroupOps "serially" serially (==)
661 semigroupOps "wSerially" wSerially (==)
662 semigroupOps "aheadly" aheadly (==)
663 semigroupOps "asyncly" asyncly sortEq
664 semigroupOps "wAsyncly" wAsyncly sortEq
665 semigroupOps "parallely" parallely sortEq
666 semigroupOps "zipSerially" zipSerially (==)
667 semigroupOps "zipAsyncly" zipAsyncly (==)
669 describe "Applicative operations" $ do
670 -- The tests using sorted equality are weaker tests
671 -- We need to have stronger unit tests for all those
672 -- XXX applicative with three arguments
673 prop "serially applicative" $ applicativeOps S.fromFoldable serially (==)
674 prop "serially applicative folded" $ applicativeOps folded serially (==)
675 prop "aheadly applicative" $ applicativeOps S.fromFoldable aheadly (==)
676 prop "aheadly applicative folded" $ applicativeOps folded aheadly (==)
677 prop "wSerially applicative" $ applicativeOps S.fromFoldable wSerially sortEq
678 prop "wSerially applicative folded" $ applicativeOps folded wSerially sortEq
679 prop "asyncly applicative" $ applicativeOps S.fromFoldable asyncly sortEq
680 prop "asyncly applicative folded" $ applicativeOps folded asyncly sortEq
681 prop "wAsyncly applicative folded" $ applicativeOps folded wAsyncly sortEq
682 prop "parallely applicative folded" $ applicativeOps folded parallely sortEq
684 describe "Zip operations" $ do
685 prop "zipSerially applicative" $ zipApplicative S.fromFoldable zipSerially (==)
686 prop "zipSerially applicative folded" $ zipApplicative folded zipSerially (==)
687 prop "zipAsyncly applicative" $ zipApplicative S.fromFoldable zipAsyncly (==)
688 prop "zipAsyncly applicative folded" $ zipApplicative folded zipAsyncly (==)
690 prop "zip monadic serially" $ zipMonadic S.fromFoldable serially (==)
691 prop "zip monadic serially folded" $ zipMonadic folded serially (==)
692 prop "zip monadic aheadly" $ zipMonadic S.fromFoldable aheadly (==)
693 prop "zip monadic aheadly folded" $ zipMonadic folded aheadly (==)
694 prop "zip monadic wSerially" $ zipMonadic S.fromFoldable wSerially (==)
695 prop "zip monadic wSerially folded" $ zipMonadic folded wSerially (==)
696 prop "zip monadic asyncly" $ zipMonadic S.fromFoldable asyncly (==)
697 prop "zip monadic asyncly folded" $ zipMonadic folded asyncly (==)
698 prop "zip monadic wAsyncly" $ zipMonadic S.fromFoldable wAsyncly (==)
699 prop "zip monadic wAsyncly folded" $ zipMonadic folded wAsyncly (==)
700 prop "zip monadic parallely" $ zipMonadic S.fromFoldable parallely (==)
701 prop "zip monadic parallely folded" $ zipMonadic folded parallely (==)
703 describe "Monad operations" $ do
704 prop "serially monad then" $ monadThen S.fromFoldable serially (==)
705 prop "aheadly monad then" $ monadThen S.fromFoldable aheadly (==)
706 prop "wSerially monad then" $ monadThen S.fromFoldable wSerially sortEq
707 prop "asyncly monad then" $ monadThen S.fromFoldable asyncly sortEq
708 prop "wAsyncly monad then" $ monadThen S.fromFoldable wAsyncly sortEq
709 prop "parallely monad then" $ monadThen S.fromFoldable parallely sortEq
711 prop "serially monad then folded" $ monadThen folded serially (==)
712 prop "aheadly monad then folded" $ monadThen folded aheadly (==)
713 prop "wSerially monad then folded" $ monadThen folded wSerially sortEq
714 prop "asyncly monad then folded" $ monadThen folded asyncly sortEq
715 prop "wAsyncly monad then folded" $ monadThen folded wAsyncly sortEq
716 prop "parallely monad then folded" $ monadThen folded parallely sortEq
718 prop "serially monad bind" $ monadBind S.fromFoldable serially (==)
719 prop "aheadly monad bind" $ monadBind S.fromFoldable aheadly (==)
720 prop "wSerially monad bind" $ monadBind S.fromFoldable wSerially sortEq
721 prop "asyncly monad bind" $ monadBind S.fromFoldable asyncly sortEq
722 prop "wAsyncly monad bind" $ monadBind S.fromFoldable wAsyncly sortEq
723 prop "parallely monad bind" $ monadBind S.fromFoldable parallely sortEq
725 describe "Stream transform operations" $ do
726 transformOps S.fromFoldable "serially" serially (==)
727 transformOps S.fromFoldable "aheadly" aheadly (==)
728 transformOps S.fromFoldable "wSerially" wSerially (==)
729 transformOps S.fromFoldable "zipSerially" zipSerially (==)
730 transformOps S.fromFoldable "zipAsyncly" zipAsyncly (==)
731 transformOps S.fromFoldable "asyncly" asyncly sortEq
732 transformOps S.fromFoldable "wAsyncly" wAsyncly sortEq
733 transformOps S.fromFoldable "parallely" parallely sortEq
735 transformOps folded "serially folded" serially (==)
736 transformOps folded "aheadly folded" aheadly (==)
737 transformOps folded "wSerially folded" wSerially (==)
738 transformOps folded "zipSerially folded" zipSerially (==)
739 transformOps folded "zipAsyncly folded" zipAsyncly (==)
740 transformOps folded "asyncly folded" asyncly sortEq
741 transformOps folded "wAsyncly folded" wAsyncly sortEq
742 transformOps folded "parallely folded" parallely sortEq
744 transformOpsWord8 S.fromFoldable "serially" serially
745 transformOpsWord8 S.fromFoldable "aheadly" aheadly
746 transformOpsWord8 S.fromFoldable "wSerially" wSerially
747 transformOpsWord8 S.fromFoldable "zipSerially" zipSerially
748 transformOpsWord8 S.fromFoldable "zipAsyncly" zipAsyncly
749 transformOpsWord8 S.fromFoldable "asyncly" asyncly
750 transformOpsWord8 S.fromFoldable "wAsyncly" wAsyncly
751 transformOpsWord8 S.fromFoldable "parallely" parallely
753 transformOpsWord8 folded "serially folded" serially
754 transformOpsWord8 folded "aheadly folded" aheadly
755 transformOpsWord8 folded "wSerially folded" wSerially
756 transformOpsWord8 folded "zipSerially folded" zipSerially
757 transformOpsWord8 folded "zipAsyncly folded" zipAsyncly
758 transformOpsWord8 folded "asyncly folded" asyncly
759 transformOpsWord8 folded "wAsyncly folded" wAsyncly
760 transformOpsWord8 folded "parallely folded" parallely
762 -- XXX add tests with outputQueue size set to 1
763 describe "Stream concurrent operations" $ do
764 concurrentOps S.fromFoldable "aheadly" aheadly (==)
765 concurrentOps S.fromFoldable "asyncly" asyncly sortEq
766 concurrentOps S.fromFoldable "wAsyncly" wAsyncly sortEq
767 concurrentOps S.fromFoldable "parallely" parallely sortEq
769 concurrentOps folded "aheadly folded" aheadly (==)
770 concurrentOps folded "asyncly folded" asyncly sortEq
771 concurrentOps folded "wAsyncly folded" wAsyncly sortEq
772 concurrentOps folded "parallely folded" parallely sortEq
774 prop "concurrent application" $ withMaxSuccess maxTestCount $
775 concurrentApplication
776 prop "concurrent foldr application" $ withMaxSuccess maxTestCount $
777 concurrentFoldrApplication
778 prop "concurrent foldl application" $ withMaxSuccess maxTestCount $
779 concurrentFoldlApplication
781 -- These tests are specifically targeted towards detecting illegal sharing
782 -- of SVar across conurrent streams.
783 describe "Stream transform and combine operations" $ do
784 transformCombineOpsCommon S.fromFoldable "serially" serially (==)
785 transformCombineOpsCommon S.fromFoldable "aheadly" aheadly (==)
786 transformCombineOpsCommon S.fromFoldable "wSerially" wSerially sortEq
787 transformCombineOpsCommon S.fromFoldable "zipSerially" zipSerially (==)
788 transformCombineOpsCommon S.fromFoldable "zipAsyncly" zipAsyncly (==)
789 transformCombineOpsCommon S.fromFoldable "asyncly" asyncly sortEq
790 transformCombineOpsCommon S.fromFoldable "wAsyncly" wAsyncly sortEq
791 transformCombineOpsCommon S.fromFoldable "parallely" parallely sortEq
793 transformCombineOpsCommon folded "serially" serially (==)
794 transformCombineOpsCommon folded "aheadly" aheadly (==)
795 transformCombineOpsCommon folded "wSerially" wSerially sortEq
796 transformCombineOpsCommon folded "zipSerially" zipSerially (==)
797 transformCombineOpsCommon folded "zipAsyncly" zipAsyncly (==)
798 transformCombineOpsCommon folded "asyncly" asyncly sortEq
799 transformCombineOpsCommon folded "wAsyncly" wAsyncly sortEq
800 transformCombineOpsCommon folded "parallely" parallely sortEq
802 transformCombineOpsOrdered S.fromFoldable "serially" serially (==)
803 transformCombineOpsOrdered S.fromFoldable "serially" aheadly (==)
804 transformCombineOpsOrdered S.fromFoldable "zipSerially" zipSerially (==)
805 transformCombineOpsOrdered S.fromFoldable "zipAsyncly" zipAsyncly (==)
807 describe "Stream elimination operations" $ do
808 eliminationOps S.fromFoldable "serially" serially
809 eliminationOps S.fromFoldable "aheadly" aheadly
810 eliminationOps S.fromFoldable "wSerially" wSerially
811 eliminationOps S.fromFoldable "zipSerially" zipSerially
812 eliminationOps S.fromFoldable "zipAsyncly" zipAsyncly
813 eliminationOps S.fromFoldable "asyncly" asyncly
814 eliminationOps S.fromFoldable "wAsyncly" wAsyncly
815 eliminationOps S.fromFoldable "parallely" parallely
817 eliminationOps folded "serially folded" serially
818 eliminationOps folded "aheadly folded" aheadly
819 eliminationOps folded "wSerially folded" wSerially
820 eliminationOps folded "zipSerially folded" zipSerially
821 eliminationOps folded "zipAsyncly folded" zipAsyncly
822 eliminationOps folded "asyncly folded" asyncly
823 eliminationOps folded "wAsyncly folded" wAsyncly
824 eliminationOps folded "parallely folded" parallely
826 -- XXX Add a test where we chain all transformation APIs and make sure that
827 -- the state is being passed through all of them.
828 describe "Stream serial elimination operations" $ do
829 serialEliminationOps S.fromFoldable "serially" serially
830 serialEliminationOps S.fromFoldable "aheadly" aheadly
831 serialEliminationOps S.fromFoldable "wSerially" wSerially
832 serialEliminationOps S.fromFoldable "zipSerially" zipSerially
833 serialEliminationOps S.fromFoldable "zipAsyncly" zipAsyncly
835 serialEliminationOps folded "serially folded" serially
836 serialEliminationOps folded "aheadly folded" aheadly
837 serialEliminationOps folded "wSerially folded" wSerially
838 serialEliminationOps folded "zipSerially folded" zipSerially
839 serialEliminationOps folded "zipAsyncly folded" zipAsyncly