@@ -4,10 +4,8 @@
44module Main (main) where
55
66import Control.Concurrent (threadDelay)
7−import Control.Monad (replicateM)
87import Data.Foldable (forM_)
98import Data.List (sort)
10−import Data.Maybe (fromJust)
119import Test.Hspec
1210
1311import Streamly
@@ -28,12 +26,11 @@ toListParallel = fmap sort . A.toList . parallely
2826main :: IO ()
2927main = hspec $ do
3028 describe "Runners" $ do
29+ -- XXX move these to property tests
3130 it "simple serially" $
3231 (runStreaming . serially) (return (0 :: Int)) `shouldReturn` ()
3332 it "simple serially with IO" $
3433 (runStreaming . serially) (liftIO $ putStrLn "hello") `shouldReturn` ()
35− it "Captures a return value using toList" $
36− toListSerial (return 0) `shouldReturn` ([0] :: [Int])
3734
3835 describe "Empty" $ do
3936 it "Monoid - mempty" $
@@ -48,8 +45,8 @@ main = hspec $ do
4845 ---------------------------------------------------------------------------
4946
5047 describe "Functor (fmap)" $ do
51− it "Simple fmap" $
52− (toListSerial $ fmap (+1) (return 1)) `shouldReturn` ([2] :: [Int])
48+ -- XXX we should do these through property tests by using a
49+ -- construction via list fold construction method.
5350 it "fmap on composed (<>)" $
5451 (toListSerial $ fmap (+1) (return 1 <> return 2))
5552 `shouldReturn` ([2,3] :: [Int])
@@ -62,10 +59,8 @@ main = hspec $ do
6259 ---------------------------------------------------------------------------
6360
6461 describe "Applicative" $ do
65− it "Simple apply" $
66− (toListSerial $ (,) <$> (return 1) <*> (return 2))
67− `shouldReturn` ([(1,2)] :: [(Int, Int)])
68−
62+ -- XXX we should do these through property tests by using a
63+ -- construction via list fold construction method.
6964 it "Apply - serial composed first argument" $
7065 (toListSerial $ (,) <$> (return 1 <> return 2) <*> (return 3))
7166 `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])
@@ -82,21 +77,6 @@ main = hspec $ do
8277 (toListSerial $ (,) <$> (return 1) <*> (return 2 <|> return 3))
8378 `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])
8479
85− ---------------------------------------------------------------------------
86− -- Binds
87− ---------------------------------------------------------------------------
88−
89− describe "Bind then" thenBind
90− describe "Pure bind serial" $ pureBind toListSerial
91− describe "Pure bind serial interleaved" $ pureBind toListInterleaved
92− describe "Pure bind parallel DFS" $ pureBind toListAsync
93− describe "Pure bind parallel BFS" $ pureBind toListParallel
94−
95− describe "Bind (>>=) with empty" $ bindEmpty toListSerial
96− describe "Bind (>->) with empty" $ bindEmpty toListInterleaved
97− describe "Bind (>|>) with empty" $ bindEmpty toListAsync
98− describe "Bind (>>|) with empty" $ bindEmpty toListParallel
99−
10080 ---------------------------------------------------------------------------
10181 -- Monoidal Compositions
10282 ---------------------------------------------------------------------------
@@ -259,48 +239,6 @@ main = hspec $ do
259239 -- TBD combine all binds and all compose in one example
260240 describe "Miscellaneous combined examples" mixedOps
261241
262− ---------------------------------------------------------------------------
263− -- Stream operations
264− ---------------------------------------------------------------------------
265−
266− -- XXX for streams other than StreamT
267− describe "Stream Ops empty" $ streamOperations makeEmptyStream
268− describe "Stream ops singleton constr" $ streamOperations makeSingletonStream1
269− describe "Stream ops singleton folded" $ streamOperations makeSingletonStream2
270− describe "Stream Ops constr" $ streamOperations makeStream1
271− describe "Stream Ops folded" $ streamOperations $ makeStream2
272− ((<>) :: StreamT IO Int -> StreamT IO Int -> StreamT IO Int)
273−
274− describe "Serial zipping" $
275− zipOps A.zipWith A.zipWithM zipping
276− describe "Async zipping" $
277− zipOps A.zipAsyncWith A.zipAsyncWithM zippingAsync
278−
279−makeEmptyStream :: (StreamT IO Int, [Int], Int)
280−makeEmptyStream = (A.nil, [], 0)
281−
282−makeSingletonStream1 :: (StreamT IO Int, [Int], Int)
283−makeSingletonStream1 = (1 `A.cons` A.nil, [1], 1)
284−
285−makeSingletonStream2 :: (StreamT IO Int, [Int], Int)
286−makeSingletonStream2 = (return 1, [1], 1)
287−
288−-- Streams that indicate an end via the stop continuation
289−makeStream1 :: (StreamT IO Int, [Int], Int)
290−makeStream1 =
291− let list = [1..10]
292− stream = A.each list
293− in (stream, list, 10)
294−
295−-- Streams that indicate an end via the yield continuation
296−makeStream2 :: (Streaming t, Monad (t IO))
297− => (t IO Int -> t IO Int -> t IO Int)
298− -> (t IO Int, [Int], Int)
299−makeStream2 f =
300− let list = [1..10]
301− stream = foldMapWith f return list
302− in (stream, list, 10)
303−
304242nestTwoSerial :: Expectation
305243nestTwoSerial =
306244 let s1 = foldMapWith (<>) return [1..4]
@@ -399,61 +337,9 @@ nestTwoParallelNum =
399337 `shouldReturn` ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])
400338-}
401339
402−zipOps :: (Streaming t, Applicative (t IO))
403− => (forall a b c. (a -> b -> c)
404− -> StreamT IO a -> StreamT IO b -> StreamT IO c)
405− -> (forall a b c. (a -> b -> StreamT IO c)
406− -> StreamT IO a -> StreamT IO b -> StreamT IO c)
407− -> (forall a. t IO a -> t IO a)
408− -> Spec
409−zipOps z zM app = do
410− it "zipWith" $
411− let s1 = foldMapWith (<>) return [1..10]
412− s2 = foldMapWith (<>) return [1..]
413− in toListSerial (z (+) s1 s2)
414− `shouldReturn` ([2,4..20] :: [Int])
415−
416− it "zipWithM" $
417− let s1 = foldMapWith (<>) return [1..10]
418− s2 = foldMapWith (<>) return [1..]
419− in toListSerial (zM (\a b -> return (a + b)) s1 s2)
420− `shouldReturn` ([2,4..20] :: [Int])
421−
422− it "Applicative zip" $
423− let s1 = adapt $ serially $ foldMapWith (<>) return [1..10]
424− s2 = adapt $ serially $ foldMapWith (<>) return [1..]
425− f = A.toList . app
426− functorial = f $ (+) <$> s1 <*> s2
427− applicative = f $ pure (+) <*> s1 <*> s2
428− expected = ([2,4..20] :: [Int])
429− in (,) <$> functorial <*> applicative
430− `shouldReturn` (expected, expected)
431−
432340timed :: Int -> StreamT IO Int
433341timed x = liftIO (threadDelay (x * 100000)) >> return x
434342
435−thenBind :: Spec
436−thenBind = do
437− it "Simple runStreaming and 'then' with IO" $
438− (runStreaming . serially) (liftIO (putStrLn "hello") >> liftIO (putStrLn "world"))
439− `shouldReturn` ()
440− it "Then and toList" $
441− toListSerial (return (1 :: Int) >> return 2) `shouldReturn` ([2] :: [Int])
442−
443−type ToListType s = (forall a. Ord a => s IO a -> IO [a])
444−pureBind :: Monad (s IO) => ToListType s -> Spec
445−pureBind l = do
446− it "Bind and toList" $
447− l (return 1 `f` \x -> return 2 `f` \y -> return (x + y))
448− `shouldReturn` ([3] :: [Int])
449− where f = (>>=)
450−
451−bindEmpty :: (Monad (s IO), Alternative (s IO)) => ToListType s -> Spec
452−bindEmpty l = it "Binds with empty" $
453− (l (return (1 :: Int) `f` \_ -> empty `f` \_ -> return 2))
454− `shouldReturn` ([] :: [Int])
455− where f = (>>=)
456−
457343interleaveCheck
458344 :: (StreamT IO Int -> StreamT IO Int -> StreamT IO Int)
459345 -> Spec
@@ -639,96 +525,3 @@ mixedOps = do
639525 return (x11 + y11 + z11)
640526 return (x1 + y1 + z1)
641527 return (x + y + z)
642−
643−streamOperations :: Streaming t => (t IO Int, [Int], Int) -> Spec
644−streamOperations (stream, list, len) = do
645−
646− -- Generation
647− it "replicateM" $ do
648− let x = return (1 :: Int)
649− str <- A.toList . serially $ A.replicateM len x
650− lst <- replicateM len x
651− return $ str == lst
652− `shouldReturn` True
653−
654− it "iterate" $
655− (A.toList . serially . (A.take len) $ (A.iterate (+ 1) (0 :: Int)))
656− `shouldReturn` (take len $ iterate (+ 1) 0)
657−
658− it "iterateM" $ do
659− let addM = (\ y -> return (y + 1))
660− A.toList . serially . (A.take len) $ A.iterateM addM (0 :: Int)
661− `shouldReturn` (take len $ iterate (+ 1) 0)
662−
663−
664− -- Filtering
665− it "filter all out" $ transform (A.filter (> len)) (filter (> len))
666− it "filter all in" $ transform (A.filter (<= len)) (filter (<= len))
667− it "filter even" $ transform (A.filter even) (filter even)
668−
669− it "take all" $ transform (A.take len) (take len)
670− it "take none" $ transform (A.take 0) (take 0)
671− it "take some" $ transform (A.take $ len - 1) (take $ len - 1)
672− it "take one" $ transform (A.take 1) (take 1)
673−
674− it "takeWhile true" $ transform (A.takeWhile (const True))
675− (takeWhile (const True))
676− it "takeWhile false" $ transform (A.takeWhile (const False))
677− (takeWhile (const False))
678− it "takeWhile < some" $ transform (A.takeWhile (< (len `div` 2)))
679− (takeWhile (< (len `div` 2)))
680−
681− it "drop all" $ transform (A.drop len) (drop len)
682− it "drop none" $ transform (A.drop 0) (drop 0)
683− it "drop some" $ transform (A.drop $ len - 1) (drop $ len - 1)
684− it "drop one" $ transform (A.drop 1) (drop 1)
685−
686− it "dropWhile true" $ transform (A.dropWhile (const True))
687− (dropWhile (const True))
688− it "dropWhile false" $ transform (A.dropWhile (const False))
689− (dropWhile (const False))
690− it "dropWhile < some" $ transform (A.dropWhile (< (len `div` 2)))
691− (dropWhile (< (len `div` 2)))
692−
693− -- Transformations
694− it "scan left" $ transform (A.scan (+) 0 id) (scanl (+) 0)
695− it "reverse" $ transform A.reverse reverse
696−
697− -- Elimination
698− it "foldl" $ elimination (A.foldl (+) 0 id) (foldl (+) 0)
699− it "all" $ elimination (A.all even) (all even)
700− it "any" $ elimination (A.any even) (any even)
701− it "length" $ elimination A.length length
702− it "elem" $ elimination (A.elem (len - 1)) (elem (len - 1))
703− it "elem" $ elimination (A.elem (len + 1)) (elem (len + 1))
704− it "notElem" $ elimination (A.notElem (len - 1)) (notElem (len - 1))
705− it "notElem" $ elimination (A.notElem (len + 1)) (notElem (len + 1))
706− it "sum" $ elimination A.sum sum
707− it "product" $ elimination A.product product
708−
709− if list == []
710− then do
711− it "head empty" $ A.head stream `shouldReturn` Nothing
712− it "last empty" $ A.last stream `shouldReturn` Nothing
713− it "maximum empty" $ A.maximum stream `shouldReturn` Nothing
714− it "minimum empty" $ A.minimum stream `shouldReturn` Nothing
715− it "null empty" $ A.null stream `shouldReturn` True
716− it "tail empty" $ (A.tail stream >>= return . maybe True (const False))
717− `shouldReturn` True
718− else do
719− it "head nonEmpty" $ A.head stream `shouldReturn` Just (head list)
720− it "last nonEmpty" $ A.last stream `shouldReturn` Just (last list)
721− it "maximum nonEmpty" $ A.maximum stream
722− `shouldReturn` Just (maximum list)
723− it "minimum nonEmpty" $ A.minimum stream
724− `shouldReturn` Just (minimum list)
725− it "null nonEmpty" $ A.null stream `shouldReturn` False
726− it "tail nonEmpty" $ (A.tail stream >>= A.toList . fromJust)
727− `shouldReturn` tail list
728−
729− where
730− -- XXX run on empty stream as well
731− transform streamOp listOp =
732− (A.toList $ streamOp stream) `shouldReturn` listOp list
733−
734− elimination streamOp listOp = (streamOp stream) `shouldReturn` listOp list