on master help sign in
Add the yield API
commitb1ee90ec4ede0eea565e617ec2dc9b075ea8dfcb authorHarendra Kumar <harendra.kumar@gmail.com> dateSat 19 Aug 2017, 03:22 (9 years ago) parent500d889
2 files changed+12−7
src/Asyncly.hs+1 src/Asyncly/AsyncT.hs+11−7
src/Asyncly.hs+1
@@ -122,6 +122,7 @@
122122module Asyncly
123123 ( AsynclyT
124124 , MonadAsync
125+ , yield
125126
126127 -- * Run
127128 , runAsyncly
src/Asyncly/AsyncT.hs+11−7
@@ -18,6 +18,7 @@
1818module Asyncly.AsyncT
1919 ( AsyncT (..)
2020 , MonadAsync
21+ , yield
2122-- , async
2223-- , makeAsync
2324 )
@@ -107,8 +108,8 @@ instance Monad m => Monoid (AsyncT m a) where
107108 mempty = AsyncT $ \_ stp _ -> stp
108109 mappend (AsyncT m1) m2 = AsyncT $ \ctx stp yld ->
109110 m1 ctx ((runAsyncT m2) ctx stp yld) $ \a _ r ->
110− let yield x = yld a ctx (Just x)
111− in maybe (yield m2) (\rx -> yield $ mappend rx m2) r
111+ let yielder x = yld a ctx (Just x)
112+ in maybe (yielder m2) (\rx -> yielder $ mappend rx m2) r
112113
113114-- We do not use bind for parallelism. That is, we do not start each iteration
114115-- of the list in parallel. That will introduce too much uncontrolled
@@ -133,6 +134,9 @@ instance Monad m => Monad (AsyncT m) where
133134 next = f a
134135 in maybe (run next) (\rx -> run $ next <> (rx >>= f)) r
135136
137+yield :: a -> AsyncT m a -> AsyncT m a
138+yield a m = AsyncT $ \ctx _ yld -> yld a ctx (Just m)
139+
136140------------------------------------------------------------------------------
137141-- Functor
138142------------------------------------------------------------------------------
@@ -171,7 +175,7 @@ push context action = run (Just context) action
171175
172176 where
173177
174− run ctx m = (runAsyncT m) ctx channelStop yield
178+ run ctx m = (runAsyncT m) ctx channelStop yielder
175179
176180 -- XXX make this a bounded channel so that we block if the previous value
177181 -- is not consumed yet.
@@ -186,7 +190,7 @@ push context action = run (Just context) action
186190
187191 done a = channelDone a
188192 continue a ctx m = channelYield a >> run ctx m
189− yield a ctx r = maybe (done a) (\rx -> continue a ctx rx) r
193+ yielder a ctx r = maybe (done a) (\rx -> continue a ctx rx) r
190194
191195-- If an exception occurs we push it to the channel so that it can handled by
192196-- the parent. 'Paused' exceptions are to be collected at the top level.
@@ -220,10 +224,10 @@ pull ctx = AsyncT $ \_ stp yld -> do
220224 Just BlockedIndefinitelyOnSTM -> stp
221225 Nothing -> throwM e
222226 Right ev ->
223− let yield a = yld a Nothing (Just (pull ctx))
227+ let yielder a = yld a Nothing (Just (pull ctx))
224228 in case ev of
225− ChildYield a -> yield a
226− ChildDone _ a -> yield a
229+ ChildYield a -> yielder a
230+ ChildDone _ a -> yielder a
227231 ChildStop _ e -> do
228232 let continue = (runAsyncT (pull ctx)) (Just ctx) stp yld
229233 in maybe continue throwM e