test/Main.hs · streamly

git.iko.soy/streamly

on 57e6232 help sign in

streamly/test/Main.hs

206 lines 9.7 kB history raw

1module Main (main) where

3import Asyncly

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

5import Control.Concurrent (myThreadId, threadDelay)

6import Data.Monoid ((<>))

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

8import Data.List (nub, sort)

9import Test.Hspec

11default (Int)

13main :: IO ()

14main = hspec $ do

15 it "simple runAsyncly" $

16 runAsyncly (return 0) `shouldReturn` ()

17 it "simple runAsyncly with IO" $

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

19 it "Captures a return value using toList" $

20 toList (return 0) `shouldReturn` ([0] :: [Int])

21 it "Monoid composition" $

22 toList (return 0 <> return 1) `shouldReturn` ([0, 1] :: [Int])

23 it "Monoid composition - each" $

24 ((toList $ each [1..100]) >>= return . sort) `shouldReturn` ([1..100] :: [Int])

25 it "simple runAsyncly and 'then' with IO" $

26 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world")) `shouldReturn` ()

27 it "Then and toList" $

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

29 it "Bind and toList" $

30 toList (do x <- return 1; y <- return 2; return (x + y)) `shouldReturn` ([3] :: [Int])

31 it "Alternative - empty" $

32 (toList empty) `shouldReturn` ([] :: [Int])

33 it "Alternative composition - empty <|> empty" $

34 (toList (empty <|> empty)) `shouldReturn` ([] :: [Int])

35 it "Alternative composition - empty at the beginning" $

36 (toList $ (empty <|> return 1)) `shouldReturn` ([1] :: [Int])

37 it "Alternative composition - empty at the end" $

38 (toList $ (return 1 <|> empty)) `shouldReturn` ([1] :: [Int])

39 it "Alternative composition" $

40 ((toList $ (return 0 <|> return 1)) >>= return . sort) `shouldReturn` ([0, 1] :: [Int])

41 it "Alternative composition - empty in the middle" $

42 ((toList $ (return 0 <|> empty <|> return 1)) >>= return . sort) `shouldReturn` ([0, 1] :: [Int])

43 it "Alternative composition - left associated" $

44 ((toList $ (((return 0 <|> return 1) <|> return 2) <|> return 3)) >>= return . sort) `shouldReturn` ([0, 1, 2, 3] :: [Int])

45 it "Alternative composition - right associated" $

46 ((toList $ (return 0 <|> (return 1 <|> (return 2 <|> return 3)))) >>= return . sort) `shouldReturn` ([0, 1, 2, 3] :: [Int])

47 it "Alternative composition (right fold) with bind" $

48 (toList (for [1..10 :: Int] $ \x -> return x >>= return . id) >>= return . sort) `shouldReturn` ([1..10] :: [Int])

49 it "Alternative composition (left fold) with bind" $

50 let forL xs f = foldl (<|>) empty $ map f xs

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

52 it "Alternative composition - hierarchical" $

53 ((toList $ (((return 0 <|> return 1) <|> (return 2 <|> return 3))

54 <|> ((return 4 <|> return 5) <|> (return 6 <|> return 7)))

55 ) >>= return . sort) `shouldReturn` ([0..7] :: [Int])

56 it "loopHead" $

57 toList (loopHead (0 :: Int)) `shouldReturn` ([3, 2..0] :: [Int])

58 it "loopHeadA" $

59 (toList (loopHeadA (0 :: Int)) >>= return . sort)

60 `shouldReturn` ([0..3] :: [Int])

61 it "loopTail" $

62 toList (loopTail (0 :: Int)) `shouldReturn` ([0..3] :: [Int])

63 it "loopTailA" $

64 (toList (loopTailA (0 :: Int)) >>= return . sort)

65 `shouldReturn` ([0..3] :: [Int])

67 {-

68 it "Alternative composition of async and sync tasks" $

69 ((wait (threads 0 ((async (return 0) <|> return 1)))) >>= return . sort)

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

71 it "Alternative composition of async tasks" $

72 (wait (async (return 0) <|> async (return 1)) >>= return . sort)

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

74 it "Nested async tasks with Alternative" $

75 (wait (async (async $ return 0 <|> return 1) <|> return 1) >>= return . sort)

76 `shouldReturn` ([0,1,1] :: [Int])

77 it "General example" $

78 (wait generalExample >>= return . sort)

79 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11,11,11,11,11,11,11,11,11,12,12,12,12,12,13] :: [Int])

80 it "General example synchronous" $

81 (wait (threads 0 generalExample) >>= return . sort)

82 `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11,11,11,11,11,11,11,11,11,12,12,12,12,12,13] :: [Int])

83 it "Alternative forks threads - 1" $

84 ((wait $ (liftIO myThreadId) <|> (liftIO myThreadId))

85 >>= (\x -> print x >> return x)

86 >>= return . \x -> (length x, length (nub x)))

87 `shouldReturn` ((2, 2) :: (Int, Int))

88 it "Alternative forks threads - 2" $

89 ((wait $

90 (liftIO myThreadId)

91 <|> (liftIO myThreadId)

92 <|> (liftIO myThreadId))

93 >>= (\x -> print x >> return x)

94 >>= return . \x -> (length x, length (nub x)))

95 `shouldReturn` ((3, 3) :: (Int, Int))

96 it "Alternative does not fork when using threads 0" $

97 ((wait $ threads 0 $ (liftIO myThreadId) <|> (liftIO myThreadId))

98 >>= (\x -> print x >> return x)

99 >>= return . \x -> (length x, length (nub x)))

100 `shouldReturn` ((2, 1) :: (Int, Int))

101 it "async primitive forces a fork at the end of Alternative\

102 \ (undesired but that's how the implementation behaves)" $

103 ((wait $ threads 0 $ (liftIO myThreadId) <|> async (liftIO myThreadId))

104 >>= (\x -> print x >> return x)

105 >>= return . \x -> (length x, length (nub x)))

106 `shouldReturn` ((2, 2) :: (Int, Int))

107 it "async primitive forces a fork at the beginning" $

108 ((wait $ threads 0 $ async (liftIO myThreadId) <|> (liftIO myThreadId))

109 >>= (\x -> print x >> return x)

110 >>= return . \x -> (length x, length (nub x)))

111 `shouldReturn` ((2, 2) :: (Int, Int))

112 it "async primitive forces a fork in the middle" $

113 ((wait $ threads 0 $

114 (liftIO myThreadId)

115 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)

116 <|> (liftIO myThreadId))

117 >>= (\x -> print x >> return x)

118 >>= return . \x -> (length x, length (nub x)))

119 `shouldReturn` ((3, 2) :: (Int, Int))

120 it "async primitive forces a fork - 3" $

121 ((wait $ threads 0 $

122 (liftIO myThreadId)

123 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)

124 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId))

125 >>= (\x -> print x >> return x)

126 >>= return . \x -> (length x, length (nub x)))

127 `shouldReturn` ((3, 3) :: (Int, Int))

128 it "async primitive forces a fork - 4" $

129 ((wait $ threads 0 $

130 async (liftIO (threadDelay 1000000) >> liftIO myThreadId)

131 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)

132 <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId))

133 >>= (\x -> print x >> return x)

134 >>= return . \x -> (length x, length (nub x)))

135 `shouldReturn` ((3, 3) :: (Int, Int))

136

137 -- Both 0 and 1 must be printed on console

138 it "*>> works as expected" $

139 (wait $ (async (liftIO (putStrLn "0") >> return 0)

140 <|> (liftIO (putStrLn "1") >> return 1))

141 *>> (liftIO (putStrLn "2") >> return 2))

142 `shouldReturn` ([2] :: [Int])

143

144 -- Both 0 and 1 must be printed on console

145 it ">>* works as expected" $

146 (wait $ (return 2

147 >>* (async (liftIO (putStrLn "0") >> return 0)

148 <|> (liftIO (putStrLn "1") >> return 1))

149 )

150 >>* return 2

151 )

152 `shouldReturn` ([2] :: [Int])

153

154 -- 2 and 3 should be printed once and only once

155 it ">>| works as expected" $

156 ((wait $ ((async (liftIO (putStrLn "0") >> return 0)

157 <|> (liftIO (putStrLn "1") >> return 1))

158 >>| (async (liftIO (putStrLn "2") >> return 2)

159 <|> (liftIO (putStrLn "3") >> return 3))

160 )

161 ) >>= return . sort)

162 `shouldReturn` ([0, 1] :: [Int])

163 -}

164 where

165 loopHead x = do

166 -- this print line is important for the test (causes a bind)

167 liftIO $ putStrLn "LoopHead..."

168 (if x < 3 then loopHead (x + 1) else empty) <> return x

169

170 loopHeadA x = do

171 -- this print line is important for the test (causes a bind)

172 liftIO $ putStrLn "LoopHeadA..."

173 (if x < 3 then loopHeadA (x + 1) else empty) <|> return x

174

175 loopTailA x = do

176 -- this print line is important for the test (causes a bind)

177 liftIO $ putStrLn "LoopTailA..."

178 return x <|> (if x < 3 then loopTailA (x + 1) else empty)

179

180 loopTail x = do

181 -- this print line is important for the test (causes a bind)

182 liftIO $ putStrLn "LoopTail..."

183 return x <> (if x < 3 then loopTail (x + 1) else empty)

184

185{-

186generalExample :: AsyncT IO Int

187generalExample = do

188 liftIO $ return ()

189 liftIO $ putStr ""

190 x <- return 1

191 y <- return 2

192 z <- do

193 x1 <- async (return 1) <|> async (return 2)

194 liftIO $ return ()

195 liftIO $ putStr ""

196 y1 <- (return 1) <|> async (return 2)

197 z1 <- do

198 x11 <- async (return 1) <|> (return 2)

199 y11 <- async (return 1) <|> async (return 2)

200 z11 <- async (return 1) <|> (return 2)

201 liftIO $ return ()

202 liftIO $ putStr ""

203 return (x11 + y11 + z11)

204 return (x1 + y1 + z1)

205 return (x + y + z)

206 -}