c99b575 · streamly · git.iko.soy

1module Main (main) where

2

3−import Asyncly

4import Control.Applicative ((<|>), empty)

3import Control.Applicative ((<|>), empty)

5import Control.Monad (mzero)

4import Control.Monad (mzero)

6−import Control.Concurrent (myThreadId, threadDelay)

5+-- import Control.Concurrent (myThreadId, threadDelay)

7−import Data.Monoid ((<>))

8import Control.Monad.IO.Class (liftIO)

6import Control.Monad.IO.Class (liftIO)

9−import Data.List (nub, sort)

7+-- import Data.List (nub)

8+import Data.List (sort)

9+import Data.Monoid ((<>))

10import Test.Hspec

11

12−default (Int)

12+import Asyncly

13

14main :: IO ()

15main = hspec $ do

16 describe "Runners" $ do

17 it "simple runAsyncly" $

18− runAsyncly (return 0) `shouldReturn` ()

18+ runAsyncly (return (0 :: Int)) `shouldReturn` ()

19 it "simple runAsyncly with IO" $

20 runAsyncly (liftIO $ putStrLn "hello") `shouldReturn` ()

21 it "Captures a return value using toList" $

41 describe "Left Biased parallel loops (<|)" $ loops (<|) sort sort

42 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort

43

44+bind :: Spec

44bind = do

45bind = do

45 it "Simple runAsyncly and 'then' with IO" $

46 it "Simple runAsyncly and 'then' with IO" $

46 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world"))

47 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world"))

47 `shouldReturn` ()

48 `shouldReturn` ()

48 it "Then and toList" $

49 it "Then and toList" $

49− toList (return 1 >> return 2) `shouldReturn` ([2] :: [Int])

50+ toList (return (1 :: Int) >> return 2) `shouldReturn` ([2] :: [Int])

50 it "Bind and toList" $

51 it "Bind and toList" $

51 toList (do x <- return 1; y <- return 2; return (x + y))

52 toList (do x <- return 1; y <- return 2; return (x + y))

52 `shouldReturn` ([3] :: [Int])

53 `shouldReturn` ([3] :: [Int])

53

54

55+interleaved :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int) -> Spec

54interleaved f =

56interleaved f =

55 it "Interleave four" $

57 it "Interleave four" $

56− toList ((return (0 :: Int) <> return 1) `f` (return 100 <> return 101))

58+ toList ((return 0 <> return 1) `f` (return 100 <> return 101))

57 `shouldReturn` ([0, 100, 1, 101])

59 `shouldReturn` ([0, 100, 1, 101])

58

60

61+compose

62+ :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)

63+ -> ([Int] -> [Int])

64+ -> Spec

59compose f srt = do

65compose f srt = do

60 it "Compose mempty, mempty" $

66 it "Compose mempty, mempty" $

61− (toList (mempty `f` mempty)) `shouldReturn` ([] :: [Int])

67+ (toList (mempty `f` mempty)) `shouldReturn` []

62 it "Compose empty, empty" $

68 it "Compose empty, empty" $

63− (toList (empty `f` empty)) `shouldReturn` ([] :: [Int])

69+ (toList (empty `f` empty)) `shouldReturn` []

64 it "Compose empty at the beginning" $

70 it "Compose empty at the beginning" $

65− (toList $ (empty `f` return 1)) `shouldReturn` ([1] :: [Int])

71+ (toList $ (empty `f` return 1)) `shouldReturn` [1]

66 it "Compose empty at the end" $

72 it "Compose empty at the end" $

67− (toList $ (return 1 `f` empty)) `shouldReturn` ([1] :: [Int])

73+ (toList $ (return 1 `f` empty)) `shouldReturn` [1]

68 it "Compose two" $

74 it "Compose two" $

69 (toList (return 0 `f` return 1) >>= return . srt)

75 (toList (return 0 `f` return 1) >>= return . srt)

70− `shouldReturn` ([0, 1] :: [Int])

76+ `shouldReturn` [0, 1]

71 it "Compose three - empty in the middle" $

77 it "Compose three - empty in the middle" $

72 ((toList $ (return 0 `f` empty `f` return 1)) >>= return . srt)

78 ((toList $ (return 0 `f` empty `f` return 1)) >>= return . srt)

73− `shouldReturn` ([0, 1] :: [Int])

79+ `shouldReturn` [0, 1]

74 it "Compose left associated" $

80 it "Compose left associated" $

75 ((toList $ (((return 0 `f` return 1) `f` return 2) `f` return 3))

81 ((toList $ (((return 0 `f` return 1) `f` return 2) `f` return 3))

76− >>= return . srt) `shouldReturn` ([0, 1, 2, 3] :: [Int])

82+ >>= return . srt) `shouldReturn` [0, 1, 2, 3]

77 it "Compose right associated" $

83 it "Compose right associated" $

78 ((toList $ (return 0 `f` (return 1 `f` (return 2 `f` return 3))))

84 ((toList $ (return 0 `f` (return 1 `f` (return 2 `f` return 3))))

79− >>= return . srt) `shouldReturn` ([0, 1, 2, 3] :: [Int])

85+ >>= return . srt) `shouldReturn` [0, 1, 2, 3]

80 it "Compose many" $

86 it "Compose many" $

81 ((toList $ forEachWith f [1..100] return) >>= return . srt)

87 ((toList $ forEachWith f [1..100] return) >>= return . srt)

82− `shouldReturn` ([1..100] :: [Int])

88+ `shouldReturn` [1..100]

83 it "Compose many (right fold) with bind" $

89 it "Compose many (right fold) with bind" $

84 (toList (forEachWith f [1..10 :: Int] $ \x -> return x >>= return . id)

90 (toList (forEachWith f [1..10 :: Int] $ \x -> return x >>= return . id)

85− >>= return . srt) `shouldReturn` ([1..10] :: [Int])

91+ >>= return . srt) `shouldReturn` [1..10]

86 it "Compose many (left fold) with bind" $

92 it "Compose many (left fold) with bind" $

87 let forL xs k = foldl f empty $ map k xs

93 let forL xs k = foldl f empty $ map k xs

88 in (toList (forL [1..10 :: Int] $ \x -> return x >>= return . id)

94 in (toList (forL [1..10 :: Int] $ \x -> return x >>= return . id)

89− >>= return . srt) `shouldReturn` ([1..10] :: [Int])

95+ >>= return . srt) `shouldReturn` [1..10]

90 it "Compose hierarchical (multiple levels)" $

96 it "Compose hierarchical (multiple levels)" $

91 ((toList $ (((return 0 `f` return 1) `f` (return 2 `f` return 3))

97 ((toList $ (((return 0 `f` return 1) `f` (return 2 `f` return 3))

92 `f` ((return 4 `f` return 5) `f` (return 6 `f` return 7)))

98 `f` ((return 4 `f` return 5) `f` (return 6 `f` return 7)))

93− ) >>= return . srt) `shouldReturn` ([0..7] :: [Int])

99+ ) >>= return . srt) `shouldReturn` [0..7]

94

100

101+loops

102+ :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int)

103+ -> ([Int] -> [Int])

104+ -> ([Int] -> [Int])

105+ -> Spec

95loops f tsrt hsrt = do

106loops f tsrt hsrt = do

96− it "Tail recursive loop" $

97− (toList (loopTail (0 :: Int)) >>= return . tsrt)

107+ it "Tail recursive loop" $ (toList (loopTail 0) >>= return . tsrt)

98− `shouldReturn` ([0..3] :: [Int])

108+ `shouldReturn` [0..3]

99

109

100− it "Head recursive loop" $

101− (toList (loopHead (0 :: Int)) >>= return . hsrt)

110+ it "Head recursive loop" $ (toList (loopHead 0) >>= return . hsrt)

102− `shouldReturn` ([0..3] :: [Int])

111+ `shouldReturn` [0..3]

103

112

104 where

113 where

105 loopHead x = do

114 loopHead x = do