@@ -44,6 +44,7 @@ main = hspec $ do
4444 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort
4545
4646 describe "Transformation" $ transformOps (<>)
47+ describe "Miscellaneouse combined examples" mixedOps
4748
4849bind :: Spec
4950bind = do
@@ -147,122 +148,31 @@ transformOps f = do
147148 (toList $ drop 5 $ foldMapWith f return [1..10])
148149 `shouldReturn` [6..10]
149150
150− {-
151− it "Alternative composition of async and sync tasks" $
152− ((wait (threads 0 ((async (return 0) <|> return 1)))) >>= return . sort)
153− `shouldReturn` ([0,1] :: [Int])
154− it "Alternative composition of async tasks" $
155− (wait (async (return 0) <|> async (return 1)) >>= return . sort)
156− `shouldReturn` ([0,1] :: [Int])
157− it "Nested async tasks with Alternative" $
158− (wait (async (async $ return 0 <|> return 1) <|> return 1) >>= return . sort)
159− `shouldReturn` ([0,1,1] :: [Int])
160− it "General example" $
161− (wait generalExample >>= return . sort)
162− `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])
163− it "General example synchronous" $
164− (wait (threads 0 generalExample) >>= return . sort)
165− `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])
166− it "Alternative forks threads - 1" $
167− ((wait $ (liftIO myThreadId) <|> (liftIO myThreadId))
168− >>= (\x -> print x >> return x)
169− >>= return . \x -> (length x, length (nub x)))
170− `shouldReturn` ((2, 2) :: (Int, Int))
171− it "Alternative forks threads - 2" $
172− ((wait $
173− (liftIO myThreadId)
174− <|> (liftIO myThreadId)
175− <|> (liftIO myThreadId))
176− >>= (\x -> print x >> return x)
177− >>= return . \x -> (length x, length (nub x)))
178− `shouldReturn` ((3, 3) :: (Int, Int))
179− it "Alternative does not fork when using threads 0" $
180− ((wait $ threads 0 $ (liftIO myThreadId) <|> (liftIO myThreadId))
181− >>= (\x -> print x >> return x)
182− >>= return . \x -> (length x, length (nub x)))
183− `shouldReturn` ((2, 1) :: (Int, Int))
184− it "async primitive forces a fork at the end of Alternative\
185− \ (undesired but that's how the implementation behaves)" $
186− ((wait $ threads 0 $ (liftIO myThreadId) <|> async (liftIO myThreadId))
187− >>= (\x -> print x >> return x)
188− >>= return . \x -> (length x, length (nub x)))
189− `shouldReturn` ((2, 2) :: (Int, Int))
190− it "async primitive forces a fork at the beginning" $
191− ((wait $ threads 0 $ async (liftIO myThreadId) <|> (liftIO myThreadId))
192− >>= (\x -> print x >> return x)
193− >>= return . \x -> (length x, length (nub x)))
194− `shouldReturn` ((2, 2) :: (Int, Int))
195− it "async primitive forces a fork in the middle" $
196− ((wait $ threads 0 $
197− (liftIO myThreadId)
198− <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
199− <|> (liftIO myThreadId))
200− >>= (\x -> print x >> return x)
201− >>= return . \x -> (length x, length (nub x)))
202− `shouldReturn` ((3, 2) :: (Int, Int))
203− it "async primitive forces a fork - 3" $
204− ((wait $ threads 0 $
205− (liftIO myThreadId)
206− <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
207− <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId))
208− >>= (\x -> print x >> return x)
209− >>= return . \x -> (length x, length (nub x)))
210− `shouldReturn` ((3, 3) :: (Int, Int))
211− it "async primitive forces a fork - 4" $
212− ((wait $ threads 0 $
213− async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
214− <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId)
215− <|> async (liftIO (threadDelay 1000000) >> liftIO myThreadId))
216− >>= (\x -> print x >> return x)
217− >>= return . \x -> (length x, length (nub x)))
218− `shouldReturn` ((3, 3) :: (Int, Int))
151+mixedOps :: Spec
152+mixedOps = do
153+ it "Compose many ops" $
154+ (toList composeMixed >>= return . sort)
155+ `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11
156+ ,11,11,11,11,11,11,11,11,12,12,12,12,12,13
157+ ] :: [Int])
219158
220− -- Both 0 and 1 must be printed on console
221− it "*>> works as expected" $
222− (wait $ (async (liftIO (putStrLn "0") >> return 0)
223− <|> (liftIO (putStrLn "1") >> return 1))
224− *>> (liftIO (putStrLn "2") >> return 2))
225− `shouldReturn` ([2] :: [Int])
226−
227− -- Both 0 and 1 must be printed on console
228− it ">>* works as expected" $
229− (wait $ (return 2
230− >>* (async (liftIO (putStrLn "0") >> return 0)
231− <|> (liftIO (putStrLn "1") >> return 1))
232− )
233− >>* return 2
234− )
235− `shouldReturn` ([2] :: [Int])
236−
237− -- 2 and 3 should be printed once and only once
238− it ">>| works as expected" $
239− ((wait $ ((async (liftIO (putStrLn "0") >> return 0)
240− <|> (liftIO (putStrLn "1") >> return 1))
241− >>| (async (liftIO (putStrLn "2") >> return 2)
242− <|> (liftIO (putStrLn "3") >> return 3))
243− )
244− ) >>= return . sort)
245− `shouldReturn` ([0, 1] :: [Int])
246− -}
247−{-
248−generalExample :: AsyncT IO Int
249−generalExample = do
159+composeMixed :: AsyncT IO Int
160+composeMixed = do
250161 liftIO $ return ()
251162 liftIO $ putStr ""
252163 x <- return 1
253164 y <- return 2
254165 z <- do
255− x1 <- async (return 1) <|> async (return 2)
166+ x1 <- return 1 <|> return 2
256167 liftIO $ return ()
257168 liftIO $ putStr ""
258− y1 <- (return 1) <|> async (return 2)
169+ y1 <- return 1 <| return 2
259170 z1 <- do
260− x11 <- async (return 1) <|> (return 2)
261− y11 <- async (return 1) <|> async (return 2)
262− z11 <- async (return 1) <|> (return 2)
171+ x11 <- return 1 <> return 2
172+ y11 <- return 1 <| return 2
173+ z11 <- return 1 <=> return 2
263174 liftIO $ return ()
264175 liftIO $ putStr ""
265176 return (x11 + y11 + z11)
266177 return (x1 + y1 + z1)
267178 return (x + y + z)
268− -}