@@ -12,7 +12,7 @@ import Control.Exception
1212import Control.Monad (when, forM_, replicateM, replicateM_)
1313import Control.Monad.IO.Class (MonadIO(..))
1414import Data.Function ((&))
15−import Data.IORef (readIORef, modifyIORef, newIORef)
15+import Data.IORef (readIORef, modifyIORef, newIORef, modifyIORef', IORef)
1616import Data.List
1717 (sort, foldl', scanl', findIndices, findIndex, elemIndices,
1818 elemIndex, find, insertBy, intersperse, foldl1', (\\),
@@ -146,15 +146,56 @@ constructWithDoubleFromThenTo op l =
146146 in constructWithLen stream list op l
147147#endif
148148
149−constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec
150−constructWithIterate t = do
151− it "iterate" $
152− (S.toList . t . S.take 100) (S.iterate (+ 1) (0 :: Int))
153− `shouldReturn` take 100 (iterate (+ 1) 0)
154− it "iterateM" $ do
155− let addM y = return (y + 1)
156− S.toList . t . S.take 100 $ S.iterateM addM (0 :: Int)
157− `shouldReturn` take 100 (iterate (+ 1) 0)
149+constructWithIterate ::
150+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
151+constructWithIterate op len =
152+ withMaxSuccess maxTestCount $
153+ monadicIO $ do
154+ stream <-
155+ run $
156+ (S.toList . op . S.take (fromIntegral len))
157+ (S.iterate (+ 1) (0 :: Int))
158+ let list = take (fromIntegral len) (iterate (+ 1) 0)
159+ listEquals (==) stream list
160+
161+constructWithIterateM ::
162+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
163+constructWithIterateM op len =
164+ withMaxSuccess maxTestCount $
165+ monadicIO $ do
166+ mvl <- run (newIORef [] :: IO (IORef [Int]))
167+ let addM mv x y = modifyIORef' mv (++ [y + x]) >> return (y + x)
168+ list = take (fromIntegral len) (iterate (+ 1) 0)
169+ run $
170+ S.drain . op $
171+ S.take (fromIntegral len) $
172+ S.iterateM (addM mvl 1) (addM mvl 0 0 :: IO Int)
173+ streamEffect <- run $ readIORef mvl
174+ listEquals (==) streamEffect list
175+
176+constructWithFromIndices ::
177+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
178+constructWithFromIndices op len =
179+ withMaxSuccess maxTestCount $
180+ monadicIO $ do
181+ stream <-
182+ run $ (S.toList . op . S.take (fromIntegral len)) (S.fromIndices id)
183+ let list = take (fromIntegral len) (iterate (+ 1) 0)
184+ listEquals (==) stream list
185+
186+constructWithFromIndicesM ::
187+ IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property
188+constructWithFromIndicesM op len =
189+ withMaxSuccess maxTestCount $
190+ monadicIO $ do
191+ mvl <- run (newIORef [] :: IO (IORef [Int]))
192+ let addIndex mv i = modifyIORef' mv (++ [i]) >> return i
193+ list = take (fromIntegral len) (iterate (+ 1) 0)
194+ run $
195+ S.drain . op $
196+ S.take (fromIntegral len) $ S.fromIndicesM (addIndex mvl)
197+ streamEffect <- run $ readIORef mvl
198+ listEquals (==) streamEffect list
158199
159200-------------------------------------------------------------------------------
160201-- Concurrent generation
@@ -560,7 +601,8 @@ transformCombineOpsOrdered constr desc eq t = do
560601 transform (dropWhile (> 0)) t (S.dropWhile (> 0))
561602 prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)
562603
563− -- XXX add uniq
604+ prop (desc <> " uniq") $ transform referenceUniq t S.uniq
605+
564606 prop (desc <> " deleteBy (<=) 0") $
565607 transform (deleteBy (<=) 0) t (S.deleteBy (<=) 0)
566608
@@ -599,10 +641,23 @@ wrapOutOfBounds f i x | null x = Nothing
599641 | otherwise = Just (f x i)
600642
601643wrapThe :: Eq a => [a] -> Maybe a
602−wrapThe (x:xs) | all (x ==) xs = Just x
603− | otherwise = Nothing
644+wrapThe (x:xs)
645+ | all (x ==) xs = Just x
646+ | otherwise = Nothing
604647wrapThe [] = Nothing
605648
649+-- This is the reference uniq implementation to compare uniq against,
650+-- we can use uniq from vector package, but for now this should
651+-- suffice.
652+referenceUniq :: Eq a => [a] -> [a]
653+referenceUniq = go
654+ where
655+ go [] = []
656+ go (x:[]) = [x]
657+ go (x:y:xs)
658+ | x == y = go (x : xs)
659+ | otherwise = x : go (y : xs)
660+
606661eliminationOps
607662 :: ([Int] -> t IO Int)
608663 -> String
@@ -971,10 +1026,24 @@ main = hspec
9711026 serialOps $ prop "serially DoubleFromThenTo" .
9721027 constructWithDoubleFromThenTo
9731028#endif
1029+
1030+ serialOps $ prop "serially iterate" . constructWithIterate
1031+
9741032 -- XXX test for all types of streams
975− constructWithIterate serially
1033+ serialOps $ prop "serially iterateM" . constructWithIterateM
1034+ -- take doesn't work well on concurrent streams. Even though it
1035+ -- seems like take only has a problem when used with parallely.
1036+ -- wSerialOps $ prop "wSerially iterateM" wSerially . constructWithIterate
1037+ -- aheadOps $ prop "aheadly iterateM" aheadly . onstructWithIterate
1038+ -- asyncOps $ prop "asyncly iterateM" asyncly . constructWithIterate
1039+ -- wAsyncOps $ prop "wAsyncly iterateM" wAsyncly . onstructWithIterate
1040+ -- parallelOps $ prop "parallely iterateM" parallely . onstructWithIterate
9761041 -- XXX add tests for fromIndices
9771042
1043+ serialOps $ prop "serially fromIndices" . constructWithFromIndices
1044+
1045+ serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM
1046+
9781047 describe "Functor operations" $ do
9791048 serialOps $ functorOps S.fromFoldable "serially" (==)
9801049 serialOps $ functorOps folded "serially folded" (==)