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