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