@@ -2,204 +2,33 @@
22
33module Main (main) where
44
5−import Control.Applicative (ZipList(..), liftA2)
5+import Control.Applicative (ZipList(..))
66import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)
77import Control.Exception
88 (BlockedIndefinitelyOnMVar(..), catches,
99 BlockedIndefinitelyOnSTM(..), Handler(..))
10−import Control.Monad (when, forM_, replicateM, replicateM_)
11−import Control.Monad.IO.Class (MonadIO(..))
12−import Data.Function ((&))
13−import Data.IORef (readIORef, modifyIORef, newIORef, modifyIORef', IORef)
14−import Data.List
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)
10+import Control.Monad (when, forM_, replicateM_)
11+import Data.IORef (readIORef, modifyIORef, newIORef)
12+import Data.List (sort)
2013import GHC.Word (Word8)
2114
2215import Test.Hspec.QuickCheck
2316import Test.QuickCheck
24− (counterexample, Property, withMaxSuccess, forAll, choose, Gen,
25− arbitrary, elements, frequency, listOf, vectorOf) --, listOf1, suchThat)
26−import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)
17+ (Property, withMaxSuccess)
18+import Test.QuickCheck.Monadic (monadicIO, run)
2719
2820import Test.Hspec as H
2921
3022import Streamly
31−import Streamly.Prelude ((.:), nil)
3223import Streamly as S
3324import qualified Streamly.Prelude as S
34−import qualified Streamly.Data.Fold as FL
35−import qualified Streamly.Internal.Data.Fold as FL
3625
37−maxStreamLen :: Int
38−maxStreamLen = 1000
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
26+import Streamly.Test.Common
27+import Streamly.Test.Prelude
5028
5129sortEq :: Ord a => [a] -> [a] -> Bool
5230sortEq a b = sort a == sort b
5331
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−
20332-------------------------------------------------------------------------------
20433-- Concurrent generation
20534-------------------------------------------------------------------------------
@@ -388,521 +217,6 @@ concurrentFoldrApplication n =
388217 (return [])
389218 listEquals (==) stream list
390219
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−
906220-------------------------------------------------------------------------------
907221-- Zip operations
908222-------------------------------------------------------------------------------
@@ -924,22 +238,6 @@ zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $
924238 listEquals eq stream2 list
925239 listEquals eq stream3 list
926240
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−
943241zipAsyncMonadic
944242 :: IsStream t
945243 => ([Int] -> t IO Int)
@@ -961,88 +259,10 @@ zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $
961259 listEquals eq stream1 list
962260 listEquals eq stream2 list
963261
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−
996262-------------------------------------------------------------------------------
997263-- Tests for S.groupsBy
998264-------------------------------------------------------------------------------
999265
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−
1046266main :: IO ()
1047267main = hspec
1048268 $ H.parallel
@@ -1145,26 +365,12 @@ main = hspec
1145365 zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly
1146366
1147367 describe "Construction" $ do
1148− serialOps $ prop "serially replicate" . constructWithReplicate
1149−
1150− serialOps $ prop "serially replicateM" . constructWithReplicateM
1151368 wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM
1152369 aheadOps $ prop "aheadly replicateM" . constructWithReplicateM
1153370 asyncOps $ prop "asyncly replicateM" . constructWithReplicateM
1154371 wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM
1155372 parallelOps $ prop "parallely replicateM" . constructWithReplicateM
1156373
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
1168374 -- take doesn't work well on concurrent streams. Even though it
1169375 -- seems like take only has a problem when used with parallely.
1170376 -- wSerialOps $ prop "wSerially iterateM" wSerially . constructWithIterate
@@ -1174,13 +380,7 @@ main = hspec
1174380 -- parallelOps $ prop "parallely iterateM" parallely . onstructWithIterate
1175381 -- XXX add tests for fromIndices
1176382
1177− serialOps $ prop "serially fromIndices" . constructWithFromIndices
1178−
1179− serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM
1180−
1181383 describe "Functor operations" $ do
1182− serialOps $ functorOps S.fromFoldable "serially" (==)
1183− serialOps $ functorOps folded "serially folded" (==)
1184384 wSerialOps $ functorOps S.fromFoldable "wSerially" (==)
1185385 wSerialOps $ functorOps folded "wSerially folded" (==)
1186386 aheadOps $ functorOps S.fromFoldable "aheadly" (==)
@@ -1197,7 +397,6 @@ main = hspec
1197397 zipAsyncOps $ functorOps folded "zipAsyncly folded" (==)
1198398
1199399 describe "Semigroup operations" $ do
1200− serialOps $ semigroupOps "serially" (==)
1201400 wSerialOps $ semigroupOps "wSerially" (==)
1202401 aheadOps $ semigroupOps "aheadly" (==)
1203402 asyncOps $ semigroupOps "asyncly" sortEq
@@ -1207,12 +406,6 @@ main = hspec
1207406 zipAsyncOps $ semigroupOps "zipAsyncly" (==)
1208407
1209408 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 (==)
1216409 wSerialOps $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq
1217410 wSerialOps $ prop "wSerially applicative folded" . applicativeOps folded sortEq
1218411 aheadOps $ prop "aheadly applicative" . applicativeOps S.fromFoldable (==)
@@ -1233,8 +426,6 @@ main = hspec
1233426 -- We test only the serial zip with serial streams and the parallel
1234427 -- stream, because the rate setting in these streams can slow down
1235428 -- zipAsync.
1236− serialOps $ prop "zip monadic serially" . zipMonadic S.fromFoldable (==)
1237− serialOps $ prop "zip monadic serially folded" . zipMonadic folded (==)
1238429 wSerialOps $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)
1239430 wSerialOps $ prop "zip monadic wSerially folded" . zipMonadic folded (==)
1240431 aheadOps $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)
@@ -1252,28 +443,24 @@ main = hspec
1252443 -- describe "Merge operations" $ do
1253444
1254445 describe "Monad operations" $ do
1255− serialOps $ prop "serially monad then" . monadThen S.fromFoldable (==)
1256446 wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq
1257447 aheadOps $ prop "aheadly monad then" . monadThen S.fromFoldable (==)
1258448 asyncOps $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq
1259449 wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq
1260450 parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq
1261451
1262− serialOps $ prop "serially monad then folded" . monadThen folded (==)
1263452 wSerialOps $ prop "wSerially monad then folded" . monadThen folded sortEq
1264453 aheadOps $ prop "aheadly monad then folded" . monadThen folded (==)
1265454 asyncOps $ prop "asyncly monad then folded" . monadThen folded sortEq
1266455 wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq
1267456 parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq
1268457
1269− serialOps $ prop "serially monad bind" . monadBind S.fromFoldable (==)
1270458 wSerialOps $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq
1271459 aheadOps $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)
1272460 asyncOps $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq
1273461 wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq
1274462 parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq
1275463
1276− serialOps $ prop "serially monad bind folded" . monadBind folded (==)
1277464 wSerialOps $ prop "wSerially monad bind folded" . monadBind folded sortEq
1278465 aheadOps $ prop "aheadly monad bind folded" . monadBind folded (==)
1279466 asyncOps $ prop "asyncly monad bind folded" . monadBind folded sortEq
@@ -1318,7 +505,6 @@ main = hspec
1318505 concurrentFoldlApplication
1319506
1320507 describe "Stream transform and combine operations" $ do
1321− serialOps $ transformCombineOpsCommon S.fromFoldable "serially" (==)
1322508 wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq
1323509 aheadOps $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)
1324510 asyncOps $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq
@@ -1327,7 +513,6 @@ main = hspec
1327513 zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)
1328514 zipAsyncOps $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)
1329515
1330− serialOps $ transformCombineOpsCommon folded "serially" (==)
1331516 wSerialOps $ transformCombineOpsCommon folded "wSerially" sortEq
1332517 aheadOps $ transformCombineOpsCommon folded "aheadly" (==)
1333518 asyncOps $ transformCombineOpsCommon folded "asyncly" sortEq
@@ -1336,21 +521,15 @@ main = hspec
1336521 zipSerialOps $ transformCombineOpsCommon folded "zipSerially" (==)
1337522 zipAsyncOps $ transformCombineOpsCommon folded "zipAsyncly" (==)
1338523
1339− serialOps $ transformCombineOpsOrdered S.fromFoldable "serially" (==)
1340524 aheadOps $ transformCombineOpsOrdered S.fromFoldable "aheadly" (==)
1341525 zipSerialOps $ transformCombineOpsOrdered S.fromFoldable "zipSerially" (==)
1342526 zipAsyncOps $ transformCombineOpsOrdered S.fromFoldable "zipAsyncly" (==)
1343527
1344− serialOps $ transformCombineOpsOrdered folded "serially" (==)
1345528 aheadOps $ transformCombineOpsOrdered folded "aheadly" (==)
1346529 zipSerialOps $ transformCombineOpsOrdered folded "zipSerially" (==)
1347530 zipAsyncOps $ transformCombineOpsOrdered folded "zipAsyncly" (==)
1348531
1349− describe "Stream group and split operations" $ do
1350− groupSplitOps "serially"
1351−
1352532 describe "Stream elimination operations" $ do
1353− serialOps $ eliminationOps S.fromFoldable "serially"
1354533 wSerialOps $ eliminationOps S.fromFoldable "wSerially"
1355534 aheadOps $ eliminationOps S.fromFoldable "aheadly"
1356535 asyncOps $ eliminationOps S.fromFoldable "asyncly"
@@ -1359,7 +538,6 @@ main = hspec
1359538 zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"
1360539 zipAsyncOps $ eliminationOps S.fromFoldable "zipAsyncly"
1361540
1362− serialOps $ eliminationOps folded "serially folded"
1363541 wSerialOps $ eliminationOps folded "wSerially folded"
1364542 aheadOps $ eliminationOps folded "aheadly folded"
1365543 asyncOps $ eliminationOps folded "asyncly folded"
@@ -1368,7 +546,6 @@ main = hspec
1368546 zipSerialOps $ eliminationOps folded "zipSerially folded"
1369547 zipAsyncOps $ eliminationOps folded "zipAsyncly folded"
1370548
1371− serialOps $ eliminationOpsWord8 S.fromFoldable "serially"
1372549 wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"
1373550 aheadOps $ eliminationOpsWord8 S.fromFoldable "aheadly"
1374551 asyncOps $ eliminationOpsWord8 S.fromFoldable "asyncly"
@@ -1377,7 +554,6 @@ main = hspec
1377554 zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"
1378555 zipAsyncOps $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"
1379556
1380− serialOps $ eliminationOpsWord8 folded "serially folded"
1381557 wSerialOps $ eliminationOpsWord8 folded "wSerially folded"
1382558 aheadOps $ eliminationOpsWord8 folded "aheadly folded"
1383559 asyncOps $ eliminationOpsWord8 folded "asyncly folded"
@@ -1389,18 +565,12 @@ main = hspec
1389565 -- XXX Add a test where we chain all transformation APIs and make sure that
1390566 -- the state is being passed through all of them.
1391567 describe "Stream serial elimination operations" $ do
1392− serialOps $ eliminationOpsOrdered S.fromFoldable "serially"
1393568 wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"
1394569 aheadOps $ eliminationOpsOrdered S.fromFoldable "aheadly"
1395570 zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"
1396571 zipAsyncOps $ eliminationOpsOrdered S.fromFoldable "zipAsyncly"
1397572
1398− serialOps $ eliminationOpsOrdered folded "serially folded"
1399573 wSerialOps $ eliminationOpsOrdered folded "wSerially folded"
1400574 aheadOps $ eliminationOpsOrdered folded "aheadly folded"
1401575 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"
1402576 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"
1403−
1404− describe "Tests for S.groupsBy" $ do
1405− prop "testGroupsBy" testGroupsBy
1406− prop "testGroupsBySep" testGroupsBySep