on master help sign in
Enable threads API and tests
4f3775dHarendra Kumar
src/Asyncly.hs+1−4
@@ -122,20 +122,17 @@
122module Asyncly
122module Asyncly
123 ( AsynclyT
123 ( AsynclyT
124 , MonadAsync
124 , MonadAsync
125− , AsyncT
126
125
127 -- * Run
126 -- * Run
128 , runAsyncly
127 , runAsyncly
129 , toList
128 , toList
130−-- , threads
129+ , threads
131 , each
130 , each
132
131
133{-
132{-
134 -- * Fork and Gather
133 -- * Fork and Gather
135 --, async
134 --, async
136 --, makeAsync
135 --, makeAsync
137− , each
138− --, gather
139
136
140 -- * Record and Play
137 -- * Record and Play
141 --, waitRecord
138 --, waitRecord
src/Asyncly/RunAsync.hs+6−7
@@ -14,14 +14,12 @@
14-- Portability : GHC
14-- Portability : GHC
15--
15--
16module Asyncly.RunAsync
16module Asyncly.RunAsync
17+ ( AsynclyT
17− ( runAsyncly
18+ , runAsyncly
18 , toList
19 , toList
19− , AsynclyT
20−-- , threads
21 , each
20 , each
21+ , threads
22 {-
22 {-
23− , gather
24−
25 , waitRecord_
23 , waitRecord_
26 , waitRecord
24 , waitRecord
27 , playRecordings
25 , playRecordings
@@ -122,8 +120,9 @@ each xs = foldr (<|>) empty $ map return xs
122-- | Runs a computation under a given thread limit. A limit of 0 means all new
120-- | Runs a computation under a given thread limit. A limit of 0 means all new
123-- tasks start synchronously in the current thread unless overridden by
121-- tasks start synchronously in the current thread unless overridden by
124-- 'async'.
122-- 'async'.
125−-- threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
123+threads :: MonadAsync m => Int -> AsynclyT m a -> AsynclyT m a
124+threads n action = AsynclyT $ AsyncT $ \stp yld ->
126−-- threads n action = AsynclyT $ AsyncT $ threadCtl n (runAsyncT $ runAsynclyT action)
125+ threadCtl n ((runAsyncT $ runAsynclyT action) stp yld)
127
126
128{-
127{-
129------------------------------------------------------------------------------
128------------------------------------------------------------------------------
test/Main.hs+13−13
@@ -11,20 +11,20 @@ default (Int)
11
11
12main :: IO ()
12main :: IO ()
13main = hspec $ do
13main = hspec $ do
14− it "simple wait_" $
14+ it "simple runAsyncly" $
15− wait_ (return 0) `shouldReturn` ()
15+ runAsyncly (return 0) `shouldReturn` ()
16− it "simple wait_ with IO" $
16+ it "simple runAsyncly with IO" $
17− wait_ (liftIO $ putStrLn "hello") `shouldReturn` ()
17+ runAsyncly (liftIO $ putStrLn "hello") `shouldReturn` ()
18− it "Captures a return value using wait" $
18+ it "Captures a return value using toList" $
19− wait (return 0) `shouldReturn` ([0] :: [Int])
19+ toList (return 0) `shouldReturn` ([0] :: [Int])
20− it "simple wait_ and 'then' with IO" $
20+ it "simple runAsyncly and 'then' with IO" $
21− wait_ (liftIO (putStrLn "hello") >> liftIO (putStrLn "world")) `shouldReturn` ()
21+ runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world")) `shouldReturn` ()
22− it "Then and wait" $
22+ it "Then and toList" $
23− wait (return 1 >> return 2) `shouldReturn` ([2] :: [Int])
23+ toList (return 1 >> return 2) `shouldReturn` ([2] :: [Int])
24− it "Bind and wait" $
24+ it "Bind and toList" $
25− wait (do x <- return 1; y <- return 2; return (x + y)) `shouldReturn` ([3] :: [Int])
25+ toList (do x <- return 1; y <- return 2; return (x + y)) `shouldReturn` ([3] :: [Int])
26 it "Alternative composition of sync tasks" $
26 it "Alternative composition of sync tasks" $
27− ((wait $ threads 0 $ (return 0 <|> return 1)) >>= return . sort) `shouldReturn` ([0, 1] :: [Int])
27+ ((toList $ threads 0 $ (return 0 <|> return 1)) >>= return . sort) `shouldReturn` ([0, 1] :: [Int])
28 {-
28 {-
29 it "Alternative composition of async and sync tasks" $
29 it "Alternative composition of async and sync tasks" $
30 ((wait (threads 0 ((async (return 0) <|> return 1)))) >>= return . sort)
30 ((wait (threads 0 ((async (return 0) <|> return 1)))) >>= return . sort)