git.iko.soy/streamly
on 4172ad9 help sign in
streamly/test/Prop.hs
1311 lines 55 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedLists #-}
3{-# LANGUAGE TypeFamilies #-}
5module Main (main) where
7import Control.Applicative (ZipList(..))
8import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)
9import Control.Exception
10 (BlockedIndefinitelyOnMVar(..), catches,
11 BlockedIndefinitelyOnSTM(..), Handler(..))
12import Control.Monad (when, forM_, replicateM, replicateM_)
13import Control.Monad.IO.Class (MonadIO(..))
14import Data.Function ((&))
15import Data.IORef (readIORef, modifyIORef, newIORef, modifyIORef', IORef)
16import Data.List
17 (sort, foldl', scanl', findIndices, findIndex, elemIndices,
18 elemIndex, find, insertBy, intersperse, foldl1', (\\),
19 maximumBy, minimumBy, deleteBy, isPrefixOf, isSubsequenceOf,
20 stripPrefix, intercalate)
21import Data.Maybe (mapMaybe)
22import GHC.Word (Word8)
24import Test.Hspec.QuickCheck
25import Test.QuickCheck
26 (counterexample, Property, withMaxSuccess, forAll, choose, Gen,
27 arbitrary, elements, frequency, listOf) --, listOf1, vectorOf, suchThat)
28import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)
30import Test.Hspec as H
32import Streamly
33import Streamly.Prelude ((.:), nil)
34import Streamly as S
35import qualified Streamly.Prelude as S
36import qualified Streamly.Data.Fold as FL
38-- Coverage build takes too long with default number of tests
39maxTestCount :: Int
40#ifdef DEVBUILD
41maxTestCount = 100
42#else
43maxTestCount = 10
44#endif
46singleton :: IsStream t => a -> t m a
47singleton a = a .: nil
49sortEq :: Ord a => [a] -> [a] -> Bool
50sortEq a b = sort a == sort b
52equals
53 :: (Show a, Monad m)
54 => (a -> a -> Bool) -> a -> a -> PropertyM m ()
55equals eq stream list = do
56 when (not $ stream `eq` list) $
57 monitor
58 (counterexample $
59 "stream " <> show stream
60 <> "\nlist " <> show list
61 )
62 assert (stream `eq` list)
64listEquals
65 :: (Show a, Eq a, MonadIO m)
66 => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
67listEquals eq stream list = do
68 when (not $ stream `eq` list) $ liftIO $ putStrLn $
69 "stream " <> show stream
70 <> "\nlist " <> show list
71 <> "\nstream \\\\ list " <> show (stream \\ list)
72 <> "\nlist \\\\ stream " <> show (list \\ stream)
73 when (not $ stream `eq` list) $
74 monitor
75 (counterexample $
76 "stream " <> show stream
77 <> "\nlist " <> show list
78 <> "\nstream \\\\ list " <> show (stream \\ list)
79 <> "\nlist \\\\ stream " <> show (list \\ stream)
80 )
81 assert (stream `eq` list)
83-------------------------------------------------------------------------------
84-- Construction operations
85-------------------------------------------------------------------------------
87constructWithLen
88 :: (Show a, Eq a)
89 => (Int -> t IO a)
90 -> (Int -> [a])
91 -> (t IO a -> SerialT IO a)
92 -> Word8
93 -> Property
94constructWithLen mkStream mkList op len = withMaxSuccess maxTestCount $
95 monadicIO $ do
96 stream <- run $ (S.toList . op) (mkStream (fromIntegral len))
97 let list = mkList (fromIntegral len)
98 listEquals (==) stream list
100constructWithLenM
101 :: (Int -> t IO Int)
102 -> (Int -> IO [Int])
103 -> (t IO Int -> SerialT IO Int)
104 -> Word8
105 -> Property
106constructWithLenM mkStream mkList op len = withMaxSuccess maxTestCount $
107 monadicIO $ do
108 stream <- run $ (S.toList . op) (mkStream (fromIntegral len))
109 list <- run $ mkList (fromIntegral len)
110 listEquals (==) stream list
112constructWithReplicate, constructWithReplicateM, constructWithIntFromThenTo
113 :: IsStream t
114 => (t IO Int -> SerialT IO Int)
115 -> Word8
116 -> Property
118constructWithReplicateM = constructWithLenM stream list
119 where list = flip replicateM (return 1 :: IO Int)
120 stream = flip S.replicateM (return 1 :: IO Int)
122constructWithReplicate = constructWithLen stream list
123 where list = flip replicate (1 :: Int)
124 stream = flip S.replicate (1 :: Int)
126constructWithIntFromThenTo op l =
127 forAll (choose (minBound, maxBound)) $ \from ->
128 forAll (choose (minBound, maxBound)) $ \next ->
129 forAll (choose (minBound, maxBound)) $ \to ->
130 let list len = take len [from,next..to]
131 stream len = S.take len $ S.enumerateFromThenTo from next to
132 in constructWithLen stream list op l
134#if __GLASGOW_HASKELL__ >= 806
135-- XXX try very small steps close to 0
136constructWithDoubleFromThenTo
137 :: IsStream t
138 => (t IO Double -> SerialT IO Double)
139 -> Word8
140 -> Property
141constructWithDoubleFromThenTo op l =
142 forAll (choose (-9007199254740999,9007199254740999)) $ \from ->
143 forAll (choose (-9007199254740999,9007199254740999)) $ \next ->
144 forAll (choose (-9007199254740999,9007199254740999)) $ \to ->
145 let list len = take len [from,next..to]
146 stream len = S.take len $ S.enumerateFromThenTo from next to
147 in constructWithLen stream list op l
148#endif
150constructWithIterate ::
151 IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
152constructWithIterate op len =
153 withMaxSuccess maxTestCount $
154 monadicIO $ do
155 stream <-
156 run $
157 (S.toList . op . S.take (fromIntegral len))
158 (S.iterate (+ 1) (0 :: Int))
159 let list = take (fromIntegral len) (iterate (+ 1) 0)
160 listEquals (==) stream list
162constructWithIterateM ::
163 IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
164constructWithIterateM op len =
165 withMaxSuccess maxTestCount $
166 monadicIO $ do
167 mvl <- run (newIORef [] :: IO (IORef [Int]))
168 let addM mv x y = modifyIORef' mv (++ [y + x]) >> return (y + x)
169 list = take (fromIntegral len) (iterate (+ 1) 0)
170 run $
171 S.drain . op $
172 S.take (fromIntegral len) $
173 S.iterateM (addM mvl 1) (addM mvl 0 0 :: IO Int)
174 streamEffect <- run $ readIORef mvl
175 listEquals (==) streamEffect list
177constructWithFromIndices ::
178 IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
179constructWithFromIndices op len =
180 withMaxSuccess maxTestCount $
181 monadicIO $ do
182 stream <-
183 run $ (S.toList . op . S.take (fromIntegral len)) (S.fromIndices id)
184 let list = take (fromIntegral len) (iterate (+ 1) 0)
185 listEquals (==) stream list
187constructWithFromIndicesM ::
188 IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
189constructWithFromIndicesM op len =
190 withMaxSuccess maxTestCount $
191 monadicIO $ do
192 mvl <- run (newIORef [] :: IO (IORef [Int]))
193 let addIndex mv i = modifyIORef' mv (++ [i]) >> return i
194 list = take (fromIntegral len) (iterate (+ 1) 0)
195 run $
196 S.drain . op $
197 S.take (fromIntegral len) $ S.fromIndicesM (addIndex mvl)
198 streamEffect <- run $ readIORef mvl
199 listEquals (==) streamEffect list
201-------------------------------------------------------------------------------
202-- Concurrent generation
203-------------------------------------------------------------------------------
205mvarExcHandler :: String -> BlockedIndefinitelyOnMVar -> IO ()
206mvarExcHandler label BlockedIndefinitelyOnMVar =
207 error $ label <> " " <> "BlockedIndefinitelyOnMVar\n"
209stmExcHandler :: String -> BlockedIndefinitelyOnSTM -> IO ()
210stmExcHandler label BlockedIndefinitelyOnSTM =
211 error $ label <> " " <> "BlockedIndefinitelyOnSTM\n"
213dbgMVar :: String -> IO () -> IO ()
214dbgMVar label action =
215 action `catches` [ Handler (mvarExcHandler label)
216 , Handler (stmExcHandler label)
217 ]
219-- | first n actions takeMVar and the last action performs putMVar n times
220mvarSequenceOp :: MVar () -> Word8 -> Word8 -> IO Word8
221mvarSequenceOp mv n x = do
222 let msg = show x <> "/" <> show n
223 if x < n
224 then dbgMVar ("take mvarSequenceOp " <> msg) (takeMVar mv) >> return x
225 else dbgMVar ("put mvarSequenceOp" <> msg)
226 (replicateM_ (fromIntegral n) (putMVar mv ())) >> return x
228concurrentMapM
229 :: ([Word8] -> t IO Word8)
230 -> ([Word8] -> [Word8] -> Bool)
231 -> (Word8 -> MVar () -> t IO Word8 -> SerialT IO Word8)
232 -> Word8
233 -> Property
234concurrentMapM constr eq op n =
235 monadicIO $ do
236 let list = [0..n]
237 stream <- run $ do
238 mv <- newEmptyMVar :: IO (MVar ())
239 (S.toList . op n mv) (constr list)
240 listEquals eq stream list
242concurrentFromFoldable
243 :: IsStream t
244 => ([Word8] -> [Word8] -> Bool)
245 -> (t IO Word8 -> SerialT IO Word8)
246 -> Word8
247 -> Property
248concurrentFromFoldable eq op n =
249 monadicIO $ do
250 let list = [0..n]
251 stream <- run $ do
252 mv <- newEmptyMVar :: IO (MVar ())
253 (S.toList . op) (S.fromFoldableM (fmap (mvarSequenceOp mv n) list))
254 listEquals eq stream list
256sourceUnfoldrM :: IsStream t => MVar () -> Word8 -> t IO Word8
257sourceUnfoldrM mv n = S.unfoldrM step 0
258 where
259 -- argument must be integer to avoid overflow of word8 at 255
260 step :: Int -> IO (Maybe (Word8, Int))
261 step cnt = do
262 let msg = show cnt <> "/" <> show n
263 if cnt > fromIntegral n
264 then return Nothing
265 else do
266 dbgMVar ("put sourceUnfoldrM " <> msg) (putMVar mv ())
267 return (Just (fromIntegral cnt, cnt + 1))
269-- Note that this test is not guaranteed to succeed, because there is no
270-- guarantee of parallelism in case of Async/Ahead streams.
271concurrentUnfoldrM
272 :: IsStream t
273 => ([Word8] -> [Word8] -> Bool)
274 -> (t IO Word8 -> SerialT IO Word8)
275 -> Word8
276 -> Property
277concurrentUnfoldrM eq op n =
278 monadicIO $ do
279 -- XXX we should test empty list case as well
280 let list = [0..n]
281 stream <- run $ do
282 -- putStrLn $ "concurrentUnfoldrM: " <> show n
283 mv <- newEmptyMVar :: IO (MVar ())
284 cnt <- newIORef 0
285 -- since unfoldr happens in parallel with the stream processing we
286 -- can do two takeMVar in one iteration. If it is not parallel then
287 -- this will not work and the test will fail.
288 S.toList $ do
289 x <- op (sourceUnfoldrM mv n)
290 -- results may not be yielded in order, in case of
291 -- Async/WAsync/Parallel. So we use an increasing count
292 -- instead.
293 i <- S.yieldM $ readIORef cnt
294 S.yieldM $ modifyIORef cnt (+1)
295 let msg = show i <> "/" <> show n
296 S.yieldM $
297 when (even i) $ do
298 dbgMVar ("first take concurrentUnfoldrM " <> msg)
299 (takeMVar mv)
300 when (n > i) $
301 dbgMVar ("second take concurrentUnfoldrM " <> msg)
302 (takeMVar mv)
303 return x
304 listEquals eq stream list
306concurrentOps
307 :: IsStream t
308 => ([Word8] -> t IO Word8)
309 -> String
310 -> ([Word8] -> [Word8] -> Bool)
311 -> (t IO Word8 -> SerialT IO Word8)
312 -> Spec
313concurrentOps constr desc eq t = do
314 let prop1 d p = prop d $ withMaxSuccess maxTestCount p
316 prop1 (desc <> " fromFoldableM") $ concurrentFromFoldable eq t
317 prop1 (desc <> " unfoldrM") $ concurrentUnfoldrM eq t
318 -- we pass it the length of the stream n and an mvar mv.
319 -- The stream is [0..n]. The threads communicate in such a way that the
320 -- actions coming first in the stream are dependent on the last action. So
321 -- if the stream is not processed concurrently it will block forever.
322 -- Note that if the size of the stream is bigger than the thread limit
323 -- then it will block even if it is concurrent.
324 prop1 (desc <> " mapM") $
325 concurrentMapM constr eq $ \n mv stream ->
326 t $ S.mapM (mvarSequenceOp mv n) stream
328-------------------------------------------------------------------------------
329-- Concurrent Application
330-------------------------------------------------------------------------------
332concurrentApplication :: IsStream t
333 => ([Word8] -> [Word8] -> Bool)
334 -> (t IO Word8 -> SerialT IO Word8)
335 -> Word8
336 -> Property
337concurrentApplication eq t n = withMaxSuccess maxTestCount $
338 monadicIO $ do
339 -- XXX we should test empty list case as well
340 let list = [0..n]
341 stream <- run $ do
342 -- putStrLn $ "concurrentApplication: " <> show n
343 mv <- newEmptyMVar :: IO (MVar ())
344 -- since unfoldr happens in parallel with the stream processing we
345 -- can do two takeMVar in one iteration. If it is not parallel then
346 -- this will not work and the test will fail.
347 (S.toList . t) $
348 sourceUnfoldrM mv n |&
349 S.mapM (\x -> do
350 let msg = show x <> "/" <> show n
351 when (even x) $ do
352 dbgMVar ("first take concurrentApp " <> msg)
353 (takeMVar mv)
354 when (n > x) $
355 dbgMVar ("second take concurrentApp " <> msg)
356 (takeMVar mv)
357 return x)
358 listEquals eq stream list
360sourceUnfoldrM1 :: IsStream t => Word8 -> t IO Word8
361sourceUnfoldrM1 n = S.unfoldrM step 0
362 where
363 -- argument must be integer to avoid overflow of word8 at 255
364 step :: Int -> IO (Maybe (Word8, Int))
365 step cnt =
366 if cnt > fromIntegral n
367 then return Nothing
368 else return (Just (fromIntegral cnt, cnt + 1))
370concurrentFoldlApplication :: Word8 -> Property
371concurrentFoldlApplication n =
372 monadicIO $ do
373 -- XXX we should test empty list case as well
374 let list = [0..n]
375 stream <- run $
376 sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) []
377 listEquals (==) (reverse stream) list
379concurrentFoldrApplication :: Word8 -> Property
380concurrentFoldrApplication n =
381 monadicIO $ do
382 -- XXX we should test empty list case as well
383 let list = [0..n]
384 stream <- run $
385 sourceUnfoldrM1 n |&. S.foldrM (\x xs -> xs >>= return . (x :))
386 (return [])
387 listEquals (==) stream list
389-------------------------------------------------------------------------------
390-- Transformation operations
391-------------------------------------------------------------------------------
393transformCombineFromList
394 :: Semigroup (t IO Int)
395 => ([Int] -> t IO Int)
396 -> ([Int] -> [Int] -> Bool)
397 -> ([Int] -> [Int])
398 -> (t IO Int -> SerialT IO Int)
399 -> (t IO Int -> t IO Int)
400 -> [Int]
401 -> [Int]
402 -> [Int]
403 -> Property
404transformCombineFromList constr eq listOp t op a b c =
405 withMaxSuccess maxTestCount $
406 monadicIO $ do
407 stream <- run ((S.toList . t) $
408 constr a <> op (constr b <> constr c))
409 let list = a <> listOp (b <> c)
410 listEquals eq stream list
412-- XXX add tests for MonadReader and MonadError etc. In case an SVar is
413-- accidentally passed through them.
414--
415-- This tests transform ops along with detecting illegal sharing of SVar across
416-- conurrent streams. These tests work for all stream types whereas
417-- transformCombineOpsOrdered work only for ordered stream types i.e. excluding
418-- the Async type.
419transformCombineOpsCommon
420 :: (IsStream t, Semigroup (t IO Int))
421 => ([Int] -> t IO Int)
422 -> String
423 -> ([Int] -> [Int] -> Bool)
424 -> (t IO Int -> SerialT IO Int)
425 -> Spec
426transformCombineOpsCommon constr desc eq t = do
427 let transform = transformCombineFromList constr eq
429 -- Filtering
430 prop (desc <> " filter False") $
431 transform (filter (const False)) t (S.filter (const False))
432 prop (desc <> " filter True") $
433 transform (filter (const True)) t (S.filter (const True))
434 prop (desc <> " filter even") $
435 transform (filter even) t (S.filter even)
437 prop (desc <> " filterM False") $
438 transform (filter (const False)) t (S.filterM (const $ return False))
439 prop (desc <> " filterM True") $
440 transform (filter (const True)) t (S.filterM (const $ return True))
441 prop (desc <> " filterM even") $
442 transform (filter even) t (S.filterM (return . even))
444 prop (desc <> " take maxBound") $
445 transform (take maxBound) t (S.take maxBound)
446 prop (desc <> " take 0") $ transform (take 0) t (S.take 0)
448 prop (desc <> " takeWhile True") $
449 transform (takeWhile (const True)) t (S.takeWhile (const True))
450 prop (desc <> " takeWhile False") $
451 transform (takeWhile (const False)) t (S.takeWhile (const False))
453 prop (desc <> " takeWhileM True") $
454 transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))
455 prop (desc <> " takeWhileM False") $
456 transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))
458 prop (desc <> " drop maxBound") $
459 transform (drop maxBound) t (S.drop maxBound)
460 prop (desc <> " drop 0") $ transform (drop 0) t (S.drop 0)
462 prop (desc <> " dropWhile True") $
463 transform (dropWhile (const True)) t (S.dropWhile (const True))
464 prop (desc <> " dropWhile False") $
465 transform (dropWhile (const False)) t (S.dropWhile (const False))
467 prop (desc <> " dropWhileM True") $
468 transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))
469 prop (desc <> " dropWhileM False") $
470 transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))
472 prop (desc <> " deleteBy (<=) maxBound") $
473 transform (deleteBy (<=) maxBound) t (S.deleteBy (<=) maxBound)
474 prop (desc <> " deleteBy (==) 4") $
475 transform (deleteBy (==) 4) t (S.deleteBy (==) 4)
477 -- transformation
478 prop (desc <> " mapM (+1)") $
479 transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))
481 prop (desc <> " scanl'") $ transform (scanl' (flip const) 0) t
482 (S.scanl' (flip const) 0)
483 prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t
484 (S.scanlM' (\_ a -> return a) 0)
485 prop (desc <> " scanl") $ transform (scanl' (flip const) 0) t
486 (S.scanl' (flip const) 0)
487 prop (desc <> " scanl1'") $ transform (scanl1 (flip const)) t
488 (S.scanl1' (flip const))
489 prop (desc <> " scanl1M'") $ transform (scanl1 (flip const)) t
490 (S.scanl1M' (\_ a -> return a))
492 let f x = if odd x then Just (x + 100) else Nothing
493 prop (desc <> " mapMaybe") $ transform (mapMaybe f) t (S.mapMaybe f)
495 -- reordering
496 prop (desc <> " reverse") $ transform reverse t S.reverse
497 -- prop (desc <> " reverse'") $ transform reverse t S.reverse'
499 -- inserting
500 prop (desc <> " intersperseM") $
501 forAll (choose (minBound, maxBound)) $ \n ->
502 transform (intersperse n) t (S.intersperseM $ return n)
503 prop (desc <> " insertBy 0") $
504 forAll (choose (minBound, maxBound)) $ \n ->
505 transform (insertBy compare n) t (S.insertBy compare n)
507 -- multi-stream
508 prop (desc <> " concatMap") $
509 forAll (choose (0, 100)) $ \n ->
510 transform (concatMap (const [1..n]))
511 t (S.concatMap (const (S.fromList [1..n])))
513toListFL :: Monad m => FL.Fold m a [a]
514toListFL = FL.toList
516groupSplitOps :: String -> Spec
517groupSplitOps desc = do
518 -- splitting
519 -- XXX add tests with multichar separators too
521{-
522 prop (desc <> " intercalate . splitOnSeq == id (nil separator)") $
523 forAll listWithZeroes $ \xs -> do
524 withMaxSuccess maxTestCount $
525 monadicIO $ do
526 ys <- S.toList $ FL.splitOnSeq [] toListFL (S.fromList xs)
527 listEquals (==) (intercalate [] ys) xs
529 prop (desc <> " intercalate . splitOnSeq == id (single element separator)") $
530 forAll listWithZeroes $ \xs -> do
531 withMaxSuccess maxTestCount $
532 monadicIO $ do
533 ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
534 listEquals (==) (intercalate [0] ys) xs
536 prop (desc <> " concat . splitOnSeq . intercalate == concat (nil separator/possibly empty list)") $
537 forAll listsWithoutZeroes $ \xss -> do
538 withMaxSuccess maxTestCount $
539 monadicIO $ do
540 let xs = intercalate [] xss
541 ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
542 listEquals (==) (concat ys) (concat xss)
544 prop (desc <> " concat . splitOnSeq . intercalate == concat (non-nil separator/possibly empty list)") $
545 forAll listsWithoutZeroes $ \xss -> do
546 withMaxSuccess maxTestCount $
547 monadicIO $ do
548 let xs = intercalate [0] xss
549 ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
550 listEquals (==) (concat ys) (concat xss)
552 prop (desc <> " splitOnSeq . intercalate == id (exclusive separator/non-empty list)") $
553 forAll listsWithoutZeroes1 $ \xss -> do
554 withMaxSuccess maxTestCount $
555 monadicIO $ do
556 let xs = intercalate [0] xss
557 ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
558 listEquals (==) ys xss
559-}
561 prop (desc <> " intercalate [x] . splitOn (== x) == id") $
562 forAll listWithZeroes $ \xs -> do
563 withMaxSuccess maxTestCount $
564 monadicIO $ do
565 ys <- S.toList $ S.splitOn (== 0) toListFL (S.fromList xs)
566 listEquals (==) (intercalate [0] ys) xs
568 where
570 listWithZeroes :: Gen [Int]
571 listWithZeroes = listOf $ frequency [(3, arbitrary), (1, elements [0])]
573{-
574 listWithoutZeroes = vectorOf 4 $ suchThat arbitrary (/= 0)
576 listsWithoutZeroes :: Gen [[Int]]
577 listsWithoutZeroes = listOf listWithoutZeroes
579 listsWithoutZeroes1 :: Gen [[Int]]
580 listsWithoutZeroes1 = listOf1 listWithoutZeroes
581-}
583-- transformation tests that can only work reliably for ordered streams i.e.
584-- Serial, Ahead and Zip. For example if we use "take 1" on an async stream, it
585-- might yield a different result every time.
586transformCombineOpsOrdered
587 :: (IsStream t, Semigroup (t IO Int))
588 => ([Int] -> t IO Int)
589 -> String
590 -> ([Int] -> [Int] -> Bool)
591 -> (t IO Int -> SerialT IO Int)
592 -> Spec
593transformCombineOpsOrdered constr desc eq t = do
594 let transform = transformCombineFromList constr eq
596 -- Filtering
597 prop (desc <> " take 1") $ transform (take 1) t (S.take 1)
598#ifdef DEVBUILD
599 prop (desc <> " take 2") $ transform (take 2) t (S.take 2)
600 prop (desc <> " take 3") $ transform (take 3) t (S.take 3)
601 prop (desc <> " take 4") $ transform (take 4) t (S.take 4)
602 prop (desc <> " take 5") $ transform (take 5) t (S.take 5)
603#endif
604 prop (desc <> " take 10") $ transform (take 10) t (S.take 10)
606 prop (desc <> " takeWhile > 0") $
607 transform (takeWhile (> 0)) t (S.takeWhile (> 0))
609 prop (desc <> " drop 1") $ transform (drop 1) t (S.drop 1)
610 prop (desc <> " drop 10") $ transform (drop 10) t (S.drop 10)
612 prop (desc <> " dropWhile > 0") $
613 transform (dropWhile (> 0)) t (S.dropWhile (> 0))
614 prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)
616 prop (desc <> " uniq") $ transform referenceUniq t S.uniq
618 prop (desc <> " deleteBy (<=) 0") $
619 transform (deleteBy (<=) 0) t (S.deleteBy (<=) 0)
621 prop (desc <> " findIndices") $
622 transform (findIndices odd) t (S.findIndices odd)
623 prop (desc <> " findIndices . filter") $
624 transform (findIndices odd . filter odd)
625 t
626 (S.findIndices odd . S.filter odd)
627 prop (desc <> " elemIndices") $
628 transform (elemIndices 0) t (S.elemIndices 0)
630 -- XXX this does not fail when the SVar is shared, need to fix.
631 prop (desc <> " concurrent application") $
632 transform (& fmap (+1)) t (|& S.map (+1))
634-------------------------------------------------------------------------------
635-- Elimination operations
636-------------------------------------------------------------------------------
638eliminateOp
639 :: (Show a, Eq a)
640 => ([s] -> t IO s)
641 -> ([s] -> a)
642 -> (t IO s -> IO a)
643 -> [s]
644 -> Property
645eliminateOp constr listOp op a =
646 monadicIO $ do
647 stream <- run $ op (constr a)
648 let list = listOp a
649 equals (==) stream list
651wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2
652wrapMaybe f x = if null x then Nothing else Just (f x)
654wrapOutOfBounds :: ([a1] -> Int -> a2) -> Int -> [a1] -> Maybe a2
655wrapOutOfBounds f i x | null x = Nothing
656 | i >= length x = Nothing
657 | otherwise = Just (f x i)
659wrapThe :: Eq a => [a] -> Maybe a
660wrapThe (x:xs)
661 | all (x ==) xs = Just x
662 | otherwise = Nothing
663wrapThe [] = Nothing
665-- This is the reference uniq implementation to compare uniq against,
666-- we can use uniq from vector package, but for now this should
667-- suffice.
668referenceUniq :: Eq a => [a] -> [a]
669referenceUniq = go
670 where
671 go [] = []
672 go (x:[]) = [x]
673 go (x:y:xs)
674 | x == y = go (x : xs)
675 | otherwise = x : go (y : xs)
677eliminationOps
678 :: ([Int] -> t IO Int)
679 -> String
680 -> (t IO Int -> SerialT IO Int)
681 -> Spec
682eliminationOps constr desc t = do
683 -- Elimination
684 prop (desc <> " null") $ eliminateOp constr null $ S.null . t
685 prop (desc <> " foldl'") $
686 eliminateOp constr (foldl' (+) 0) $ S.foldl' (+) 0 . t
687 prop (desc <> " foldl1'") $
688 eliminateOp constr (wrapMaybe $ foldl1' (+)) $ S.foldl1' (+) . t
689#ifdef DEVBUILD
690 prop (desc <> " foldr1") $
691 eliminateOp constr (wrapMaybe $ foldr1 (+)) $ S.foldr1 (+) . t
692#endif
693 prop (desc <> " all") $ eliminateOp constr (all even) $ S.all even . t
694 prop (desc <> " any") $ eliminateOp constr (any even) $ S.any even . t
695 prop (desc <> " and") $ eliminateOp constr (and . fmap (> 0)) $
696 (S.and . S.map (> 0)) . t
697 prop (desc <> " or") $ eliminateOp constr (or . fmap (> 0)) $
698 (S.or . S.map (> 0)) . t
699 prop (desc <> " length") $ eliminateOp constr length $ S.length . t
700 prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t
701 prop (desc <> " product") $ eliminateOp constr product $ S.product . t
703 prop (desc <> " maximum") $
704 eliminateOp constr (wrapMaybe maximum) $ S.maximum . t
705 prop (desc <> " minimum") $
706 eliminateOp constr (wrapMaybe minimum) $ S.minimum . t
708 prop (desc <> " maximumBy compare") $
709 eliminateOp constr (wrapMaybe $ maximumBy compare) $
710 S.maximumBy compare . t
711 prop (desc <> " maximumBy flip compare") $
712 eliminateOp constr (wrapMaybe $ maximumBy $ flip compare) $
713 S.maximumBy (flip compare) . t
714 prop (desc <> " minimumBy compare") $
715 eliminateOp constr (wrapMaybe $ minimumBy compare) $
716 S.minimumBy compare . t
717 prop (desc <> " minimumBy flip compare") $
718 eliminateOp constr (wrapMaybe $ minimumBy $ flip compare) $
719 S.minimumBy (flip compare) . t
721 prop (desc <> " findIndex") $
722 eliminateOp constr (findIndex odd) $ S.findIndex odd . t
723 prop (desc <> " elemIndex") $
724 eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t
726 prop (desc <> " !! 5") $
727 eliminateOp constr (wrapOutOfBounds (!!) 5) $ (S.!! 5) . t
728 prop (desc <> " !! 4") $
729 eliminateOp constr (wrapOutOfBounds (!!) 0) $ (S.!! 0) . t
731 prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t
732 prop (desc <> " lookup") $
733 eliminateOp constr (lookup 3 . flip zip [1..]) $
734 S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t
735 prop (desc <> " the") $ eliminateOp constr wrapThe $ S.the . t
737 -- Multi-stream eliminations
738 -- Add eqBy, cmpBy
739 -- XXX Write better tests for substreams.
740 prop (desc <> " isPrefixOf 10") $ eliminateOp constr (isPrefixOf [1..10]) $
741 S.isPrefixOf (S.fromList [(1::Int)..10]) . t
742 prop (desc <> " isSubsequenceOf 10") $
743 eliminateOp constr (isSubsequenceOf $ filter even [1..10]) $
744 S.isSubsequenceOf (S.fromList $ filter even [(1::Int)..10]) . t
745 prop (desc <> " stripPrefix 10") $ eliminateOp constr (stripPrefix [1..10]) $
746 (\s -> s >>= maybe (return Nothing) (fmap Just . S.toList)) .
747 S.stripPrefix (S.fromList [(1::Int)..10]) . t
749-- head/tail/last may depend on the order in case of parallel streams
750-- so we test these only for serial streams.
751eliminationOpsOrdered
752 :: ([Int] -> t IO Int)
753 -> String
754 -> (t IO Int -> SerialT IO Int)
755 -> Spec
756eliminationOpsOrdered constr desc t = do
757 prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t
758 prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do
759 r <- S.tail (t x)
760 case r of
761 Nothing -> return Nothing
762 Just s -> Just <$> S.toList s
763 prop (desc <> " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t
764 prop (desc <> " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do
765 r <- S.init (t x)
766 case r of
767 Nothing -> return Nothing
768 Just s -> Just <$> S.toList s
770elemOp
771 :: ([Word8] -> t IO Word8)
772 -> (t IO Word8 -> SerialT IO Word8)
773 -> (Word8 -> SerialT IO Word8 -> IO Bool)
774 -> (Word8 -> [Word8] -> Bool)
775 -> (Word8, [Word8])
776 -> Property
777elemOp constr op streamOp listOp (x, xs) =
778 monadicIO $ do
779 stream <- run $ (streamOp x . op) (constr xs)
780 let list = listOp x xs
781 equals (==) stream list
783eliminationOpsWord8
784 :: ([Word8] -> t IO Word8)
785 -> String
786 -> (t IO Word8 -> SerialT IO Word8)
787 -> Spec
788eliminationOpsWord8 constr desc t = do
789 prop (desc <> " elem") $ elemOp constr t S.elem elem
790 prop (desc <> " notElem") $ elemOp constr t S.notElem notElem
792-------------------------------------------------------------------------------
793-- Semigroup operations
794-------------------------------------------------------------------------------
796transformFromList
797 :: (Eq b, Show b) =>
798 ([a] -> t IO a)
799 -> ([b] -> [b] -> Bool)
800 -> ([a] -> [b])
801 -> (t IO a -> SerialT IO b)
802 -> [a]
803 -> Property
804transformFromList constr eq listOp op a =
805 monadicIO $ do
806 stream <- run ((S.toList . op) (constr a))
807 let list = listOp a
808 listEquals eq stream list
810foldFromList
811 :: ([Int] -> t IO Int)
812 -> (t IO Int -> SerialT IO Int)
813 -> ([Int] -> [Int] -> Bool)
814 -> [Int]
815 -> Property
816foldFromList constr op eq = transformFromList constr eq id op
818-- XXX concatenate streams of multiple elements rather than single elements
819semigroupOps
820 :: (IsStream t
822#if __GLASGOW_HASKELL__ < 804
823 , Semigroup (t IO Int)
824#endif
825 , Monoid (t IO Int))
826 => String
827 -> ([Int] -> [Int] -> Bool)
828 -> (t IO Int -> SerialT IO Int)
829 -> Spec
830semigroupOps desc eq t = do
831 prop (desc <> " <>") $ foldFromList (S.foldMapWith (<>) singleton) t eq
832 prop (desc <> " mappend") $ foldFromList (S.foldMapWith mappend singleton) t eq
834-------------------------------------------------------------------------------
835-- Functor operations
836-------------------------------------------------------------------------------
838functorOps
839 :: Functor (t IO)
840 => ([Int] -> t IO Int)
841 -> String
842 -> ([Int] -> [Int] -> Bool)
843 -> (t IO Int -> SerialT IO Int)
844 -> Spec
845functorOps constr desc eq t = do
846 prop (desc <> " id") $ transformFromList constr eq id t
847 prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)
849-------------------------------------------------------------------------------
850-- Applicative operations
851-------------------------------------------------------------------------------
853applicativeOps
854 :: Applicative (t IO)
855 => ([Int] -> t IO Int)
856 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
857 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
858 -> ([Int], [Int])
859 -> Property
860applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $
861 monadicIO $ do
862 stream <- run ((S.toList . t) ((,) <$> constr a <*> constr b))
863 let list = (,) <$> a <*> b
864 listEquals eq stream list
866-------------------------------------------------------------------------------
867-- Zip operations
868-------------------------------------------------------------------------------
870zipApplicative
871 :: (IsStream t, Applicative (t IO))
872 => ([Int] -> t IO Int)
873 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
874 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
875 -> ([Int], [Int])
876 -> Property
877zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $
878 monadicIO $ do
879 stream1 <- run ((S.toList . t) ((,) <$> constr a <*> constr b))
880 stream2 <- run ((S.toList . t) (pure (,) <*> constr a <*> constr b))
881 stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))
882 let list = getZipList $ (,) <$> ZipList a <*> ZipList b
883 listEquals eq stream1 list
884 listEquals eq stream2 list
885 listEquals eq stream3 list
887zipMonadic
888 :: IsStream t
889 => ([Int] -> t IO Int)
890 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
891 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
892 -> ([Int], [Int])
893 -> Property
894zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $
895 monadicIO $ do
896 stream1 <-
897 run
898 ((S.toList . t)
899 (S.zipWithM (curry return) (constr a) (constr b)))
900 let list = getZipList $ (,) <$> ZipList a <*> ZipList b
901 listEquals eq stream1 list
903zipAsyncMonadic
904 :: IsStream t
905 => ([Int] -> t IO Int)
906 -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
907 -> (t IO (Int, Int) -> SerialT IO (Int, Int))
908 -> ([Int], [Int])
909 -> Property
910zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $
911 monadicIO $ do
912 stream1 <-
913 run
914 ((S.toList . t)
915 (S.zipWithM (curry return) (constr a) (constr b)))
916 stream2 <-
917 run
918 ((S.toList . t)
919 (S.zipAsyncWithM (curry return) (constr a) (constr b)))
920 let list = getZipList $ (,) <$> ZipList a <*> ZipList b
921 listEquals eq stream1 list
922 listEquals eq stream2 list
924-------------------------------------------------------------------------------
925-- Monad operations
926-------------------------------------------------------------------------------
928monadThen
929 :: Monad (t IO)
930 => ([Int] -> t IO Int)
931 -> ([Int] -> [Int] -> Bool)
932 -> (t IO Int -> SerialT IO Int)
933 -> ([Int], [Int])
934 -> Property
935monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do
936 stream <- run ((S.toList . t) (constr a >> constr b))
937 let list = a >> b
938 listEquals eq stream list
940monadBind
941 :: Monad (t IO)
942 => ([Int] -> t IO Int)
943 -> ([Int] -> [Int] -> Bool)
944 -> (t IO Int -> SerialT IO Int)
945 -> ([Int], [Int])
946 -> Property
947monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $
948 monadicIO $ do
949 stream <-
950 run
951 ((S.toList . t)
952 (constr a >>= \x -> (+ x) <$> constr b))
953 let list = a >>= \x -> (+ x) <$> b
954 listEquals eq stream list
956main :: IO ()
957main = hspec
958 $ H.parallel
959#ifdef COVERAGE_BUILD
960 $ modifyMaxSuccess (const 10)
961#endif
962 $ do
963 let folded :: IsStream t => [a] -> t IO a
964 folded = serially . (\xs ->
965 case xs of
966 [x] -> return x -- singleton stream case
967 _ -> S.foldMapWith (<>) return xs
968 )
970 let makeCommonOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]
971 makeCommonOps t =
972 [ ("default", t)
973#ifndef COVERAGE_BUILD
974 , ("rate AvgRate 10000", t . avgRate 10000)
975 , ("rate Nothing", t . rate Nothing)
976 , ("maxBuffer 0", t . maxBuffer 0)
977 , ("maxThreads 0", t . maxThreads 0)
978 , ("maxThreads 1", t . maxThreads 1)
979 , ("maxThreads -1", t . maxThreads (-1))
980#endif
981 ]
983 let makeOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]
984 makeOps t = makeCommonOps t ++
985 [
986#ifndef COVERAGE_BUILD
987 ("maxBuffer 1", t . maxBuffer 1)
988#endif
989 ]
991 -- For concurrent application test we need a buffer of at least size 2 to
992 -- allow two threads to run.
993 let makeConcurrentAppOps :: IsStream t
994 => (t m a -> c) -> [(String, t m a -> c)]
995 makeConcurrentAppOps t = makeCommonOps t ++
996 [
997#ifndef COVERAGE_BUILD
998 ("maxBuffer 2", t . maxBuffer 2)
999#endif
1002 let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)
1003 let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec
1004 serialOps spec = mapOps spec $ makeOps serially
1005#ifndef COVERAGE_BUILD
1006 <> [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]
1007 <> [("maxBuffer -1", serially . maxBuffer (-1))]
1008#endif
1009 let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec
1010 wSerialOps spec = mapOps spec $ makeOps wSerially
1011#ifndef COVERAGE_BUILD
1012 <> [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]
1013 <> [("maxBuffer (-1)", wSerially . maxBuffer (-1))]
1014#endif
1015 let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec
1016 asyncOps spec = mapOps spec $ makeOps asyncly
1017#ifndef COVERAGE_BUILD
1018 <> [("maxBuffer (-1)", asyncly . maxBuffer (-1))]
1019#endif
1020 let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec
1021 wAsyncOps spec = mapOps spec $ makeOps wAsyncly
1022#ifndef COVERAGE_BUILD
1023 <> [("maxBuffer (-1)", wAsyncly . maxBuffer (-1))]
1024#endif
1025 let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec
1026 aheadOps spec = mapOps spec $ makeOps aheadly
1027#ifndef COVERAGE_BUILD
1028 <> [("maxBuffer (-1)", aheadly . maxBuffer (-1))]
1029#endif
1030 let parallelCommonOps :: IsStream t => [(String, ParallelT m a -> t m a)]
1031 parallelCommonOps = []
1032#ifndef COVERAGE_BUILD
1033 <> [("rate AvgRate 0.00000001", parallely . avgRate 0.00000001)]
1034 <> [("maxBuffer (-1)", parallely . maxBuffer (-1))]
1035#endif
1036 let parallelOps :: IsStream t
1037 => ((ParallelT IO a -> t IO a) -> Spec) -> Spec
1038 parallelOps spec = mapOps spec $ makeOps parallely <> parallelCommonOps
1040 let parallelConcurrentAppOps :: IsStream t
1041 => ((ParallelT IO a -> t IO a) -> Spec) -> Spec
1042 parallelConcurrentAppOps spec =
1043 mapOps spec $ makeConcurrentAppOps parallely <> parallelCommonOps
1045 let zipSerialOps :: IsStream t
1046 => ((ZipSerialM IO a -> t IO a) -> Spec) -> Spec
1047 zipSerialOps spec = mapOps spec $ makeOps zipSerially
1048#ifndef COVERAGE_BUILD
1049 <> [("rate AvgRate 0.00000001", zipSerially . avgRate 0.00000001)]
1050 <> [("maxBuffer (-1)", zipSerially . maxBuffer (-1))]
1051#endif
1052 -- Note, the "pure" of applicative Zip streams generates and infinite
1053 -- stream and therefore maxBuffer (-1) must not be used for that case.
1054 let zipAsyncOps :: IsStream t => ((ZipAsyncM IO a -> t IO a) -> Spec) -> Spec
1055 zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly
1057 describe "Construction" $ do
1058 serialOps $ prop "serially replicate" . constructWithReplicate
1060 serialOps $ prop "serially replicateM" . constructWithReplicateM
1061 wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM
1062 aheadOps $ prop "aheadly replicateM" . constructWithReplicateM
1063 asyncOps $ prop "asyncly replicateM" . constructWithReplicateM
1064 wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM
1065 parallelOps $ prop "parallely replicateM" . constructWithReplicateM
1067 serialOps $ prop "serially intFromThenTo" .
1068 constructWithIntFromThenTo
1069#if __GLASGOW_HASKELL__ >= 806
1070 serialOps $ prop "serially DoubleFromThenTo" .
1071 constructWithDoubleFromThenTo
1072#endif
1074 serialOps $ prop "serially iterate" . constructWithIterate
1076 -- XXX test for all types of streams
1077 serialOps $ prop "serially iterateM" . constructWithIterateM
1078 -- take doesn't work well on concurrent streams. Even though it
1079 -- seems like take only has a problem when used with parallely.
1080 -- wSerialOps $ prop "wSerially iterateM" wSerially . constructWithIterate
1081 -- aheadOps $ prop "aheadly iterateM" aheadly . onstructWithIterate
1082 -- asyncOps $ prop "asyncly iterateM" asyncly . constructWithIterate
1083 -- wAsyncOps $ prop "wAsyncly iterateM" wAsyncly . onstructWithIterate
1084 -- parallelOps $ prop "parallely iterateM" parallely . onstructWithIterate
1085 -- XXX add tests for fromIndices
1087 serialOps $ prop "serially fromIndices" . constructWithFromIndices
1089 serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM
1091 describe "Functor operations" $ do
1092 serialOps $ functorOps S.fromFoldable "serially" (==)
1093 serialOps $ functorOps folded "serially folded" (==)
1094 wSerialOps $ functorOps S.fromFoldable "wSerially" (==)
1095 wSerialOps $ functorOps folded "wSerially folded" (==)
1096 aheadOps $ functorOps S.fromFoldable "aheadly" (==)
1097 aheadOps $ functorOps folded "aheadly folded" (==)
1098 asyncOps $ functorOps S.fromFoldable "asyncly" sortEq
1099 asyncOps $ functorOps folded "asyncly folded" sortEq
1100 wAsyncOps $ functorOps S.fromFoldable "wAsyncly" sortEq
1101 wAsyncOps $ functorOps folded "wAsyncly folded" sortEq
1102 parallelOps $ functorOps S.fromFoldable "parallely" sortEq
1103 parallelOps $ functorOps folded "parallely folded" sortEq
1104 zipSerialOps $ functorOps S.fromFoldable "zipSerially" (==)
1105 zipSerialOps $ functorOps folded "zipSerially folded" (==)
1106 zipAsyncOps $ functorOps S.fromFoldable "zipAsyncly" (==)
1107 zipAsyncOps $ functorOps folded "zipAsyncly folded" (==)
1109 describe "Semigroup operations" $ do
1110 serialOps $ semigroupOps "serially" (==)
1111 wSerialOps $ semigroupOps "wSerially" (==)
1112 aheadOps $ semigroupOps "aheadly" (==)
1113 asyncOps $ semigroupOps "asyncly" sortEq
1114 wAsyncOps $ semigroupOps "wAsyncly" sortEq
1115 parallelOps $ semigroupOps "parallely" sortEq
1116 zipSerialOps $ semigroupOps "zipSerially" (==)
1117 zipAsyncOps $ semigroupOps "zipAsyncly" (==)
1119 describe "Applicative operations" $ do
1120 -- The tests using sorted equality are weaker tests
1121 -- We need to have stronger unit tests for all those
1122 -- XXX applicative with three arguments
1123 serialOps $ prop "serially applicative" . applicativeOps S.fromFoldable (==)
1124 serialOps $ prop "serially applicative folded" . applicativeOps folded (==)
1125 wSerialOps $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq
1126 wSerialOps $ prop "wSerially applicative folded" . applicativeOps folded sortEq
1127 aheadOps $ prop "aheadly applicative" . applicativeOps S.fromFoldable (==)
1128 aheadOps $ prop "aheadly applicative folded" . applicativeOps folded (==)
1129 asyncOps $ prop "asyncly applicative" . applicativeOps S.fromFoldable sortEq
1130 asyncOps $ prop "asyncly applicative folded" . applicativeOps folded sortEq
1131 wAsyncOps $ prop "wAsyncly applicative" . applicativeOps S.fromFoldable sortEq
1132 wAsyncOps $ prop "wAsyncly applicative folded" . applicativeOps folded sortEq
1133 parallelOps $ prop "parallely applicative folded" . applicativeOps folded sortEq
1135 -- XXX add tests for indexed/indexedR
1136 describe "Zip operations" $ do
1137 zipSerialOps $ prop "zipSerially applicative" . zipApplicative S.fromFoldable (==)
1138 zipSerialOps $ prop "zipSerially applicative folded" . zipApplicative folded (==)
1139 zipAsyncOps $ prop "zipAsyncly applicative" . zipApplicative S.fromFoldable (==)
1140 zipAsyncOps $ prop "zipAsyncly applicative folded" . zipApplicative folded (==)
1142 -- We test only the serial zip with serial streams and the parallel
1143 -- stream, because the rate setting in these streams can slow down
1144 -- zipAsync.
1145 serialOps $ prop "zip monadic serially" . zipMonadic S.fromFoldable (==)
1146 serialOps $ prop "zip monadic serially folded" . zipMonadic folded (==)
1147 wSerialOps $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)
1148 wSerialOps $ prop "zip monadic wSerially folded" . zipMonadic folded (==)
1149 aheadOps $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)
1150 aheadOps $ prop "zip monadic aheadly folded" . zipAsyncMonadic folded (==)
1151 asyncOps $ prop "zip monadic asyncly" . zipAsyncMonadic S.fromFoldable (==)
1152 asyncOps $ prop "zip monadic asyncly folded" . zipAsyncMonadic folded (==)
1153 wAsyncOps $ prop "zip monadic wAsyncly" . zipAsyncMonadic S.fromFoldable (==)
1154 wAsyncOps $ prop "zip monadic wAsyncly folded" . zipAsyncMonadic folded (==)
1155 parallelOps $ prop "zip monadic parallely" . zipMonadic S.fromFoldable (==)
1156 parallelOps $ prop "zip monadic parallely folded" . zipMonadic folded (==)
1158 -- XXX add merge tests like zip tests
1159 -- for mergeBy, we can split a list randomly into two lists and
1160 -- then merge them, it should result in original list
1161 -- describe "Merge operations" $ do
1163 describe "Monad operations" $ do
1164 serialOps $ prop "serially monad then" . monadThen S.fromFoldable (==)
1165 wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq
1166 aheadOps $ prop "aheadly monad then" . monadThen S.fromFoldable (==)
1167 asyncOps $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq
1168 wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq
1169 parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq
1171 serialOps $ prop "serially monad then folded" . monadThen folded (==)
1172 wSerialOps $ prop "wSerially monad then folded" . monadThen folded sortEq
1173 aheadOps $ prop "aheadly monad then folded" . monadThen folded (==)
1174 asyncOps $ prop "asyncly monad then folded" . monadThen folded sortEq
1175 wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq
1176 parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq
1178 serialOps $ prop "serially monad bind" . monadBind S.fromFoldable (==)
1179 wSerialOps $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq
1180 aheadOps $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)
1181 asyncOps $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq
1182 wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq
1183 parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq
1185 serialOps $ prop "serially monad bind folded" . monadBind folded (==)
1186 wSerialOps $ prop "wSerially monad bind folded" . monadBind folded sortEq
1187 aheadOps $ prop "aheadly monad bind folded" . monadBind folded (==)
1188 asyncOps $ prop "asyncly monad bind folded" . monadBind folded sortEq
1189 wAsyncOps $ prop "wAsyncly monad bind folded" . monadBind folded sortEq
1190 parallelOps $ prop "parallely monad bind folded" . monadBind folded sortEq
1192 -- These tests won't work with maxBuffer or maxThreads set to 1, so we
1193 -- exclude those cases from these.
1194 let mkOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]
1195 mkOps t =
1196 [ ("default", t)
1197#ifndef COVERAGE_BUILD
1198 , ("rate Nothing", t . rate Nothing)
1199 , ("maxBuffer 0", t . maxBuffer 0)
1200 , ("maxThreads 0", t . maxThreads 0)
1201 , ("maxThreads 0", t . maxThreads (-1))
1202#endif
1205 let forOps ops spec = forM_ ops (\(desc, f) -> describe desc $ spec f)
1206 describe "Stream concurrent operations" $ do
1207 forOps (mkOps aheadly) $ concurrentOps S.fromFoldable "aheadly" (==)
1208 forOps (mkOps asyncly) $ concurrentOps S.fromFoldable "asyncly" sortEq
1209 forOps (mkOps wAsyncly) $ concurrentOps S.fromFoldable "wAsyncly" sortEq
1210 forOps (mkOps parallely) $ concurrentOps S.fromFoldable "parallely" sortEq
1212 forOps (mkOps aheadly) $ concurrentOps folded "aheadly folded" (==)
1213 forOps (mkOps asyncly) $ concurrentOps folded "asyncly folded" sortEq
1214 forOps (mkOps wAsyncly) $ concurrentOps folded "wAsyncly folded" sortEq
1215 forOps (mkOps parallely) $ concurrentOps folded "parallely folded" sortEq
1217 describe "Concurrent application" $ do
1218 serialOps $ prop "serial" . concurrentApplication (==)
1219 asyncOps $ prop "async" . concurrentApplication sortEq
1220 aheadOps $ prop "ahead" . concurrentApplication (==)
1221 parallelConcurrentAppOps $
1222 prop "parallel" . concurrentApplication sortEq
1224 prop "concurrent foldr application" $ withMaxSuccess maxTestCount
1225 concurrentFoldrApplication
1226 prop "concurrent foldl application" $ withMaxSuccess maxTestCount
1227 concurrentFoldlApplication
1229 describe "Stream transform and combine operations" $ do
1230 serialOps $ transformCombineOpsCommon S.fromFoldable "serially" (==)
1231 wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq
1232 aheadOps $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)
1233 asyncOps $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq
1234 wAsyncOps $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq
1235 parallelOps $ transformCombineOpsCommon S.fromFoldable "parallely" sortEq
1236 zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)
1237 zipAsyncOps $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)
1239 serialOps $ transformCombineOpsCommon folded "serially" (==)
1240 wSerialOps $ transformCombineOpsCommon folded "wSerially" sortEq
1241 aheadOps $ transformCombineOpsCommon folded "aheadly" (==)
1242 asyncOps $ transformCombineOpsCommon folded "asyncly" sortEq
1243 wAsyncOps $ transformCombineOpsCommon folded "wAsyncly" sortEq
1244 parallelOps $ transformCombineOpsCommon folded "parallely" sortEq
1245 zipSerialOps $ transformCombineOpsCommon folded "zipSerially" (==)
1246 zipAsyncOps $ transformCombineOpsCommon folded "zipAsyncly" (==)
1248 serialOps $ transformCombineOpsOrdered S.fromFoldable "serially" (==)
1249 aheadOps $ transformCombineOpsOrdered S.fromFoldable "aheadly" (==)
1250 zipSerialOps $ transformCombineOpsOrdered S.fromFoldable "zipSerially" (==)
1251 zipAsyncOps $ transformCombineOpsOrdered S.fromFoldable "zipAsyncly" (==)
1253 serialOps $ transformCombineOpsOrdered folded "serially" (==)
1254 aheadOps $ transformCombineOpsOrdered folded "aheadly" (==)
1255 zipSerialOps $ transformCombineOpsOrdered folded "zipSerially" (==)
1256 zipAsyncOps $ transformCombineOpsOrdered folded "zipAsyncly" (==)
1258 describe "Stream group and split operations" $ do
1259 groupSplitOps "serially"
1261 describe "Stream elimination operations" $ do
1262 serialOps $ eliminationOps S.fromFoldable "serially"
1263 wSerialOps $ eliminationOps S.fromFoldable "wSerially"
1264 aheadOps $ eliminationOps S.fromFoldable "aheadly"
1265 asyncOps $ eliminationOps S.fromFoldable "asyncly"
1266 wAsyncOps $ eliminationOps S.fromFoldable "wAsyncly"
1267 parallelOps $ eliminationOps S.fromFoldable "parallely"
1268 zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"
1269 zipAsyncOps $ eliminationOps S.fromFoldable "zipAsyncly"
1271 serialOps $ eliminationOps folded "serially folded"
1272 wSerialOps $ eliminationOps folded "wSerially folded"
1273 aheadOps $ eliminationOps folded "aheadly folded"
1274 asyncOps $ eliminationOps folded "asyncly folded"
1275 wAsyncOps $ eliminationOps folded "wAsyncly folded"
1276 parallelOps $ eliminationOps folded "parallely folded"
1277 zipSerialOps $ eliminationOps folded "zipSerially folded"
1278 zipAsyncOps $ eliminationOps folded "zipAsyncly folded"
1280 serialOps $ eliminationOpsWord8 S.fromFoldable "serially"
1281 wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"
1282 aheadOps $ eliminationOpsWord8 S.fromFoldable "aheadly"
1283 asyncOps $ eliminationOpsWord8 S.fromFoldable "asyncly"
1284 wAsyncOps $ eliminationOpsWord8 S.fromFoldable "wAsyncly"
1285 parallelOps $ eliminationOpsWord8 S.fromFoldable "parallely"
1286 zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"
1287 zipAsyncOps $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"
1289 serialOps $ eliminationOpsWord8 folded "serially folded"
1290 wSerialOps $ eliminationOpsWord8 folded "wSerially folded"
1291 aheadOps $ eliminationOpsWord8 folded "aheadly folded"
1292 asyncOps $ eliminationOpsWord8 folded "asyncly folded"
1293 wAsyncOps $ eliminationOpsWord8 folded "wAsyncly folded"
1294 parallelOps $ eliminationOpsWord8 folded "parallely folded"
1295 zipSerialOps $ eliminationOpsWord8 folded "zipSerially folded"
1296 zipAsyncOps $ eliminationOpsWord8 folded "zipAsyncly folded"
1298 -- XXX Add a test where we chain all transformation APIs and make sure that
1299 -- the state is being passed through all of them.
1300 describe "Stream serial elimination operations" $ do
1301 serialOps $ eliminationOpsOrdered S.fromFoldable "serially"
1302 wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"
1303 aheadOps $ eliminationOpsOrdered S.fromFoldable "aheadly"
1304 zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"
1305 zipAsyncOps $ eliminationOpsOrdered S.fromFoldable "zipAsyncly"
1307 serialOps $ eliminationOpsOrdered folded "serially folded"
1308 wSerialOps $ eliminationOpsOrdered folded "wSerially folded"
1309 aheadOps $ eliminationOpsOrdered folded "aheadly folded"
1310 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"
1311 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"