git.iko.soy/streamly
on master help sign in
Refactor Serial ops into a separate test suite.
397d167Pranay Sashank
streamly.cabal+25−12
compare with master
unifiedsplit
@@ -311,6 +311,20 @@ common test-options
311 -- build-depends:
311 -- build-depends:
312 -- fusion-plugin >= 0.2 && < 0.3
312 -- fusion-plugin >= 0.2 && < 0.3
313
313
314+common prelude-test-options
315+ js-sources: jsbits/clock.js
316+ hs-source-dirs: test
317+ build-depends:
318+ streamly
319+ , base >= 4.8 && < 5
320+ , QuickCheck >= 2.10 && < 2.15
321+ , hspec >= 2.0 && < 3
322+ if impl(ghc < 8.0)
323+ build-depends:
324+ transformers >= 0.4 && < 0.6
325+ , semigroups >= 0.18 && < 0.19
326+ default-language: Haskell2010
327+
314-- Used by maxrate test, benchmarks and executables
328-- Used by maxrate test, benchmarks and executables
315common exe-options
329common exe-options
316 import: compile-options, optimization-options, threading-options
330 import: compile-options, optimization-options, threading-options
@@ -564,20 +578,19 @@ test-suite pure-streams-streamly
564 default-language: Haskell2010
578 default-language: Haskell2010
565
579
566test-suite properties
580test-suite properties
567− import: test-options
581+ import: test-options, prelude-test-options
568 type: exitcode-stdio-1.0
582 type: exitcode-stdio-1.0
569 main-is: Prop.hs
583 main-is: Prop.hs
570− js-sources: jsbits/clock.js
584+ other-modules: Streamly.Test.Common
571− hs-source-dirs: test
585+ , Streamly.Test.Prelude
572− build-depends:
586+
573− streamly
587+test-suite Prelude.Serial
574− , base >= 4.8 && < 5
588+ import: test-options, prelude-test-options
575− , QuickCheck >= 2.10 && < 2.15
589+ type: exitcode-stdio-1.0
576− , hspec >= 2.0 && < 3
590+ main-is: Streamly/Test/Prelude/Serial.hs
577− if impl(ghc < 8.0)
591+ ghc-options: -main-is Streamly.Test.Prelude.Serial.main
578− build-depends:
592+ other-modules: Streamly.Test.Common
579− transformers >= 0.4 && < 0.6
593+ , Streamly.Test.Prelude
580− default-language: Haskell2010
581
594
582test-suite array-test
595test-suite array-test
583 import: test-options
596 import: test-options
test/Prop.hs+8−838
@@ -2,204 +2,33 @@
2
2
3module Main (main) where
3module Main (main) where
4
4
5−import Control.Applicative (ZipList(..), liftA2)
5+import Control.Applicative (ZipList(..))
6import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)
6import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)
7import Control.Exception
7import Control.Exception
8 (BlockedIndefinitelyOnMVar(..), catches,
8 (BlockedIndefinitelyOnMVar(..), catches,
9 BlockedIndefinitelyOnSTM(..), Handler(..))
9 BlockedIndefinitelyOnSTM(..), Handler(..))
10−import Control.Monad (when, forM_, replicateM, replicateM_)
10+import Control.Monad (when, forM_, replicateM_)
11−import Control.Monad.IO.Class (MonadIO(..))
12−import Data.Function ((&))
13−import Data.IORef (readIORef, modifyIORef, newIORef, modifyIORef', IORef)
11+import Data.IORef (readIORef, modifyIORef, newIORef)
14−import Data.List
12+import Data.List (sort)
15− (sort, foldl', scanl', findIndices, findIndex, elemIndices,
16− elemIndex, find, insertBy, intersperse, foldl1', (\\),
17− maximumBy, minimumBy, deleteBy, isPrefixOf, isSubsequenceOf,
18− stripPrefix, intercalate)
19−import Data.Maybe (mapMaybe)
20import GHC.Word (Word8)
13import GHC.Word (Word8)
21
14
22import Test.Hspec.QuickCheck
15import Test.Hspec.QuickCheck
23import Test.QuickCheck
16import Test.QuickCheck
24− (counterexample, Property, withMaxSuccess, forAll, choose, Gen,
17+ (Property, withMaxSuccess)
25− arbitrary, elements, frequency, listOf, vectorOf) --, listOf1, suchThat)
26−import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)
18+import Test.QuickCheck.Monadic (monadicIO, run)
27
19
28import Test.Hspec as H
20import Test.Hspec as H
29
21
30import Streamly
22import Streamly
31−import Streamly.Prelude ((.:), nil)
32import Streamly as S
23import Streamly as S
33import qualified Streamly.Prelude as S
24import qualified Streamly.Prelude as S
34−import qualified Streamly.Data.Fold as FL
35−import qualified Streamly.Internal.Data.Fold as FL
36
25
37−maxStreamLen :: Int
26+import Streamly.Test.Common
38−maxStreamLen = 1000
27+import Streamly.Test.Prelude
39−
40−-- Coverage build takes too long with default number of tests
41−maxTestCount :: Int
42−#ifdef DEVBUILD
43−maxTestCount = 100
44−#else
45−maxTestCount = 10
46−#endif
47−
48−singleton :: IsStream t => a -> t m a
49−singleton a = a .: nil
50
28
51sortEq :: Ord a => [a] -> [a] -> Bool
29sortEq :: Ord a => [a] -> [a] -> Bool
52sortEq a b = sort a == sort b
30sortEq a b = sort a == sort b
53
31
54−equals
55− :: (Show a, Monad m)
56− => (a -> a -> Bool) -> a -> a -> PropertyM m ()
57−equals eq stream list = do
58− when (not $ stream `eq` list) $
59− monitor
60− (counterexample $
61− "stream " <> show stream
62− <> "\nlist " <> show list
63− )
64− assert (stream `eq` list)
65−
66−listEquals
67− :: (Show a, Eq a, MonadIO m)
68− => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
69−listEquals eq stream list = do
70− when (not $ stream `eq` list) $ liftIO $ putStrLn $
71− "stream " <> show stream
72− <> "\nlist " <> show list
73− <> "\nstream \\\\ list " <> show (stream \\ list)
74− <> "\nlist \\\\ stream " <> show (list \\ stream)
75− when (not $ stream `eq` list) $
76− monitor
77− (counterexample $
78− "stream " <> show stream
79− <> "\nlist " <> show list
80− <> "\nstream \\\\ list " <> show (stream \\ list)
81− <> "\nlist \\\\ stream " <> show (list \\ stream)
82− )
83− assert (stream `eq` list)
84−
85−-------------------------------------------------------------------------------
86−-- Construction operations
87−-------------------------------------------------------------------------------
88−
89−constructWithLen
90− :: (Show a, Eq a)
91− => (Int -> t IO a)
92− -> (Int -> [a])
93− -> (t IO a -> SerialT IO a)
94− -> Word8
95− -> Property
96−constructWithLen mkStream mkList op len = withMaxSuccess maxTestCount $
97− monadicIO $ do
98− stream <- run $ (S.toList . op) (mkStream (fromIntegral len))
99− let list = mkList (fromIntegral len)
100− listEquals (==) stream list
101−
102−constructWithLenM
103− :: (Int -> t IO Int)
104− -> (Int -> IO [Int])
105− -> (t IO Int -> SerialT IO Int)
106− -> Word8
107− -> Property
108−constructWithLenM mkStream mkList op len = withMaxSuccess maxTestCount $
109− monadicIO $ do
110− stream <- run $ (S.toList . op) (mkStream (fromIntegral len))
111− list <- run $ mkList (fromIntegral len)
112− listEquals (==) stream list
113−
114−constructWithReplicate, constructWithReplicateM, constructWithIntFromThenTo
115− :: IsStream t
116− => (t IO Int -> SerialT IO Int)
117− -> Word8
118− -> Property
119−
120−constructWithReplicateM = constructWithLenM stream list
121− where list = flip replicateM (return 1 :: IO Int)
122− stream = flip S.replicateM (return 1 :: IO Int)
123−
124−constructWithReplicate = constructWithLen stream list
125− where list = flip replicate (1 :: Int)
126− stream = flip S.replicate (1 :: Int)
127−
128−constructWithIntFromThenTo op l =
129− forAll (choose (minBound, maxBound)) $ \from ->
130− forAll (choose (minBound, maxBound)) $ \next ->
131− forAll (choose (minBound, maxBound)) $ \to ->
132− let list len = take len [from,next..to]
133− stream len = S.take len $ S.enumerateFromThenTo from next to
134− in constructWithLen stream list op l
135−
136−#if __GLASGOW_HASKELL__ >= 806
137−-- XXX try very small steps close to 0
138−constructWithDoubleFromThenTo
139− :: IsStream t
140− => (t IO Double -> SerialT IO Double)
141− -> Word8
142− -> Property
143−constructWithDoubleFromThenTo op l =
144− forAll (choose (-9007199254740999,9007199254740999)) $ \from ->
145− forAll (choose (-9007199254740999,9007199254740999)) $ \next ->
146− forAll (choose (-9007199254740999,9007199254740999)) $ \to ->
147− let list len = take len [from,next..to]
148− stream len = S.take len $ S.enumerateFromThenTo from next to
149− in constructWithLen stream list op l
150−#endif
151−
152−constructWithIterate ::
153− IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
154−constructWithIterate op len =
155− withMaxSuccess maxTestCount $
156− monadicIO $ do
157− stream <-
158− run $
159− (S.toList . op . S.take (fromIntegral len))
160− (S.iterate (+ 1) (0 :: Int))
161− let list = take (fromIntegral len) (iterate (+ 1) 0)
162− listEquals (==) stream list
163−
164−constructWithIterateM ::
165− IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
166−constructWithIterateM op len =
167− withMaxSuccess maxTestCount $
168− monadicIO $ do
169− mvl <- run (newIORef [] :: IO (IORef [Int]))
170− let addM mv x y = modifyIORef' mv (++ [y + x]) >> return (y + x)
171− list = take (fromIntegral len) (iterate (+ 1) 0)
172− run $
173− S.drain . op $
174− S.take (fromIntegral len) $
175− S.iterateM (addM mvl 1) (addM mvl 0 0 :: IO Int)
176− streamEffect <- run $ readIORef mvl
177− listEquals (==) streamEffect list
178−
179−constructWithFromIndices ::
180− IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
181−constructWithFromIndices op len =
182− withMaxSuccess maxTestCount $
183− monadicIO $ do
184− stream <-
185− run $ (S.toList . op . S.take (fromIntegral len)) (S.fromIndices id)
186− let list = take (fromIntegral len) (iterate (+ 1) 0)
187− listEquals (==) stream list
188−
189−constructWithFromIndicesM ::
190− IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
191−constructWithFromIndicesM op len =
192− withMaxSuccess maxTestCount $
193− monadicIO $ do
194− mvl <- run (newIORef [] :: IO (IORef [Int]))
195− let addIndex mv i = modifyIORef' mv (++ [i]) >> return i
196− list = take (fromIntegral len) (iterate (+ 1) 0)
197− run $
198− S.drain . op $
199− S.take (fromIntegral len) $ S.fromIndicesM (addIndex mvl)
200− streamEffect <- run $ readIORef mvl
201− listEquals (==) streamEffect list
202−
203-------------------------------------------------------------------------------
32-------------------------------------------------------------------------------
204-- Concurrent generation
33-- Concurrent generation
205-------------------------------------------------------------------------------
34-------------------------------------------------------------------------------
@@ -388,521 +217,6 @@ concurrentFoldrApplication n =
388 (return [])
217 (return [])
389 listEquals (==) stream list
218 listEquals (==) stream list
390
219
391−-------------------------------------------------------------------------------
392−-- Transformation operations
393−-------------------------------------------------------------------------------
394−
395−transformCombineFromList
396− :: Semigroup (t IO Int)
397− => ([Int] -> t IO Int)
398− -> ([Int] -> [Int] -> Bool)
399− -> ([Int] -> [Int])
400− -> (t IO Int -> SerialT IO Int)
401− -> (t IO Int -> t IO Int)
402− -> [Int]
403− -> [Int]
404− -> [Int]
405− -> Property
406−transformCombineFromList constr eq listOp t op a b c =
407− withMaxSuccess maxTestCount $
408− monadicIO $ do
409− stream <- run ((S.toList . t) $
410− constr a <> op (constr b <> constr c))
411− let list = a <> listOp (b <> c)
412− listEquals eq stream list
413−
414−-- XXX add tests for MonadReader and MonadError etc. In case an SVar is
415−-- accidentally passed through them.
416−--
417−-- This tests transform ops along with detecting illegal sharing of SVar across
418−-- conurrent streams. These tests work for all stream types whereas
419−-- transformCombineOpsOrdered work only for ordered stream types i.e. excluding
420−-- the Async type.
421−transformCombineOpsCommon
422− :: (IsStream t, Semigroup (t IO Int))
423− => ([Int] -> t IO Int)
424− -> String
425− -> ([Int] -> [Int] -> Bool)
426− -> (t IO Int -> SerialT IO Int)
427− -> Spec
428−transformCombineOpsCommon constr desc eq t = do
429− let transform = transformCombineFromList constr eq
430−
431− -- Filtering
432− prop (desc <> " filter False") $
433− transform (filter (const False)) t (S.filter (const False))
434− prop (desc <> " filter True") $
435− transform (filter (const True)) t (S.filter (const True))
436− prop (desc <> " filter even") $
437− transform (filter even) t (S.filter even)
438−
439− prop (desc <> " filterM False") $
440− transform (filter (const False)) t (S.filterM (const $ return False))
441− prop (desc <> " filterM True") $
442− transform (filter (const True)) t (S.filterM (const $ return True))
443− prop (desc <> " filterM even") $
444− transform (filter even) t (S.filterM (return . even))
445−
446− prop (desc <> " take maxBound") $
447− transform (take maxBound) t (S.take maxBound)
448− prop (desc <> " take 0") $ transform (take 0) t (S.take 0)
449−
450− prop (desc <> " takeWhile True") $
451− transform (takeWhile (const True)) t (S.takeWhile (const True))
452− prop (desc <> " takeWhile False") $
453− transform (takeWhile (const False)) t (S.takeWhile (const False))
454−
455− prop (desc <> " takeWhileM True") $
456− transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))
457− prop (desc <> " takeWhileM False") $
458− transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))
459−
460− prop (desc <> " drop maxBound") $
461− transform (drop maxBound) t (S.drop maxBound)
462− prop (desc <> " drop 0") $ transform (drop 0) t (S.drop 0)
463−
464− prop (desc <> " dropWhile True") $
465− transform (dropWhile (const True)) t (S.dropWhile (const True))
466− prop (desc <> " dropWhile False") $
467− transform (dropWhile (const False)) t (S.dropWhile (const False))
468−
469− prop (desc <> " dropWhileM True") $
470− transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))
471− prop (desc <> " dropWhileM False") $
472− transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))
473−
474− prop (desc <> " deleteBy (<=) maxBound") $
475− transform (deleteBy (<=) maxBound) t (S.deleteBy (<=) maxBound)
476− prop (desc <> " deleteBy (==) 4") $
477− transform (deleteBy (==) 4) t (S.deleteBy (==) 4)
478−
479− -- transformation
480− prop (desc <> " mapM (+1)") $
481− transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))
482−
483− prop (desc <> " scanl'") $ transform (scanl' (flip const) 0) t
484− (S.scanl' (flip const) 0)
485− prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t
486− (S.scanlM' (\_ a -> return a) 0)
487− prop (desc <> " scanl") $ transform (scanl' (flip const) 0) t
488− (S.scanl' (flip const) 0)
489− prop (desc <> " scanl1'") $ transform (scanl1 (flip const)) t
490− (S.scanl1' (flip const))
491− prop (desc <> " scanl1M'") $ transform (scanl1 (flip const)) t
492− (S.scanl1M' (\_ a -> return a))
493−
494− let f x = if odd x then Just (x + 100) else Nothing
495− prop (desc <> " mapMaybe") $ transform (mapMaybe f) t (S.mapMaybe f)
496−
497− -- tap
498− prop (desc <> " tap FL.sum . map (+1)") $ \a b ->
499− withMaxSuccess maxTestCount $
500− monadicIO $ do
501− cref <- run $ newIORef 0
502− let sumfoldinref = FL.Fold (\_ e -> modifyIORef' cref (e+))
503− (return ())
504− (const $ return ())
505− op = S.tap sumfoldinref . S.mapM (\x -> return (x+1))
506− listOp = fmap (+1)
507− stream <- run ((S.toList . t) $ op (constr a <> constr b))
508− let list = listOp (a <> b)
509− ssum <- run $ readIORef cref
510− assert (sum list == ssum)
511− listEquals eq stream list
512−
513− -- reordering
514− prop (desc <> " reverse") $ transform reverse t S.reverse
515− -- prop (desc <> " reverse'") $ transform reverse t S.reverse'
516−
517− -- inserting
518− prop (desc <> " intersperseM") $
519− forAll (choose (minBound, maxBound)) $ \n ->
520− transform (intersperse n) t (S.intersperseM $ return n)
521− prop (desc <> " insertBy 0") $
522− forAll (choose (minBound, maxBound)) $ \n ->
523− transform (insertBy compare n) t (S.insertBy compare n)
524−
525− -- multi-stream
526− prop (desc <> " concatMap") $
527− forAll (choose (0, 100)) $ \n ->
528− transform (concatMap (const [1..n]))
529− t (S.concatMap (const (S.fromList [1..n])))
530−
531−toListFL :: Monad m => FL.Fold m a [a]
532−toListFL = FL.toList
533−
534−groupSplitOps :: String -> Spec
535−groupSplitOps desc = do
536− -- splitting
537− -- XXX add tests with multichar separators too
538−
539−{-
540− prop (desc <> " intercalate . splitOnSeq == id (nil separator)") $
541− forAll listWithZeroes $ \xs -> do
542− withMaxSuccess maxTestCount $
543− monadicIO $ do
544− ys <- S.toList $ FL.splitOnSeq [] toListFL (S.fromList xs)
545− listEquals (==) (intercalate [] ys) xs
546−
547− prop (desc <> " intercalate . splitOnSeq == id (single element separator)") $
548− forAll listWithZeroes $ \xs -> do
549− withMaxSuccess maxTestCount $
550− monadicIO $ do
551− ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
552− listEquals (==) (intercalate [0] ys) xs
553−
554− prop (desc <> " concat . splitOnSeq . intercalate == concat (nil separator/possibly empty list)") $
555− forAll listsWithoutZeroes $ \xss -> do
556− withMaxSuccess maxTestCount $
557− monadicIO $ do
558− let xs = intercalate [] xss
559− ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
560− listEquals (==) (concat ys) (concat xss)
561−
562− prop (desc <> " concat . splitOnSeq . intercalate == concat (non-nil separator/possibly empty list)") $
563− forAll listsWithoutZeroes $ \xss -> do
564− withMaxSuccess maxTestCount $
565− monadicIO $ do
566− let xs = intercalate [0] xss
567− ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
568− listEquals (==) (concat ys) (concat xss)
569−
570− prop (desc <> " splitOnSeq . intercalate == id (exclusive separator/non-empty list)") $
571− forAll listsWithoutZeroes1 $ \xss -> do
572− withMaxSuccess maxTestCount $
573− monadicIO $ do
574− let xs = intercalate [0] xss
575− ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
576− listEquals (==) ys xss
577−-}
578−
579− prop (desc <> " intercalate [x] . splitOn (== x) == id") $
580− forAll listWithZeroes $ \xs -> do
581− withMaxSuccess maxTestCount $
582− monadicIO $ do
583− ys <- S.toList $ S.splitOn (== 0) toListFL (S.fromList xs)
584− listEquals (==) (intercalate [0] ys) xs
585−
586− where
587−
588− listWithZeroes :: Gen [Int]
589− listWithZeroes = listOf $ frequency [(3, arbitrary), (1, elements [0])]
590−
591−{-
592− listWithoutZeroes = vectorOf 4 $ suchThat arbitrary (/= 0)
593−
594− listsWithoutZeroes :: Gen [[Int]]
595− listsWithoutZeroes = listOf listWithoutZeroes
596−
597− listsWithoutZeroes1 :: Gen [[Int]]
598− listsWithoutZeroes1 = listOf1 listWithoutZeroes
599−-}
600−
601−-- transformation tests that can only work reliably for ordered streams i.e.
602−-- Serial, Ahead and Zip. For example if we use "take 1" on an async stream, it
603−-- might yield a different result every time.
604−transformCombineOpsOrdered
605− :: (IsStream t, Semigroup (t IO Int))
606− => ([Int] -> t IO Int)
607− -> String
608− -> ([Int] -> [Int] -> Bool)
609− -> (t IO Int -> SerialT IO Int)
610− -> Spec
611−transformCombineOpsOrdered constr desc eq t = do
612− let transform = transformCombineFromList constr eq
613−
614− -- Filtering
615− prop (desc <> " take 1") $ transform (take 1) t (S.take 1)
616−#ifdef DEVBUILD
617− prop (desc <> " take 2") $ transform (take 2) t (S.take 2)
618− prop (desc <> " take 3") $ transform (take 3) t (S.take 3)
619− prop (desc <> " take 4") $ transform (take 4) t (S.take 4)
620− prop (desc <> " take 5") $ transform (take 5) t (S.take 5)
621−#endif
622− prop (desc <> " take 10") $ transform (take 10) t (S.take 10)
623−
624− prop (desc <> " takeWhile > 0") $
625− transform (takeWhile (> 0)) t (S.takeWhile (> 0))
626−
627− prop (desc <> " drop 1") $ transform (drop 1) t (S.drop 1)
628− prop (desc <> " drop 10") $ transform (drop 10) t (S.drop 10)
629−
630− prop (desc <> " dropWhile > 0") $
631− transform (dropWhile (> 0)) t (S.dropWhile (> 0))
632− prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)
633−
634− prop (desc <> " uniq") $ transform referenceUniq t S.uniq
635−
636− prop (desc <> " deleteBy (<=) 0") $
637− transform (deleteBy (<=) 0) t (S.deleteBy (<=) 0)
638−
639− prop (desc <> " findIndices") $
640− transform (findIndices odd) t (S.findIndices odd)
641− prop (desc <> " findIndices . filter") $
642− transform (findIndices odd . filter odd)
643− t
644− (S.findIndices odd . S.filter odd)
645− prop (desc <> " elemIndices") $
646− transform (elemIndices 0) t (S.elemIndices 0)
647−
648− -- XXX this does not fail when the SVar is shared, need to fix.
649− prop (desc <> " concurrent application") $
650− transform (& fmap (+1)) t (|& S.map (+1))
651−
652−-------------------------------------------------------------------------------
653−-- Elimination operations
654−-------------------------------------------------------------------------------
655−
656−eliminateOp
657− :: (Show a, Eq a)
658− => ([s] -> t IO s)
659− -> ([s] -> a)
660− -> (t IO s -> IO a)
661− -> [s]
662− -> Property
663−eliminateOp constr listOp op a =
664− monadicIO $ do
665− stream <- run $ op (constr a)
666− let list = listOp a
667− equals (==) stream list
668−
669−wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2
670−wrapMaybe f x = if null x then Nothing else Just (f x)
671−
672−wrapOutOfBounds :: ([a1] -> Int -> a2) -> Int -> [a1] -> Maybe a2
673−wrapOutOfBounds f i x | null x = Nothing
674− | i >= length x = Nothing
675− | otherwise = Just (f x i)
676−
677−wrapThe :: Eq a => [a] -> Maybe a
678−wrapThe (x:xs)
679− | all (x ==) xs = Just x
680− | otherwise = Nothing
681−wrapThe [] = Nothing
682−
683−-- This is the reference uniq implementation to compare uniq against,
684−-- we can use uniq from vector package, but for now this should
685−-- suffice.
686−referenceUniq :: Eq a => [a] -> [a]
687−referenceUniq = go
688− where
689− go [] = []
690− go (x:[]) = [x]
691− go (x:y:xs)
692− | x == y = go (x : xs)
693− | otherwise = x : go (y : xs)
694−
695−eliminationOps
696− :: ([Int] -> t IO Int)
697− -> String
698− -> (t IO Int -> SerialT IO Int)
699− -> Spec
700−eliminationOps constr desc t = do
701− -- Elimination
702− prop (desc <> " null") $ eliminateOp constr null $ S.null . t
703− prop (desc <> " foldl'") $
704− eliminateOp constr (foldl' (+) 0) $ S.foldl' (+) 0 . t
705− prop (desc <> " foldl1'") $
706− eliminateOp constr (wrapMaybe $ foldl1' (+)) $ S.foldl1' (+) . t
707−#ifdef DEVBUILD
708− prop (desc <> " foldr1") $
709− eliminateOp constr (wrapMaybe $ foldr1 (+)) $ S.foldr1 (+) . t
710−#endif
711− prop (desc <> " all") $ eliminateOp constr (all even) $ S.all even . t
712− prop (desc <> " any") $ eliminateOp constr (any even) $ S.any even . t
713− prop (desc <> " and") $ eliminateOp constr (and . fmap (> 0)) $
714− (S.and . S.map (> 0)) . t
715− prop (desc <> " or") $ eliminateOp constr (or . fmap (> 0)) $
716− (S.or . S.map (> 0)) . t
717− prop (desc <> " length") $ eliminateOp constr length $ S.length . t
718− prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t
719− prop (desc <> " product") $ eliminateOp constr product $ S.product . t
720−
721− prop (desc <> " maximum") $
722− eliminateOp constr (wrapMaybe maximum) $ S.maximum . t
723− prop (desc <> " minimum") $
724− eliminateOp constr (wrapMaybe minimum) $ S.minimum . t
725−
726− prop (desc <> " maximumBy compare") $
727− eliminateOp constr (wrapMaybe $ maximumBy compare) $
728− S.maximumBy compare . t
729− prop (desc <> " maximumBy flip compare") $
730− eliminateOp constr (wrapMaybe $ maximumBy $ flip compare) $
731− S.maximumBy (flip compare) . t
732− prop (desc <> " minimumBy compare") $
733− eliminateOp constr (wrapMaybe $ minimumBy compare) $
734− S.minimumBy compare . t
735− prop (desc <> " minimumBy flip compare") $
736− eliminateOp constr (wrapMaybe $ minimumBy $ flip compare) $
737− S.minimumBy (flip compare) . t
738−
739− prop (desc <> " findIndex") $
740− eliminateOp constr (findIndex odd) $ S.findIndex odd . t
741− prop (desc <> " elemIndex") $
742− eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t
743−
744− prop (desc <> " !! 5") $
745− eliminateOp constr (wrapOutOfBounds (!!) 5) $ (S.!! 5) . t
746− prop (desc <> " !! 4") $
747− eliminateOp constr (wrapOutOfBounds (!!) 0) $ (S.!! 0) . t
748−
749− prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t
750− prop (desc <> " lookup") $
751− eliminateOp constr (lookup 3 . flip zip [1..]) $
752− S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t
753− prop (desc <> " the") $ eliminateOp constr wrapThe $ S.the . t
754−
755− -- Multi-stream eliminations
756− -- Add eqBy, cmpBy
757− -- XXX Write better tests for substreams.
758− prop (desc <> " isPrefixOf 10") $ eliminateOp constr (isPrefixOf [1..10]) $
759− S.isPrefixOf (S.fromList [(1::Int)..10]) . t
760− prop (desc <> " isSubsequenceOf 10") $
761− eliminateOp constr (isSubsequenceOf $ filter even [1..10]) $
762− S.isSubsequenceOf (S.fromList $ filter even [(1::Int)..10]) . t
763− prop (desc <> " stripPrefix 10") $ eliminateOp constr (stripPrefix [1..10]) $
764− (\s -> s >>= maybe (return Nothing) (fmap Just . S.toList)) .
765− S.stripPrefix (S.fromList [(1::Int)..10]) . t
766−
767−-- head/tail/last may depend on the order in case of parallel streams
768−-- so we test these only for serial streams.
769−eliminationOpsOrdered
770− :: ([Int] -> t IO Int)
771− -> String
772− -> (t IO Int -> SerialT IO Int)
773− -> Spec
774−eliminationOpsOrdered constr desc t = do
775− prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t
776− prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do
777− r <- S.tail (t x)
778− case r of
779− Nothing -> return Nothing
780− Just s -> Just <$> S.toList s
781− prop (desc <> " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t
782− prop (desc <> " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do
783− r <- S.init (t x)
784− case r of
785− Nothing -> return Nothing
786− Just s -> Just <$> S.toList s
787−
788−elemOp
789− :: ([Word8] -> t IO Word8)
790− -> (t IO Word8 -> SerialT IO Word8)
791− -> (Word8 -> SerialT IO Word8 -> IO Bool)
792− -> (Word8 -> [Word8] -> Bool)
793− -> (Word8, [Word8])
794− -> Property
795−elemOp constr op streamOp listOp (x, xs) =
796− monadicIO $ do
797− stream <- run $ (streamOp x . op) (constr xs)
798− let list = listOp x xs
799− equals (==) stream list
800−
801−eliminationOpsWord8
802− :: ([Word8] -> t IO Word8)
803− -> String
804− -> (t IO Word8 -> SerialT IO Word8)
805− -> Spec
806−eliminationOpsWord8 constr desc t = do
807− prop (desc <> " elem") $ elemOp constr t S.elem elem
808− prop (desc <> " notElem") $ elemOp constr t S.notElem notElem
809−
810−-------------------------------------------------------------------------------
811−-- Semigroup operations
812−-------------------------------------------------------------------------------
813−
814−transformFromList
815− :: (Eq b, Show b) =>
816− ([a] -> t IO a)
817− -> ([b] -> [b] -> Bool)
818− -> ([a] -> [b])
819− -> (t IO a -> SerialT IO b)
820− -> [a]
821− -> Property
822−transformFromList constr eq listOp op a =
823− monadicIO $ do
824− stream <- run ((S.toList . op) (constr a))
825− let list = listOp a
826− listEquals eq stream list
827−
828−foldFromList
829− :: ([Int] -> t IO Int)
830− -> (t IO Int -> SerialT IO Int)
831− -> ([Int] -> [Int] -> Bool)
832− -> [Int]
833− -> Property
834−foldFromList constr op eq = transformFromList constr eq id op
835−
836−-- XXX concatenate streams of multiple elements rather than single elements
837−semigroupOps
838− :: (IsStream t
839−
840−#if __GLASGOW_HASKELL__ < 804
841− , Semigroup (t IO Int)
842−#endif
843− , Monoid (t IO Int))
844− => String
845− -> ([Int] -> [Int] -> Bool)
846− -> (t IO Int -> SerialT IO Int)
847− -> Spec
848−semigroupOps desc eq t = do
849− prop (desc <> " <>") $ foldFromList (S.foldMapWith (<>) singleton) t eq
850− prop (desc <> " mappend") $ foldFromList (S.foldMapWith mappend singleton) t eq
851−
852−-------------------------------------------------------------------------------
853−-- Functor operations
854−-------------------------------------------------------------------------------
855−
856−functorOps
857− :: Functor (t IO)
858− => ([Int] -> t IO Int)
859− -> String
860− -> ([Int] -> [Int] -> Bool)
861− -> (t IO Int -> SerialT IO Int)
862− -> Spec
863−functorOps constr desc eq t = do
864− prop (desc <> " id") $ transformFromList constr eq id t
865− prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)
866−
867−-------------------------------------------------------------------------------
868−-- Applicative operations
869−-------------------------------------------------------------------------------
870−
871−applicativeOps
872− :: Applicative (t IO)
873− => ([Int] -> t IO Int)
874− -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
875− -> (t IO (Int, Int) -> SerialT IO (Int, Int))
876− -> ([Int], [Int])
877− -> Property
878−applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $
879− monadicIO $ do
880− stream <- run ((S.toList . t) ((,) <$> constr a <*> constr b))
881− let list = (,) <$> a <*> b
882− listEquals eq stream list
883−
884− stream1 <- run ((S.toList . t) (liftA2 (,) (constr a) (constr b)))
885− listEquals eq stream1 list
886−
887−-- XXX we can combine this with applicativeOps by making the type sufficiently
888−-- polymorphic.
889−applicativeOps1
890− :: Applicative (t IO)
891− => ([Int] -> t IO Int)
892− -> ([Int] -> [Int] -> Bool)
893− -> (t IO Int -> SerialT IO Int)
894− -> ([Int], [Int])
895− -> Property
896−applicativeOps1 constr eq t (a, b) = withMaxSuccess maxTestCount $
897− monadicIO $ do
898− stream <- run ((S.toList . t) (constr a *> constr b))
899− let list = a *> b
900− listEquals eq stream list
901−
902− stream1 <- run ((S.toList . t) (constr a <* constr b))
903− let list1 = a <* b
904− listEquals eq stream1 list1
905−
906-------------------------------------------------------------------------------
220-------------------------------------------------------------------------------
907-- Zip operations
221-- Zip operations
908-------------------------------------------------------------------------------
222-------------------------------------------------------------------------------
@@ -924,22 +238,6 @@ zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $
924 listEquals eq stream2 list
238 listEquals eq stream2 list
925 listEquals eq stream3 list
239 listEquals eq stream3 list
926
240
927−zipMonadic
928− :: IsStream t
929− => ([Int] -> t IO Int)
930− -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
931− -> (t IO (Int, Int) -> SerialT IO (Int, Int))
932− -> ([Int], [Int])
933− -> Property
934−zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $
935− monadicIO $ do
936− stream1 <-
937− run
938− ((S.toList . t)
939− (S.zipWithM (curry return) (constr a) (constr b)))
940− let list = getZipList $ (,) <$> ZipList a <*> ZipList b
941− listEquals eq stream1 list
942−
943zipAsyncMonadic
241zipAsyncMonadic
944 :: IsStream t
242 :: IsStream t
945 => ([Int] -> t IO Int)
243 => ([Int] -> t IO Int)
@@ -961,88 +259,10 @@ zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $
961 listEquals eq stream1 list
259 listEquals eq stream1 list
962 listEquals eq stream2 list
260 listEquals eq stream2 list
963
261
964−-------------------------------------------------------------------------------
965−-- Monad operations
966−-------------------------------------------------------------------------------
967−
968−monadThen
969− :: Monad (t IO)
970− => ([Int] -> t IO Int)
971− -> ([Int] -> [Int] -> Bool)
972− -> (t IO Int -> SerialT IO Int)
973− -> ([Int], [Int])
974− -> Property
975−monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do
976− stream <- run ((S.toList . t) (constr a >> constr b))
977− let list = a >> b
978− listEquals eq stream list
979−
980−monadBind
981− :: Monad (t IO)
982− => ([Int] -> t IO Int)
983− -> ([Int] -> [Int] -> Bool)
984− -> (t IO Int -> SerialT IO Int)
985− -> ([Int], [Int])
986− -> Property
987−monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $
988− monadicIO $ do
989− stream <-
990− run
991− ((S.toList . t)
992− (constr a >>= \x -> (+ x) <$> constr b))
993− let list = a >>= \x -> (+ x) <$> b
994− listEquals eq stream list
995−
996-------------------------------------------------------------------------------
262-------------------------------------------------------------------------------
997-- Tests for S.groupsBy
263-- Tests for S.groupsBy
998-------------------------------------------------------------------------------
264-------------------------------------------------------------------------------
999
265
1000−-- |
1001−-- If the list is empty, returns Nothing,
1002−-- else wraps the minimum value of the list in Just.
1003−maybeMinimum :: [Int] -> Maybe Int
1004−maybeMinimum [] = Nothing
1005−maybeMinimum ls = Just $ minimum ls
1006−
1007−
1008−-- |
1009−-- After grouping (and folding) Int stream using @>@ operation,
1010−-- the first @Int@ of every @[Int]@ in the @[Int]@ stream should be the minimum.
1011−testGroupsBy :: Property
1012−testGroupsBy =
1013− forAll (choose (0, maxStreamLen)) $ \len ->
1014− forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do
1015− r <- run $ S.all (\ls ->
1016− case ls of
1017− [] -> True
1018− (x:_) -> x == minimum ls)
1019− $ S.groupsBy (>) FL.toList
1020− $ S.fromList vec
1021− assert $ r == True
1022−
1023−-- |
1024−-- Checks if the @[Int]@ is non-increasing.
1025−decreasing :: [Maybe Int] -> Bool
1026−decreasing [] = True
1027−decreasing xs = all (== True) $ zipWith (<=) (tail xs) xs
1028−
1029−
1030−-- |
1031−-- To check if the minimum elements (after grouping on @>@)
1032−-- are non-increasing (either decrease or remain the same).
1033−-- Had an element been strictly greater, it would have been grouped
1034−-- with that element only.
1035−testGroupsBySep :: Property
1036−testGroupsBySep =
1037− forAll (choose (0, maxStreamLen)) $ \len ->
1038− forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do
1039− a <- run $ S.toList
1040− $ S.map maybeMinimum
1041− $ S.groupsBy (>) FL.toList
1042− $ S.fromList vec
1043− assert $ decreasing a == True
1044−
1045−
1046main :: IO ()
266main :: IO ()
1047main = hspec
267main = hspec
1048 $ H.parallel
268 $ H.parallel
@@ -1145,26 +365,12 @@ main = hspec
1145 zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly
365 zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly
1146
366
1147 describe "Construction" $ do
367 describe "Construction" $ do
1148− serialOps $ prop "serially replicate" . constructWithReplicate
1149−
1150− serialOps $ prop "serially replicateM" . constructWithReplicateM
1151 wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM
368 wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM
1152 aheadOps $ prop "aheadly replicateM" . constructWithReplicateM
369 aheadOps $ prop "aheadly replicateM" . constructWithReplicateM
1153 asyncOps $ prop "asyncly replicateM" . constructWithReplicateM
370 asyncOps $ prop "asyncly replicateM" . constructWithReplicateM
1154 wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM
371 wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM
1155 parallelOps $ prop "parallely replicateM" . constructWithReplicateM
372 parallelOps $ prop "parallely replicateM" . constructWithReplicateM
1156
373
1157− serialOps $ prop "serially intFromThenTo" .
1158− constructWithIntFromThenTo
1159−#if __GLASGOW_HASKELL__ >= 806
1160− serialOps $ prop "serially DoubleFromThenTo" .
1161− constructWithDoubleFromThenTo
1162−#endif
1163−
1164− serialOps $ prop "serially iterate" . constructWithIterate
1165−
1166− -- XXX test for all types of streams
1167− serialOps $ prop "serially iterateM" . constructWithIterateM
1168 -- take doesn't work well on concurrent streams. Even though it
374 -- take doesn't work well on concurrent streams. Even though it
1169 -- seems like take only has a problem when used with parallely.
375 -- seems like take only has a problem when used with parallely.
1170 -- wSerialOps $ prop "wSerially iterateM" wSerially . constructWithIterate
376 -- wSerialOps $ prop "wSerially iterateM" wSerially . constructWithIterate
@@ -1174,13 +380,7 @@ main = hspec
1174 -- parallelOps $ prop "parallely iterateM" parallely . onstructWithIterate
380 -- parallelOps $ prop "parallely iterateM" parallely . onstructWithIterate
1175 -- XXX add tests for fromIndices
381 -- XXX add tests for fromIndices
1176
382
1177− serialOps $ prop "serially fromIndices" . constructWithFromIndices
1178−
1179− serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM
1180−
1181 describe "Functor operations" $ do
383 describe "Functor operations" $ do
1182− serialOps $ functorOps S.fromFoldable "serially" (==)
1183− serialOps $ functorOps folded "serially folded" (==)
1184 wSerialOps $ functorOps S.fromFoldable "wSerially" (==)
384 wSerialOps $ functorOps S.fromFoldable "wSerially" (==)
1185 wSerialOps $ functorOps folded "wSerially folded" (==)
385 wSerialOps $ functorOps folded "wSerially folded" (==)
1186 aheadOps $ functorOps S.fromFoldable "aheadly" (==)
386 aheadOps $ functorOps S.fromFoldable "aheadly" (==)
@@ -1197,7 +397,6 @@ main = hspec
1197 zipAsyncOps $ functorOps folded "zipAsyncly folded" (==)
397 zipAsyncOps $ functorOps folded "zipAsyncly folded" (==)
1198
398
1199 describe "Semigroup operations" $ do
399 describe "Semigroup operations" $ do
1200− serialOps $ semigroupOps "serially" (==)
1201 wSerialOps $ semigroupOps "wSerially" (==)
400 wSerialOps $ semigroupOps "wSerially" (==)
1202 aheadOps $ semigroupOps "aheadly" (==)
401 aheadOps $ semigroupOps "aheadly" (==)
1203 asyncOps $ semigroupOps "asyncly" sortEq
402 asyncOps $ semigroupOps "asyncly" sortEq
@@ -1207,12 +406,6 @@ main = hspec
1207 zipAsyncOps $ semigroupOps "zipAsyncly" (==)
406 zipAsyncOps $ semigroupOps "zipAsyncly" (==)
1208
407
1209 describe "Applicative operations" $ do
408 describe "Applicative operations" $ do
1210− -- The tests using sorted equality are weaker tests
1211− -- We need to have stronger unit tests for all those
1212− -- XXX applicative with three arguments
1213− serialOps $ prop "serially applicative" . applicativeOps S.fromFoldable (==)
1214− serialOps $ prop "serially applicative folded" . applicativeOps folded (==)
1215− serialOps $ prop "serially applicative discard" . applicativeOps1 S.fromFoldable (==)
1216 wSerialOps $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq
409 wSerialOps $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq
1217 wSerialOps $ prop "wSerially applicative folded" . applicativeOps folded sortEq
410 wSerialOps $ prop "wSerially applicative folded" . applicativeOps folded sortEq
1218 aheadOps $ prop "aheadly applicative" . applicativeOps S.fromFoldable (==)
411 aheadOps $ prop "aheadly applicative" . applicativeOps S.fromFoldable (==)
@@ -1233,8 +426,6 @@ main = hspec
1233 -- We test only the serial zip with serial streams and the parallel
426 -- We test only the serial zip with serial streams and the parallel
1234 -- stream, because the rate setting in these streams can slow down
427 -- stream, because the rate setting in these streams can slow down
1235 -- zipAsync.
428 -- zipAsync.
1236− serialOps $ prop "zip monadic serially" . zipMonadic S.fromFoldable (==)
1237− serialOps $ prop "zip monadic serially folded" . zipMonadic folded (==)
1238 wSerialOps $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)
429 wSerialOps $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)
1239 wSerialOps $ prop "zip monadic wSerially folded" . zipMonadic folded (==)
430 wSerialOps $ prop "zip monadic wSerially folded" . zipMonadic folded (==)
1240 aheadOps $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)
431 aheadOps $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)
@@ -1252,28 +443,24 @@ main = hspec
1252 -- describe "Merge operations" $ do
443 -- describe "Merge operations" $ do
1253
444
1254 describe "Monad operations" $ do
445 describe "Monad operations" $ do
1255− serialOps $ prop "serially monad then" . monadThen S.fromFoldable (==)
1256 wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq
446 wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq
1257 aheadOps $ prop "aheadly monad then" . monadThen S.fromFoldable (==)
447 aheadOps $ prop "aheadly monad then" . monadThen S.fromFoldable (==)
1258 asyncOps $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq
448 asyncOps $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq
1259 wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq
449 wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq
1260 parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq
450 parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq
1261
451
1262− serialOps $ prop "serially monad then folded" . monadThen folded (==)
1263 wSerialOps $ prop "wSerially monad then folded" . monadThen folded sortEq
452 wSerialOps $ prop "wSerially monad then folded" . monadThen folded sortEq
1264 aheadOps $ prop "aheadly monad then folded" . monadThen folded (==)
453 aheadOps $ prop "aheadly monad then folded" . monadThen folded (==)
1265 asyncOps $ prop "asyncly monad then folded" . monadThen folded sortEq
454 asyncOps $ prop "asyncly monad then folded" . monadThen folded sortEq
1266 wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq
455 wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq
1267 parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq
456 parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq
1268
457
1269− serialOps $ prop "serially monad bind" . monadBind S.fromFoldable (==)
1270 wSerialOps $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq
458 wSerialOps $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq
1271 aheadOps $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)
459 aheadOps $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)
1272 asyncOps $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq
460 asyncOps $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq
1273 wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq
461 wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq
1274 parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq
462 parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq
1275
463
1276− serialOps $ prop "serially monad bind folded" . monadBind folded (==)
1277 wSerialOps $ prop "wSerially monad bind folded" . monadBind folded sortEq
464 wSerialOps $ prop "wSerially monad bind folded" . monadBind folded sortEq
1278 aheadOps $ prop "aheadly monad bind folded" . monadBind folded (==)
465 aheadOps $ prop "aheadly monad bind folded" . monadBind folded (==)
1279 asyncOps $ prop "asyncly monad bind folded" . monadBind folded sortEq
466 asyncOps $ prop "asyncly monad bind folded" . monadBind folded sortEq
@@ -1318,7 +505,6 @@ main = hspec
1318 concurrentFoldlApplication
505 concurrentFoldlApplication
1319
506
1320 describe "Stream transform and combine operations" $ do
507 describe "Stream transform and combine operations" $ do
1321− serialOps $ transformCombineOpsCommon S.fromFoldable "serially" (==)
1322 wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq
508 wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq
1323 aheadOps $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)
509 aheadOps $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)
1324 asyncOps $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq
510 asyncOps $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq
@@ -1327,7 +513,6 @@ main = hspec
1327 zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)
513 zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)
1328 zipAsyncOps $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)
514 zipAsyncOps $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)
1329
515
1330− serialOps $ transformCombineOpsCommon folded "serially" (==)
1331 wSerialOps $ transformCombineOpsCommon folded "wSerially" sortEq
516 wSerialOps $ transformCombineOpsCommon folded "wSerially" sortEq
1332 aheadOps $ transformCombineOpsCommon folded "aheadly" (==)
517 aheadOps $ transformCombineOpsCommon folded "aheadly" (==)
1333 asyncOps $ transformCombineOpsCommon folded "asyncly" sortEq
518 asyncOps $ transformCombineOpsCommon folded "asyncly" sortEq
@@ -1336,21 +521,15 @@ main = hspec
1336 zipSerialOps $ transformCombineOpsCommon folded "zipSerially" (==)
521 zipSerialOps $ transformCombineOpsCommon folded "zipSerially" (==)
1337 zipAsyncOps $ transformCombineOpsCommon folded "zipAsyncly" (==)
522 zipAsyncOps $ transformCombineOpsCommon folded "zipAsyncly" (==)
1338
523
1339− serialOps $ transformCombineOpsOrdered S.fromFoldable "serially" (==)
1340 aheadOps $ transformCombineOpsOrdered S.fromFoldable "aheadly" (==)
524 aheadOps $ transformCombineOpsOrdered S.fromFoldable "aheadly" (==)
1341 zipSerialOps $ transformCombineOpsOrdered S.fromFoldable "zipSerially" (==)
525 zipSerialOps $ transformCombineOpsOrdered S.fromFoldable "zipSerially" (==)
1342 zipAsyncOps $ transformCombineOpsOrdered S.fromFoldable "zipAsyncly" (==)
526 zipAsyncOps $ transformCombineOpsOrdered S.fromFoldable "zipAsyncly" (==)
1343
527
1344− serialOps $ transformCombineOpsOrdered folded "serially" (==)
1345 aheadOps $ transformCombineOpsOrdered folded "aheadly" (==)
528 aheadOps $ transformCombineOpsOrdered folded "aheadly" (==)
1346 zipSerialOps $ transformCombineOpsOrdered folded "zipSerially" (==)
529 zipSerialOps $ transformCombineOpsOrdered folded "zipSerially" (==)
1347 zipAsyncOps $ transformCombineOpsOrdered folded "zipAsyncly" (==)
530 zipAsyncOps $ transformCombineOpsOrdered folded "zipAsyncly" (==)
1348
531
1349− describe "Stream group and split operations" $ do
1350− groupSplitOps "serially"
1351−
1352 describe "Stream elimination operations" $ do
532 describe "Stream elimination operations" $ do
1353− serialOps $ eliminationOps S.fromFoldable "serially"
1354 wSerialOps $ eliminationOps S.fromFoldable "wSerially"
533 wSerialOps $ eliminationOps S.fromFoldable "wSerially"
1355 aheadOps $ eliminationOps S.fromFoldable "aheadly"
534 aheadOps $ eliminationOps S.fromFoldable "aheadly"
1356 asyncOps $ eliminationOps S.fromFoldable "asyncly"
535 asyncOps $ eliminationOps S.fromFoldable "asyncly"
@@ -1359,7 +538,6 @@ main = hspec
1359 zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"
538 zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"
1360 zipAsyncOps $ eliminationOps S.fromFoldable "zipAsyncly"
539 zipAsyncOps $ eliminationOps S.fromFoldable "zipAsyncly"
1361
540
1362− serialOps $ eliminationOps folded "serially folded"
1363 wSerialOps $ eliminationOps folded "wSerially folded"
541 wSerialOps $ eliminationOps folded "wSerially folded"
1364 aheadOps $ eliminationOps folded "aheadly folded"
542 aheadOps $ eliminationOps folded "aheadly folded"
1365 asyncOps $ eliminationOps folded "asyncly folded"
543 asyncOps $ eliminationOps folded "asyncly folded"
@@ -1368,7 +546,6 @@ main = hspec
1368 zipSerialOps $ eliminationOps folded "zipSerially folded"
546 zipSerialOps $ eliminationOps folded "zipSerially folded"
1369 zipAsyncOps $ eliminationOps folded "zipAsyncly folded"
547 zipAsyncOps $ eliminationOps folded "zipAsyncly folded"
1370
548
1371− serialOps $ eliminationOpsWord8 S.fromFoldable "serially"
1372 wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"
549 wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"
1373 aheadOps $ eliminationOpsWord8 S.fromFoldable "aheadly"
550 aheadOps $ eliminationOpsWord8 S.fromFoldable "aheadly"
1374 asyncOps $ eliminationOpsWord8 S.fromFoldable "asyncly"
551 asyncOps $ eliminationOpsWord8 S.fromFoldable "asyncly"
@@ -1377,7 +554,6 @@ main = hspec
1377 zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"
554 zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"
1378 zipAsyncOps $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"
555 zipAsyncOps $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"
1379
556
1380− serialOps $ eliminationOpsWord8 folded "serially folded"
1381 wSerialOps $ eliminationOpsWord8 folded "wSerially folded"
557 wSerialOps $ eliminationOpsWord8 folded "wSerially folded"
1382 aheadOps $ eliminationOpsWord8 folded "aheadly folded"
558 aheadOps $ eliminationOpsWord8 folded "aheadly folded"
1383 asyncOps $ eliminationOpsWord8 folded "asyncly folded"
559 asyncOps $ eliminationOpsWord8 folded "asyncly folded"
@@ -1389,18 +565,12 @@ main = hspec
1389 -- XXX Add a test where we chain all transformation APIs and make sure that
565 -- XXX Add a test where we chain all transformation APIs and make sure that
1390 -- the state is being passed through all of them.
566 -- the state is being passed through all of them.
1391 describe "Stream serial elimination operations" $ do
567 describe "Stream serial elimination operations" $ do
1392− serialOps $ eliminationOpsOrdered S.fromFoldable "serially"
1393 wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"
568 wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"
1394 aheadOps $ eliminationOpsOrdered S.fromFoldable "aheadly"
569 aheadOps $ eliminationOpsOrdered S.fromFoldable "aheadly"
1395 zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"
570 zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"
1396 zipAsyncOps $ eliminationOpsOrdered S.fromFoldable "zipAsyncly"
571 zipAsyncOps $ eliminationOpsOrdered S.fromFoldable "zipAsyncly"
1397
572
1398− serialOps $ eliminationOpsOrdered folded "serially folded"
1399 wSerialOps $ eliminationOpsOrdered folded "wSerially folded"
573 wSerialOps $ eliminationOpsOrdered folded "wSerially folded"
1400 aheadOps $ eliminationOpsOrdered folded "aheadly folded"
574 aheadOps $ eliminationOpsOrdered folded "aheadly folded"
1401 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"
575 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"
1402 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"
576 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"
1403−
1404− describe "Tests for S.groupsBy" $ do
1405− prop "testGroupsBy" testGroupsBy
1406− prop "testGroupsBySep" testGroupsBySep
test/Streamly/Test/Common.hsnew file+50
@@ -0,0 +1,50 @@
1+-- |
2+-- Module : Streamly.Test.Common
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+module Streamly.Test.Common
11+ ( equals
12+ , listEquals
13+ ) where
14+
15+import Control.Monad (when)
16+import Control.Monad.IO.Class (MonadIO(..))
17+import Data.List ((\\))
18+import Test.QuickCheck (counterexample)
19+import Test.QuickCheck.Monadic (PropertyM, assert, monitor)
20+
21+equals
22+ :: (Show a, Monad m)
23+ => (a -> a -> Bool) -> a -> a -> PropertyM m ()
24+equals eq stream list = do
25+ when (not $ stream `eq` list) $
26+ monitor
27+ (counterexample $
28+ "stream " <> show stream
29+ <> "\nlist " <> show list
30+ )
31+ assert (stream `eq` list)
32+
33+listEquals
34+ :: (Show a, Eq a, MonadIO m)
35+ => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
36+listEquals eq stream list = do
37+ when (not $ stream `eq` list) $ liftIO $ putStrLn $
38+ "stream " <> show stream
39+ <> "\nlist " <> show list
40+ <> "\nstream \\\\ list " <> show (stream \\ list)
41+ <> "\nlist \\\\ stream " <> show (list \\ stream)
42+ when (not $ stream `eq` list) $
43+ monitor
44+ (counterexample $
45+ "stream " <> show stream
46+ <> "\nlist " <> show list
47+ <> "\nstream \\\\ list " <> show (stream \\ list)
48+ <> "\nlist \\\\ stream " <> show (list \\ stream)
49+ )
50+ assert (stream `eq` list)
test/Streamly/Test/Prelude.hsnew file+731
@@ -0,0 +1,731 @@
1+-- |
2+-- Module : Streamly.Test.Prelude
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+module Streamly.Test.Prelude
11+ (
12+ -- * Construction operations
13+ constructWithReplicate
14+ , constructWithReplicateM
15+ , constructWithIntFromThenTo
16+#if __GLASGOW_HASKELL__ >= 806
17+ , constructWithDoubleFromThenTo
18+#endif
19+ , constructWithIterate
20+ , constructWithIterateM
21+ , constructWithFromIndices
22+ , constructWithFromIndicesM
23+ -- * Applicative operations
24+ , applicativeOps
25+ , applicativeOps1
26+ -- * Elimination operations
27+ , eliminationOpsOrdered
28+ , eliminationOpsWord8
29+ , eliminationOps
30+ -- * Functor operations
31+ , functorOps
32+ -- * Semigroup operations
33+ , semigroupOps
34+ -- * Transformation operations
35+ , transformCombineOpsOrdered
36+ , transformCombineOpsCommon
37+ , toListFL
38+ -- * Monad operations
39+ , monadBind
40+ , monadThen
41+ -- * ZipOperations
42+ , zipMonadic
43+ -- * Default values
44+ , maxTestCount
45+ , maxStreamLen
46+ ) where
47+
48+import Control.Applicative (ZipList(..), liftA2)
49+import Control.Monad (replicateM)
50+import Data.Function ((&))
51+import Data.IORef (IORef, modifyIORef, modifyIORef', newIORef, readIORef)
52+import Data.List
53+ ( deleteBy
54+ , elemIndex
55+ , elemIndices
56+ , find
57+ , findIndex
58+ , findIndices
59+ , foldl'
60+ , foldl1'
61+ , insertBy
62+ , intersperse
63+ , isPrefixOf
64+ , isSubsequenceOf
65+ , maximumBy
66+ , minimumBy
67+ , scanl'
68+ , sort
69+ , stripPrefix
70+ )
71+import Data.Maybe (mapMaybe)
72+import GHC.Word (Word8)
73+import Test.Hspec.QuickCheck
74+import Test.Hspec
75+import Test.QuickCheck
76+ ( Gen
77+ , Property
78+ , arbitrary
79+ , choose
80+ , elements
81+ , forAll
82+ , frequency
83+ , listOf
84+ , vectorOf
85+ , withMaxSuccess
86+ )
87+import Test.QuickCheck.Monadic (PropertyM, assert, monadicIO, run)
88+
89+import Streamly
90+import Streamly.Prelude ((.:), nil)
91+import Streamly as S
92+import qualified Streamly.Prelude as S
93+import qualified Streamly.Data.Fold as FL
94+import qualified Streamly.Internal.Data.Fold as FL
95+
96+import Streamly.Test.Common
97+
98+maxStreamLen :: Int
99+maxStreamLen = 1000
100+
101+-- Coverage build takes too long with default number of tests
102+maxTestCount :: Int
103+#ifdef DEVBUILD
104+maxTestCount = 100
105+#else
106+maxTestCount = 10
107+#endif
108+
109+singleton :: IsStream t => a -> t m a
110+singleton a = a .: nil
111+
112+sortEq :: Ord a => [a] -> [a] -> Bool
113+sortEq a b = sort a == sort b
114+
115+-------------------------------------------------------------------------------
116+-- Construction operations
117+-------------------------------------------------------------------------------
118+
119+constructWithLen
120+ :: (Show a, Eq a)
121+ => (Int -> t IO a)
122+ -> (Int -> [a])
123+ -> (t IO a -> SerialT IO a)
124+ -> Word8
125+ -> Property
126+constructWithLen mkStream mkList op len = withMaxSuccess maxTestCount $
127+ monadicIO $ do
128+ stream <- run $ (S.toList . op) (mkStream (fromIntegral len))
129+ let list = mkList (fromIntegral len)
130+ listEquals (==) stream list
131+
132+constructWithLenM
133+ :: (Int -> t IO Int)
134+ -> (Int -> IO [Int])
135+ -> (t IO Int -> SerialT IO Int)
136+ -> Word8
137+ -> Property
138+constructWithLenM mkStream mkList op len = withMaxSuccess maxTestCount $
139+ monadicIO $ do
140+ stream <- run $ (S.toList . op) (mkStream (fromIntegral len))
141+ list <- run $ mkList (fromIntegral len)
142+ listEquals (==) stream list
143+
144+constructWithReplicate, constructWithReplicateM, constructWithIntFromThenTo
145+ :: IsStream t
146+ => (t IO Int -> SerialT IO Int)
147+ -> Word8
148+ -> Property
149+
150+constructWithReplicateM = constructWithLenM stream list
151+ where list = flip replicateM (return 1 :: IO Int)
152+ stream = flip S.replicateM (return 1 :: IO Int)
153+
154+constructWithReplicate = constructWithLen stream list
155+ where list = flip replicate (1 :: Int)
156+ stream = flip S.replicate (1 :: Int)
157+
158+constructWithIntFromThenTo op l =
159+ forAll (choose (minBound, maxBound)) $ \from ->
160+ forAll (choose (minBound, maxBound)) $ \next ->
161+ forAll (choose (minBound, maxBound)) $ \to ->
162+ let list len = take len [from,next..to]
163+ stream len = S.take len $ S.enumerateFromThenTo from next to
164+ in constructWithLen stream list op l
165+
166+#if __GLASGOW_HASKELL__ >= 806
167+-- XXX try very small steps close to 0
168+constructWithDoubleFromThenTo
169+ :: IsStream t
170+ => (t IO Double -> SerialT IO Double)
171+ -> Word8
172+ -> Property
173+constructWithDoubleFromThenTo op l =
174+ forAll (choose (-9007199254740999,9007199254740999)) $ \from ->
175+ forAll (choose (-9007199254740999,9007199254740999)) $ \next ->
176+ forAll (choose (-9007199254740999,9007199254740999)) $ \to ->
177+ let list len = take len [from,next..to]
178+ stream len = S.take len $ S.enumerateFromThenTo from next to
179+ in constructWithLen stream list op l
180+#endif
181+
182+constructWithIterate ::
183+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
184+constructWithIterate op len =
185+ withMaxSuccess maxTestCount $
186+ monadicIO $ do
187+ stream <-
188+ run $
189+ (S.toList . op . S.take (fromIntegral len))
190+ (S.iterate (+ 1) (0 :: Int))
191+ let list = take (fromIntegral len) (iterate (+ 1) 0)
192+ listEquals (==) stream list
193+
194+constructWithIterateM ::
195+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
196+constructWithIterateM op len =
197+ withMaxSuccess maxTestCount $
198+ monadicIO $ do
199+ mvl <- run (newIORef [] :: IO (IORef [Int]))
200+ let addM mv x y = modifyIORef' mv (++ [y + x]) >> return (y + x)
201+ list = take (fromIntegral len) (iterate (+ 1) 0)
202+ run $
203+ S.drain . op $
204+ S.take (fromIntegral len) $
205+ S.iterateM (addM mvl 1) (addM mvl 0 0 :: IO Int)
206+ streamEffect <- run $ readIORef mvl
207+ listEquals (==) streamEffect list
208+
209+constructWithFromIndices ::
210+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
211+constructWithFromIndices op len =
212+ withMaxSuccess maxTestCount $
213+ monadicIO $ do
214+ stream <-
215+ run $ (S.toList . op . S.take (fromIntegral len)) (S.fromIndices id)
216+ let list = take (fromIntegral len) (iterate (+ 1) 0)
217+ listEquals (==) stream list
218+
219+constructWithFromIndicesM ::
220+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
221+constructWithFromIndicesM op len =
222+ withMaxSuccess maxTestCount $
223+ monadicIO $ do
224+ mvl <- run (newIORef [] :: IO (IORef [Int]))
225+ let addIndex mv i = modifyIORef' mv (++ [i]) >> return i
226+ list = take (fromIntegral len) (iterate (+ 1) 0)
227+ run $
228+ S.drain . op $
229+ S.take (fromIntegral len) $ S.fromIndicesM (addIndex mvl)
230+ streamEffect <- run $ readIORef mvl
231+ listEquals (==) streamEffect list
232+
233+-------------------------------------------------------------------------------
234+-- Applicative operations
235+-------------------------------------------------------------------------------
236+
237+applicativeOps
238+ :: Applicative (t IO)
239+ => ([Int] -> t IO Int)
240+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
241+ -> (t IO (Int, Int) -> SerialT IO (Int, Int))
242+ -> ([Int], [Int])
243+ -> Property
244+applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $
245+ monadicIO $ do
246+ stream <- run ((S.toList . t) ((,) <$> constr a <*> constr b))
247+ let list = (,) <$> a <*> b
248+ listEquals eq stream list
249+
250+ stream1 <- run ((S.toList . t) (liftA2 (,) (constr a) (constr b)))
251+ listEquals eq stream1 list
252+
253+-- XXX we can combine this with applicativeOps by making the type sufficiently
254+-- polymorphic.
255+applicativeOps1
256+ :: Applicative (t IO)
257+ => ([Int] -> t IO Int)
258+ -> ([Int] -> [Int] -> Bool)
259+ -> (t IO Int -> SerialT IO Int)
260+ -> ([Int], [Int])
261+ -> Property
262+applicativeOps1 constr eq t (a, b) = withMaxSuccess maxTestCount $
263+ monadicIO $ do
264+ stream <- run ((S.toList . t) (constr a *> constr b))
265+ let list = a *> b
266+ listEquals eq stream list
267+
268+ stream1 <- run ((S.toList . t) (constr a <* constr b))
269+ let list1 = a <* b
270+ listEquals eq stream1 list1
271+
272+-------------------------------------------------------------------------------
273+-- Elimination operations
274+-------------------------------------------------------------------------------
275+
276+eliminateOp
277+ :: (Show a, Eq a)
278+ => ([s] -> t IO s)
279+ -> ([s] -> a)
280+ -> (t IO s -> IO a)
281+ -> [s]
282+ -> Property
283+eliminateOp constr listOp op a =
284+ monadicIO $ do
285+ stream <- run $ op (constr a)
286+ let list = listOp a
287+ equals (==) stream list
288+
289+wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2
290+wrapMaybe f x = if null x then Nothing else Just (f x)
291+
292+wrapOutOfBounds :: ([a1] -> Int -> a2) -> Int -> [a1] -> Maybe a2
293+wrapOutOfBounds f i x | null x = Nothing
294+ | i >= length x = Nothing
295+ | otherwise = Just (f x i)
296+
297+wrapThe :: Eq a => [a] -> Maybe a
298+wrapThe (x:xs)
299+ | all (x ==) xs = Just x
300+ | otherwise = Nothing
301+wrapThe [] = Nothing
302+
303+-- This is the reference uniq implementation to compare uniq against,
304+-- we can use uniq from vector package, but for now this should
305+-- suffice.
306+referenceUniq :: Eq a => [a] -> [a]
307+referenceUniq = go
308+ where
309+ go [] = []
310+ go (x:[]) = [x]
311+ go (x:y:xs)
312+ | x == y = go (x : xs)
313+ | otherwise = x : go (y : xs)
314+
315+eliminationOps
316+ :: ([Int] -> t IO Int)
317+ -> String
318+ -> (t IO Int -> SerialT IO Int)
319+ -> Spec
320+eliminationOps constr desc t = do
321+ -- Elimination
322+ prop (desc <> " null") $ eliminateOp constr null $ S.null . t
323+ prop (desc <> " foldl'") $
324+ eliminateOp constr (foldl' (+) 0) $ S.foldl' (+) 0 . t
325+ prop (desc <> " foldl1'") $
326+ eliminateOp constr (wrapMaybe $ foldl1' (+)) $ S.foldl1' (+) . t
327+#ifdef DEVBUILD
328+ prop (desc <> " foldr1") $
329+ eliminateOp constr (wrapMaybe $ foldr1 (+)) $ S.foldr1 (+) . t
330+#endif
331+ prop (desc <> " all") $ eliminateOp constr (all even) $ S.all even . t
332+ prop (desc <> " any") $ eliminateOp constr (any even) $ S.any even . t
333+ prop (desc <> " and") $ eliminateOp constr (and . fmap (> 0)) $
334+ (S.and . S.map (> 0)) . t
335+ prop (desc <> " or") $ eliminateOp constr (or . fmap (> 0)) $
336+ (S.or . S.map (> 0)) . t
337+ prop (desc <> " length") $ eliminateOp constr length $ S.length . t
338+ prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t
339+ prop (desc <> " product") $ eliminateOp constr product $ S.product . t
340+
341+ prop (desc <> " maximum") $
342+ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t
343+ prop (desc <> " minimum") $
344+ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t
345+
346+ prop (desc <> " maximumBy compare") $
347+ eliminateOp constr (wrapMaybe $ maximumBy compare) $
348+ S.maximumBy compare . t
349+ prop (desc <> " maximumBy flip compare") $
350+ eliminateOp constr (wrapMaybe $ maximumBy $ flip compare) $
351+ S.maximumBy (flip compare) . t
352+ prop (desc <> " minimumBy compare") $
353+ eliminateOp constr (wrapMaybe $ minimumBy compare) $
354+ S.minimumBy compare . t
355+ prop (desc <> " minimumBy flip compare") $
356+ eliminateOp constr (wrapMaybe $ minimumBy $ flip compare) $
357+ S.minimumBy (flip compare) . t
358+
359+ prop (desc <> " findIndex") $
360+ eliminateOp constr (findIndex odd) $ S.findIndex odd . t
361+ prop (desc <> " elemIndex") $
362+ eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t
363+
364+ prop (desc <> " !! 5") $
365+ eliminateOp constr (wrapOutOfBounds (!!) 5) $ (S.!! 5) . t
366+ prop (desc <> " !! 4") $
367+ eliminateOp constr (wrapOutOfBounds (!!) 0) $ (S.!! 0) . t
368+
369+ prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t
370+ prop (desc <> " lookup") $
371+ eliminateOp constr (lookup 3 . flip zip [1..]) $
372+ S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t
373+ prop (desc <> " the") $ eliminateOp constr wrapThe $ S.the . t
374+
375+ -- Multi-stream eliminations
376+ -- Add eqBy, cmpBy
377+ -- XXX Write better tests for substreams.
378+ prop (desc <> " isPrefixOf 10") $ eliminateOp constr (isPrefixOf [1..10]) $
379+ S.isPrefixOf (S.fromList [(1::Int)..10]) . t
380+ prop (desc <> " isSubsequenceOf 10") $
381+ eliminateOp constr (isSubsequenceOf $ filter even [1..10]) $
382+ S.isSubsequenceOf (S.fromList $ filter even [(1::Int)..10]) . t
383+ prop (desc <> " stripPrefix 10") $ eliminateOp constr (stripPrefix [1..10]) $
384+ (\s -> s >>= maybe (return Nothing) (fmap Just . S.toList)) .
385+ S.stripPrefix (S.fromList [(1::Int)..10]) . t
386+
387+-- head/tail/last may depend on the order in case of parallel streams
388+-- so we test these only for serial streams.
389+eliminationOpsOrdered
390+ :: ([Int] -> t IO Int)
391+ -> String
392+ -> (t IO Int -> SerialT IO Int)
393+ -> Spec
394+eliminationOpsOrdered constr desc t = do
395+ prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t
396+ prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do
397+ r <- S.tail (t x)
398+ case r of
399+ Nothing -> return Nothing
400+ Just s -> Just <$> S.toList s
401+ prop (desc <> " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t
402+ prop (desc <> " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do
403+ r <- S.init (t x)
404+ case r of
405+ Nothing -> return Nothing
406+ Just s -> Just <$> S.toList s
407+
408+elemOp
409+ :: ([Word8] -> t IO Word8)
410+ -> (t IO Word8 -> SerialT IO Word8)
411+ -> (Word8 -> SerialT IO Word8 -> IO Bool)
412+ -> (Word8 -> [Word8] -> Bool)
413+ -> (Word8, [Word8])
414+ -> Property
415+elemOp constr op streamOp listOp (x, xs) =
416+ monadicIO $ do
417+ stream <- run $ (streamOp x . op) (constr xs)
418+ let list = listOp x xs
419+ equals (==) stream list
420+
421+eliminationOpsWord8
422+ :: ([Word8] -> t IO Word8)
423+ -> String
424+ -> (t IO Word8 -> SerialT IO Word8)
425+ -> Spec
426+eliminationOpsWord8 constr desc t = do
427+ prop (desc <> " elem") $ elemOp constr t S.elem elem
428+ prop (desc <> " notElem") $ elemOp constr t S.notElem notElem
429+
430+-------------------------------------------------------------------------------
431+-- Functor operations
432+-------------------------------------------------------------------------------
433+
434+functorOps
435+ :: Functor (t IO)
436+ => ([Int] -> t IO Int)
437+ -> String
438+ -> ([Int] -> [Int] -> Bool)
439+ -> (t IO Int -> SerialT IO Int)
440+ -> Spec
441+functorOps constr desc eq t = do
442+ prop (desc <> " id") $ transformFromList constr eq id t
443+ prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)
444+
445+-------------------------------------------------------------------------------
446+-- Semigroup operations
447+-------------------------------------------------------------------------------
448+
449+transformFromList
450+ :: (Eq b, Show b) =>
451+ ([a] -> t IO a)
452+ -> ([b] -> [b] -> Bool)
453+ -> ([a] -> [b])
454+ -> (t IO a -> SerialT IO b)
455+ -> [a]
456+ -> Property
457+transformFromList constr eq listOp op a =
458+ monadicIO $ do
459+ stream <- run ((S.toList . op) (constr a))
460+ let list = listOp a
461+ listEquals eq stream list
462+
463+foldFromList
464+ :: ([Int] -> t IO Int)
465+ -> (t IO Int -> SerialT IO Int)
466+ -> ([Int] -> [Int] -> Bool)
467+ -> [Int]
468+ -> Property
469+foldFromList constr op eq = transformFromList constr eq id op
470+
471+-- XXX concatenate streams of multiple elements rather than single elements
472+semigroupOps
473+ :: (IsStream t
474+
475+#if __GLASGOW_HASKELL__ < 804
476+ , Semigroup (t IO Int)
477+#endif
478+ , Monoid (t IO Int))
479+ => String
480+ -> ([Int] -> [Int] -> Bool)
481+ -> (t IO Int -> SerialT IO Int)
482+ -> Spec
483+semigroupOps desc eq t = do
484+ prop (desc <> " <>") $ foldFromList (S.foldMapWith (<>) singleton) t eq
485+ prop (desc <> " mappend") $ foldFromList (S.foldMapWith mappend singleton) t eq
486+
487+-------------------------------------------------------------------------------
488+-- Transformation operations
489+-------------------------------------------------------------------------------
490+
491+transformCombineFromList
492+ :: Semigroup (t IO Int)
493+ => ([Int] -> t IO Int)
494+ -> ([Int] -> [Int] -> Bool)
495+ -> ([Int] -> [Int])
496+ -> (t IO Int -> SerialT IO Int)
497+ -> (t IO Int -> t IO Int)
498+ -> [Int]
499+ -> [Int]
500+ -> [Int]
501+ -> Property
502+transformCombineFromList constr eq listOp t op a b c =
503+ withMaxSuccess maxTestCount $
504+ monadicIO $ do
505+ stream <- run ((S.toList . t) $
506+ constr a <> op (constr b <> constr c))
507+ let list = a <> listOp (b <> c)
508+ listEquals eq stream list
509+
510+-- XXX add tests for MonadReader and MonadError etc. In case an SVar is
511+-- accidentally passed through them.
512+--
513+-- This tests transform ops along with detecting illegal sharing of SVar across
514+-- conurrent streams. These tests work for all stream types whereas
515+-- transformCombineOpsOrdered work only for ordered stream types i.e. excluding
516+-- the Async type.
517+transformCombineOpsCommon
518+ :: (IsStream t, Semigroup (t IO Int))
519+ => ([Int] -> t IO Int)
520+ -> String
521+ -> ([Int] -> [Int] -> Bool)
522+ -> (t IO Int -> SerialT IO Int)
523+ -> Spec
524+transformCombineOpsCommon constr desc eq t = do
525+ let transform = transformCombineFromList constr eq
526+
527+ -- Filtering
528+ prop (desc <> " filter False") $
529+ transform (filter (const False)) t (S.filter (const False))
530+ prop (desc <> " filter True") $
531+ transform (filter (const True)) t (S.filter (const True))
532+ prop (desc <> " filter even") $
533+ transform (filter even) t (S.filter even)
534+
535+ prop (desc <> " filterM False") $
536+ transform (filter (const False)) t (S.filterM (const $ return False))
537+ prop (desc <> " filterM True") $
538+ transform (filter (const True)) t (S.filterM (const $ return True))
539+ prop (desc <> " filterM even") $
540+ transform (filter even) t (S.filterM (return . even))
541+
542+ prop (desc <> " take maxBound") $
543+ transform (take maxBound) t (S.take maxBound)
544+ prop (desc <> " take 0") $ transform (take 0) t (S.take 0)
545+
546+ prop (desc <> " takeWhile True") $
547+ transform (takeWhile (const True)) t (S.takeWhile (const True))
548+ prop (desc <> " takeWhile False") $
549+ transform (takeWhile (const False)) t (S.takeWhile (const False))
550+
551+ prop (desc <> " takeWhileM True") $
552+ transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))
553+ prop (desc <> " takeWhileM False") $
554+ transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))
555+
556+ prop (desc <> " drop maxBound") $
557+ transform (drop maxBound) t (S.drop maxBound)
558+ prop (desc <> " drop 0") $ transform (drop 0) t (S.drop 0)
559+
560+ prop (desc <> " dropWhile True") $
561+ transform (dropWhile (const True)) t (S.dropWhile (const True))
562+ prop (desc <> " dropWhile False") $
563+ transform (dropWhile (const False)) t (S.dropWhile (const False))
564+
565+ prop (desc <> " dropWhileM True") $
566+ transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))
567+ prop (desc <> " dropWhileM False") $
568+ transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))
569+
570+ prop (desc <> " deleteBy (<=) maxBound") $
571+ transform (deleteBy (<=) maxBound) t (S.deleteBy (<=) maxBound)
572+ prop (desc <> " deleteBy (==) 4") $
573+ transform (deleteBy (==) 4) t (S.deleteBy (==) 4)
574+
575+ -- transformation
576+ prop (desc <> " mapM (+1)") $
577+ transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))
578+
579+ prop (desc <> " scanl'") $ transform (scanl' (flip const) 0) t
580+ (S.scanl' (flip const) 0)
581+ prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t
582+ (S.scanlM' (\_ a -> return a) 0)
583+ prop (desc <> " scanl") $ transform (scanl' (flip const) 0) t
584+ (S.scanl' (flip const) 0)
585+ prop (desc <> " scanl1'") $ transform (scanl1 (flip const)) t
586+ (S.scanl1' (flip const))
587+ prop (desc <> " scanl1M'") $ transform (scanl1 (flip const)) t
588+ (S.scanl1M' (\_ a -> return a))
589+
590+ let f x = if odd x then Just (x + 100) else Nothing
591+ prop (desc <> " mapMaybe") $ transform (mapMaybe f) t (S.mapMaybe f)
592+
593+ -- tap
594+ prop (desc <> " tap FL.sum . map (+1)") $ \a b ->
595+ withMaxSuccess maxTestCount $
596+ monadicIO $ do
597+ cref <- run $ newIORef 0
598+ let sumfoldinref = FL.Fold (\_ e -> modifyIORef' cref (e+))
599+ (return ())
600+ (const $ return ())
601+ op = S.tap sumfoldinref . S.mapM (\x -> return (x+1))
602+ listOp = fmap (+1)
603+ stream <- run ((S.toList . t) $ op (constr a <> constr b))
604+ let list = listOp (a <> b)
605+ ssum <- run $ readIORef cref
606+ assert (sum list == ssum)
607+ listEquals eq stream list
608+
609+ -- reordering
610+ prop (desc <> " reverse") $ transform reverse t S.reverse
611+ -- prop (desc <> " reverse'") $ transform reverse t S.reverse'
612+
613+ -- inserting
614+ prop (desc <> " intersperseM") $
615+ forAll (choose (minBound, maxBound)) $ \n ->
616+ transform (intersperse n) t (S.intersperseM $ return n)
617+ prop (desc <> " insertBy 0") $
618+ forAll (choose (minBound, maxBound)) $ \n ->
619+ transform (insertBy compare n) t (S.insertBy compare n)
620+
621+ -- multi-stream
622+ prop (desc <> " concatMap") $
623+ forAll (choose (0, 100)) $ \n ->
624+ transform (concatMap (const [1..n]))
625+ t (S.concatMap (const (S.fromList [1..n])))
626+
627+toListFL :: Monad m => FL.Fold m a [a]
628+toListFL = FL.toList
629+
630+-- transformation tests that can only work reliably for ordered streams i.e.
631+-- Serial, Ahead and Zip. For example if we use "take 1" on an async stream, it
632+-- might yield a different result every time.
633+transformCombineOpsOrdered
634+ :: (IsStream t, Semigroup (t IO Int))
635+ => ([Int] -> t IO Int)
636+ -> String
637+ -> ([Int] -> [Int] -> Bool)
638+ -> (t IO Int -> SerialT IO Int)
639+ -> Spec
640+transformCombineOpsOrdered constr desc eq t = do
641+ let transform = transformCombineFromList constr eq
642+
643+ -- Filtering
644+ prop (desc <> " take 1") $ transform (take 1) t (S.take 1)
645+#ifdef DEVBUILD
646+ prop (desc <> " take 2") $ transform (take 2) t (S.take 2)
647+ prop (desc <> " take 3") $ transform (take 3) t (S.take 3)
648+ prop (desc <> " take 4") $ transform (take 4) t (S.take 4)
649+ prop (desc <> " take 5") $ transform (take 5) t (S.take 5)
650+#endif
651+ prop (desc <> " take 10") $ transform (take 10) t (S.take 10)
652+
653+ prop (desc <> " takeWhile > 0") $
654+ transform (takeWhile (> 0)) t (S.takeWhile (> 0))
655+
656+ prop (desc <> " drop 1") $ transform (drop 1) t (S.drop 1)
657+ prop (desc <> " drop 10") $ transform (drop 10) t (S.drop 10)
658+
659+ prop (desc <> " dropWhile > 0") $
660+ transform (dropWhile (> 0)) t (S.dropWhile (> 0))
661+ prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)
662+
663+ prop (desc <> " uniq") $ transform referenceUniq t S.uniq
664+
665+ prop (desc <> " deleteBy (<=) 0") $
666+ transform (deleteBy (<=) 0) t (S.deleteBy (<=) 0)
667+
668+ prop (desc <> " findIndices") $
669+ transform (findIndices odd) t (S.findIndices odd)
670+ prop (desc <> " findIndices . filter") $
671+ transform (findIndices odd . filter odd)
672+ t
673+ (S.findIndices odd . S.filter odd)
674+ prop (desc <> " elemIndices") $
675+ transform (elemIndices 0) t (S.elemIndices 0)
676+
677+ -- XXX this does not fail when the SVar is shared, need to fix.
678+ prop (desc <> " concurrent application") $
679+ transform (& fmap (+1)) t (|& S.map (+1))
680+
681+-------------------------------------------------------------------------------
682+-- Monad operations
683+-------------------------------------------------------------------------------
684+
685+monadThen
686+ :: Monad (t IO)
687+ => ([Int] -> t IO Int)
688+ -> ([Int] -> [Int] -> Bool)
689+ -> (t IO Int -> SerialT IO Int)
690+ -> ([Int], [Int])
691+ -> Property
692+monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do
693+ stream <- run ((S.toList . t) (constr a >> constr b))
694+ let list = a >> b
695+ listEquals eq stream list
696+
697+monadBind
698+ :: Monad (t IO)
699+ => ([Int] -> t IO Int)
700+ -> ([Int] -> [Int] -> Bool)
701+ -> (t IO Int -> SerialT IO Int)
702+ -> ([Int], [Int])
703+ -> Property
704+monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $
705+ monadicIO $ do
706+ stream <-
707+ run
708+ ((S.toList . t)
709+ (constr a >>= \x -> (+ x) <$> constr b))
710+ let list = a >>= \x -> (+ x) <$> b
711+ listEquals eq stream list
712+
713+-------------------------------------------------------------------------------
714+-- Zip operations
715+-------------------------------------------------------------------------------
716+
717+zipMonadic
718+ :: IsStream t
719+ => ([Int] -> t IO Int)
720+ -> ([(Int, Int)] -> [(Int, Int)] -> Bool)
721+ -> (t IO (Int, Int) -> SerialT IO (Int, Int))
722+ -> ([Int], [Int])
723+ -> Property
724+zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $
725+ monadicIO $ do
726+ stream1 <-
727+ run
728+ ((S.toList . t)
729+ (S.zipWithM (curry return) (constr a) (constr b)))
730+ let list = getZipList $ (,) <$> ZipList a <*> ZipList b
731+ listEquals eq stream1 list
test/Streamly/Test/Prelude/Serial.hsnew file+261
@@ -0,0 +1,261 @@
1+-- |
2+-- Module : Streamly.Test.Prelude.Serial
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+module Streamly.Test.Prelude.Serial where
11+
12+import Data.List (intercalate)
13+import Test.Hspec.QuickCheck
14+import Test.QuickCheck
15+ ( Gen
16+ , Property
17+ , arbitrary
18+ , choose
19+ , elements
20+ , forAll
21+ , frequency
22+ , listOf
23+ , vectorOf
24+ , withMaxSuccess
25+ )
26+import Test.QuickCheck.Monadic (assert, monadicIO, run)
27+import Test.Hspec as H
28+
29+import Streamly
30+import Streamly as S
31+import qualified Streamly.Prelude as S
32+import qualified Streamly.Data.Fold as FL
33+import qualified Streamly.Internal.Data.Fold as FL
34+
35+import Streamly.Test.Common
36+import Streamly.Test.Prelude
37+
38+groupSplitOps :: String -> Spec
39+groupSplitOps desc = do
40+ -- splitting
41+ -- XXX add tests with multichar separators too
42+{-
43+ prop (desc <> " intercalate . splitOnSeq == id (nil separator)") $
44+ forAll listWithZeroes $ \xs -> do
45+ withMaxSuccess maxTestCount $
46+ monadicIO $ do
47+ ys <- S.toList $ FL.splitOnSeq [] toListFL (S.fromList xs)
48+ listEquals (==) (intercalate [] ys) xs
49+
50+ prop (desc <> " intercalate . splitOnSeq == id (single element separator)") $
51+ forAll listWithZeroes $ \xs -> do
52+ withMaxSuccess maxTestCount $
53+ monadicIO $ do
54+ ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
55+ listEquals (==) (intercalate [0] ys) xs
56+
57+ prop (desc <> " concat . splitOnSeq . intercalate == concat (nil separator/possibly empty list)") $
58+ forAll listsWithoutZeroes $ \xss -> do
59+ withMaxSuccess maxTestCount $
60+ monadicIO $ do
61+ let xs = intercalate [] xss
62+ ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
63+ listEquals (==) (concat ys) (concat xss)
64+
65+ prop (desc <> " concat . splitOnSeq . intercalate == concat (non-nil separator/possibly empty list)") $
66+ forAll listsWithoutZeroes $ \xss -> do
67+ withMaxSuccess maxTestCount $
68+ monadicIO $ do
69+ let xs = intercalate [0] xss
70+ ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
71+ listEquals (==) (concat ys) (concat xss)
72+
73+ prop (desc <> " splitOnSeq . intercalate == id (exclusive separator/non-empty list)") $
74+ forAll listsWithoutZeroes1 $ \xss -> do
75+ withMaxSuccess maxTestCount $
76+ monadicIO $ do
77+ let xs = intercalate [0] xss
78+ ys <- S.toList $ FL.splitOnSeq [0] toListFL (S.fromList xs)
79+ listEquals (==) ys xss
80+-}
81+
82+ prop (desc <> " intercalate [x] . splitOn (== x) == id") $
83+ forAll listWithZeroes $ \xs -> do
84+ withMaxSuccess maxTestCount $
85+ monadicIO $ do
86+ ys <- S.toList $ S.splitOn (== 0) toListFL (S.fromList xs)
87+ listEquals (==) (intercalate [0] ys) xs
88+
89+ where
90+
91+ listWithZeroes :: Gen [Int]
92+ listWithZeroes = listOf $ frequency [(3, arbitrary), (1, elements [0])]
93+
94+{-
95+ listWithoutZeroes = vectorOf 4 $ suchThat arbitrary (/= 0)
96+
97+ listsWithoutZeroes :: Gen [[Int]]
98+ listsWithoutZeroes = listOf listWithoutZeroes
99+
100+ listsWithoutZeroes1 :: Gen [[Int]]
101+ listsWithoutZeroes1 = listOf1 listWithoutZeroes
102+-}
103+
104+-- |
105+-- After grouping (and folding) Int stream using @>@ operation,
106+-- the first @Int@ of every @[Int]@ in the @[Int]@ stream should be the minimum.
107+testGroupsBy :: Property
108+testGroupsBy =
109+ forAll (choose (0, maxStreamLen)) $ \len ->
110+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do
111+ r <- run $ S.all (\ls ->
112+ case ls of
113+ [] -> True
114+ (x:_) -> x == minimum ls)
115+ $ S.groupsBy (>) FL.toList
116+ $ S.fromList vec
117+ assert $ r == True
118+
119+-- |
120+-- If the list is empty, returns Nothing,
121+-- else wraps the minimum value of the list in Just.
122+maybeMinimum :: [Int] -> Maybe Int
123+maybeMinimum [] = Nothing
124+maybeMinimum ls = Just $ minimum ls
125+
126+-- |
127+-- Checks if the @[Int]@ is non-increasing.
128+decreasing :: [Maybe Int] -> Bool
129+decreasing [] = True
130+decreasing xs = all (== True) $ zipWith (<=) (tail xs) xs
131+
132+-- |
133+-- To check if the minimum elements (after grouping on @>@)
134+-- are non-increasing (either decrease or remain the same).
135+-- Had an element been strictly greater, it would have been grouped
136+-- with that element only.
137+testGroupsBySep :: Property
138+testGroupsBySep =
139+ forAll (choose (0, maxStreamLen)) $ \len ->
140+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do
141+ a <- run $ S.toList
142+ $ S.map maybeMinimum
143+ $ S.groupsBy (>) FL.toList
144+ $ S.fromList vec
145+ assert $ decreasing a == True
146+
147+main :: IO ()
148+main = hspec
149+ $ H.parallel
150+#ifdef COVERAGE_BUILD
151+ $ modifyMaxSuccess (const 10)
152+#endif
153+ $ do
154+ let folded :: IsStream t => [a] -> t IO a
155+ folded = serially . (\xs ->
156+ case xs of
157+ [x] -> return x -- singleton stream case
158+ _ -> S.foldMapWith (<>) return xs
159+ )
160+
161+ let makeCommonOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]
162+ makeCommonOps t =
163+ [ ("default", t)
164+#ifndef COVERAGE_BUILD
165+ , ("rate AvgRate 10000", t . avgRate 10000)
166+ , ("rate Nothing", t . rate Nothing)
167+ , ("maxBuffer 0", t . maxBuffer 0)
168+ , ("maxThreads 0", t . maxThreads 0)
169+ , ("maxThreads 1", t . maxThreads 1)
170+ , ("maxThreads -1", t . maxThreads (-1))
171+#endif
172+ ]
173+
174+ let makeOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]
175+ makeOps t = makeCommonOps t ++
176+ [
177+#ifndef COVERAGE_BUILD
178+ ("maxBuffer 1", t . maxBuffer 1)
179+#endif
180+ ]
181+
182+ let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)
183+ let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec
184+ serialOps spec = mapOps spec $ makeOps serially
185+#ifndef COVERAGE_BUILD
186+ <> [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]
187+ <> [("maxBuffer -1", serially . maxBuffer (-1))]
188+#endif
189+
190+ describe "Construction" $ do
191+ serialOps $ prop "serially replicate" . constructWithReplicate
192+ serialOps $ prop "serially replicateM" . constructWithReplicateM
193+ serialOps $ prop "serially intFromThenTo" .
194+ constructWithIntFromThenTo
195+#if __GLASGOW_HASKELL__ >= 806
196+ serialOps $ prop "serially DoubleFromThenTo" .
197+ constructWithDoubleFromThenTo
198+#endif
199+ serialOps $ prop "serially iterate" . constructWithIterate
200+ -- XXX test for all types of streams
201+ serialOps $ prop "serially iterateM" . constructWithIterateM
202+ serialOps $ prop "serially fromIndices" . constructWithFromIndices
203+ serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM
204+
205+ describe "Functor operations" $ do
206+ serialOps $ functorOps S.fromFoldable "serially" (==)
207+ serialOps $ functorOps folded "serially folded" (==)
208+ describe "Semigroup operations" $ do
209+ serialOps $ semigroupOps "serially" (==)
210+
211+ describe "Applicative operations" $ do
212+ -- The tests using sorted equality are weaker tests
213+ -- We need to have stronger unit tests for all those
214+ -- XXX applicative with three arguments
215+ serialOps $ prop "serially applicative" . applicativeOps S.fromFoldable (==)
216+ serialOps $ prop "serially applicative folded" . applicativeOps folded (==)
217+ serialOps $ prop "serially applicative discard" . applicativeOps1 S.fromFoldable (==)
218+
219+ -- XXX add tests for indexed/indexedR
220+ describe "Zip operations" $ do
221+ -- We test only the serial zip with serial streams and the parallel
222+ -- stream, because the rate setting in these streams can slow down
223+ -- zipAsync.
224+ serialOps $ prop "zip monadic serially" . zipMonadic S.fromFoldable (==)
225+ serialOps $ prop "zip monadic serially folded" . zipMonadic folded (==)
226+
227+ -- XXX add merge tests like zip tests
228+ -- for mergeBy, we can split a list randomly into two lists and
229+ -- then merge them, it should result in original list
230+ -- describe "Merge operations" $ do
231+
232+ describe "Monad operations" $ do
233+ serialOps $ prop "serially monad then" . monadThen S.fromFoldable (==)
234+ serialOps $ prop "serially monad then folded" . monadThen folded (==)
235+ serialOps $ prop "serially monad bind" . monadBind S.fromFoldable (==)
236+ serialOps $ prop "serially monad bind folded" . monadBind folded (==)
237+
238+ describe "Stream transform and combine operations" $ do
239+ serialOps $ transformCombineOpsCommon S.fromFoldable "serially" (==)
240+ serialOps $ transformCombineOpsCommon folded "serially" (==)
241+ serialOps $ transformCombineOpsOrdered S.fromFoldable "serially" (==)
242+ serialOps $ transformCombineOpsOrdered folded "serially" (==)
243+
244+ describe "Stream group and split operations" $ do
245+ groupSplitOps "serially"
246+
247+ describe "Stream elimination operations" $ do
248+ serialOps $ eliminationOps S.fromFoldable "serially"
249+ serialOps $ eliminationOps folded "serially folded"
250+ serialOps $ eliminationOpsWord8 S.fromFoldable "serially"
251+ serialOps $ eliminationOpsWord8 folded "serially folded"
252+
253+ -- XXX Add a test where we chain all transformation APIs and make sure that
254+ -- the state is being passed through all of them.
255+ describe "Stream serial elimination operations" $ do
256+ serialOps $ eliminationOpsOrdered S.fromFoldable "serially"
257+ serialOps $ eliminationOpsOrdered folded "serially folded"
258+
259+ describe "Tests for S.groupsBy" $ do
260+ prop "testGroupsBy" testGroupsBy
261+ prop "testGroupsBySep" testGroupsBySep