@@ -4,10 +4,8 @@
4module Main (main) where
4module Main (main) where
6import Control.Concurrent (threadDelay)
6import Control.Concurrent (threadDelay)
7−import Control.Monad (replicateM)
8import Data.Foldable (forM_)
7import Data.Foldable (forM_)
9import Data.List (sort)
8import Data.List (sort)
10−import Data.Maybe (fromJust)
11import Test.Hspec
9import Test.Hspec
13import Streamly
11import Streamly
@@ -28,12 +26,11 @@ toListParallel = fmap sort . A.toList . parallely
28main :: IO ()
26main :: IO ()
29main = hspec $ do
27main = hspec $ do
30 describe "Runners" $ do
28 describe "Runners" $ do
29+ -- XXX move these to property tests
31 it "simple serially" $
30 it "simple serially" $
32 (runStreaming . serially) (return (0 :: Int)) `shouldReturn` ()
31 (runStreaming . serially) (return (0 :: Int)) `shouldReturn` ()
33 it "simple serially with IO" $
32 it "simple serially with IO" $
34 (runStreaming . serially) (liftIO $ putStrLn "hello") `shouldReturn` ()
33 (runStreaming . serially) (liftIO $ putStrLn "hello") `shouldReturn` ()
35− it "Captures a return value using toList" $
36− toListSerial (return 0) `shouldReturn` ([0] :: [Int])
38 describe "Empty" $ do
35 describe "Empty" $ do
39 it "Monoid - mempty" $
36 it "Monoid - mempty" $
@@ -48,8 +45,8 @@ main = hspec $ do
48 ---------------------------------------------------------------------------
45 ---------------------------------------------------------------------------
50 describe "Functor (fmap)" $ do
47 describe "Functor (fmap)" $ do
51− it "Simple fmap" $
48+ -- XXX we should do these through property tests by using a
52− (toListSerial $ fmap (+1) (return 1)) `shouldReturn` ([2] :: [Int])
49+ -- construction via list fold construction method.
53 it "fmap on composed (<>)" $
50 it "fmap on composed (<>)" $
54 (toListSerial $ fmap (+1) (return 1 <> return 2))
51 (toListSerial $ fmap (+1) (return 1 <> return 2))
55 `shouldReturn` ([2,3] :: [Int])
52 `shouldReturn` ([2,3] :: [Int])
@@ -62,10 +59,8 @@ main = hspec $ do
62 ---------------------------------------------------------------------------
59 ---------------------------------------------------------------------------
64 describe "Applicative" $ do
61 describe "Applicative" $ do
65− it "Simple apply" $
62+ -- XXX we should do these through property tests by using a
66− (toListSerial $ (,) <$> (return 1) <*> (return 2))
63+ -- construction via list fold construction method.
67− `shouldReturn` ([(1,2)] :: [(Int, Int)])
69 it "Apply - serial composed first argument" $
64 it "Apply - serial composed first argument" $
70 (toListSerial $ (,) <$> (return 1 <> return 2) <*> (return 3))
65 (toListSerial $ (,) <$> (return 1 <> return 2) <*> (return 3))
71 `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])
66 `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])
@@ -82,21 +77,6 @@ main = hspec $ do
82 (toListSerial $ (,) <$> (return 1) <*> (return 2 <|> return 3))
77 (toListSerial $ (,) <$> (return 1) <*> (return 2 <|> return 3))
83 `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])
78 `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])
85− ---------------------------------------------------------------------------
87− ---------------------------------------------------------------------------
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
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
100 ---------------------------------------------------------------------------
80 ---------------------------------------------------------------------------
101 -- Monoidal Compositions
81 -- Monoidal Compositions
102 ---------------------------------------------------------------------------
82 ---------------------------------------------------------------------------
@@ -259,48 +239,6 @@ main = hspec $ do
259 -- TBD combine all binds and all compose in one example
239 -- TBD combine all binds and all compose in one example
260 describe "Miscellaneous combined examples" mixedOps
240 describe "Miscellaneous combined examples" mixedOps
262− ---------------------------------------------------------------------------
263− -- Stream operations
264− ---------------------------------------------------------------------------
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)
274− describe "Serial zipping" $
275− zipOps A.zipWith A.zipWithM zipping
276− describe "Async zipping" $
277− zipOps A.zipAsyncWith A.zipAsyncWithM zippingAsync
279−makeEmptyStream :: (StreamT IO Int, [Int], Int)
280−makeEmptyStream = (A.nil, [], 0)
282−makeSingletonStream1 :: (StreamT IO Int, [Int], Int)
283−makeSingletonStream1 = (1 `A.cons` A.nil, [1], 1)
285−makeSingletonStream2 :: (StreamT IO Int, [Int], Int)
286−makeSingletonStream2 = (return 1, [1], 1)
288−-- Streams that indicate an end via the stop continuation
289−makeStream1 :: (StreamT IO Int, [Int], Int)
292− stream = A.each list
293− in (stream, list, 10)
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)
301− stream = foldMapWith f return list
302− in (stream, list, 10)
304nestTwoSerial :: Expectation
242nestTwoSerial :: Expectation
305nestTwoSerial =
243nestTwoSerial =
306 let s1 = foldMapWith (<>) return [1..4]
244 let s1 = foldMapWith (<>) return [1..4]
@@ -399,61 +337,9 @@ nestTwoParallelNum =
399 `shouldReturn` ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])
337 `shouldReturn` ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])
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)
411− let s1 = foldMapWith (<>) return [1..10]
412− s2 = foldMapWith (<>) return [1..]
413− in toListSerial (z (+) s1 s2)
414− `shouldReturn` ([2,4..20] :: [Int])
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])
422− it "Applicative zip" $
423− let s1 = adapt $ serially $ foldMapWith (<>) return [1..10]
424− s2 = adapt $ serially $ foldMapWith (<>) return [1..]
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)
432timed :: Int -> StreamT IO Int
340timed :: Int -> StreamT IO Int
433timed x = liftIO (threadDelay (x * 100000)) >> return x
341timed x = liftIO (threadDelay (x * 100000)) >> return x
437− it "Simple runStreaming and 'then' with IO" $
438− (runStreaming . serially) (liftIO (putStrLn "hello") >> liftIO (putStrLn "world"))
440− it "Then and toList" $
441− toListSerial (return (1 :: Int) >> return 2) `shouldReturn` ([2] :: [Int])
443−type ToListType s = (forall a. Ord a => s IO a -> IO [a])
444−pureBind :: Monad (s IO) => ToListType s -> Spec
446− it "Bind and toList" $
447− l (return 1 `f` \x -> return 2 `f` \y -> return (x + y))
448− `shouldReturn` ([3] :: [Int])
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])
457interleaveCheck
343interleaveCheck
458 :: (StreamT IO Int -> StreamT IO Int -> StreamT IO Int)
344 :: (StreamT IO Int -> StreamT IO Int -> StreamT IO Int)
@@ -639,96 +525,3 @@ mixedOps = do
639 return (x11 + y11 + z11)
525 return (x11 + y11 + z11)
640 return (x1 + y1 + z1)
526 return (x1 + y1 + z1)
641 return (x + y + z)
527 return (x + y + z)
643−streamOperations :: Streaming t => (t IO Int, [Int], Int) -> Spec
644−streamOperations (stream, list, len) = do
647− it "replicateM" $ do
648− let x = return (1 :: Int)
649− str <- A.toList . serially $ A.replicateM len x
650− lst <- replicateM len x
655− (A.toList . serially . (A.take len) $ (A.iterate (+ 1) (0 :: Int)))
656− `shouldReturn` (take len $ iterate (+ 1) 0)
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)
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)
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)
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)))
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)
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)))
694− it "scan left" $ transform (A.scan (+) 0 id) (scanl (+) 0)
695− it "reverse" $ transform A.reverse reverse
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
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))
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
730− -- XXX run on empty stream as well
731− transform streamOp listOp =
732− (A.toList $ streamOp stream) `shouldReturn` listOp list
734− elimination streamOp listOp = (streamOp stream) `shouldReturn` listOp list