@@ -138,9 +138,9 @@ forkFinally1 action and_then =
138 _ <- runInIO $ EL.try (restore action) >>= liftIO . and_then
138 _ <- runInIO $ EL.try (restore action) >>= liftIO . and_then
139 return ()
139 return ()
141−forkContext :: (MonadBaseControl IO m, MonadIO m)
141+forkContextWith :: (MonadBaseControl IO m, MonadIO m)
142− => Context -> (Context -> m ()) -> m ()
142+ => (Context -> m ()) -> Context -> m ()
143−forkContext context runCtx = do
143+forkContextWith runCtx context = do
144 child <- childContext context
144 child <- childContext context
145 tid <- forkFinally1 (runCtx child) (beforeExit child)
145 tid <- forkFinally1 (runCtx child) (beforeExit child)
146 updatePendingThreads context tid
146 updatePendingThreads context tid
@@ -179,8 +179,9 @@ forkContext context runCtx = do
179 tid <- myThreadId
179 tid <- myThreadId
180 liftIO $ atomically $ writeTChan p tid
180 liftIO $ atomically $ writeTChan p tid
182−forkMaybe :: (MonadBaseControl IO m, MonadIO m) => Context -> (Context -> m ()) -> m ()
182+forkMaybe :: (MonadBaseControl IO m, MonadIO m)
183+ => (Context -> m ()) -> Context -> m ()
183−forkMaybe context runCtx = do
184+forkMaybe runCtx context = do
184 gotCredit <- liftIO $ waitQSemB (threadCredit context)
185 gotCredit <- liftIO $ waitQSemB (threadCredit context)
185 pending <- liftIO $ readIORef $ pendingThreads context
186 pending <- liftIO $ readIORef $ pendingThreads context
186 case gotCredit of
187 case gotCredit of
@@ -194,8 +195,8 @@ forkMaybe context runCtx = do
194 -- async thread, cannot use sync for those.
195 -- async thread, cannot use sync for those.
195 waitForOneChild (childChannel context)
196 waitForOneChild (childChannel context)
196 (pendingThreads context)
197 (pendingThreads context)
197− forkMaybe context runCtx
198+ forkMaybe runCtx context
198− True -> forkContext context runCtx
199+ True -> forkContextWith runCtx context
200-- | 'StreamData' represents a task in a task stream being generated.
201-- | 'StreamData' represents a task in a task stream being generated.
201data StreamData a =
202data StreamData a =
@@ -220,21 +221,18 @@ data StreamData a =
220-- they can go away rather than waiting indefinitely.
221-- they can go away rather than waiting indefinitely.
222-- | Execute the IO action resume the saved context
223-- | Execute the IO action resume the saved context
223−genAsyncEvents :: (MonadIO m, MonadBaseControl IO m) => Context -> IO (StreamData t) -> m ()
224+runContextWith :: (MonadIO m, MonadBaseControl IO m)
224−genAsyncEvents context rec = forkMaybe context loop
225+ => IO (StreamData t) -> Context -> m ()
225−
226+runContextWith ioaction ctx = do
229− streamData <- liftIO $ rec `catch`
227+ streamData <- liftIO $ ioaction `catch`
230− \(e :: SomeException) -> return $ SError e
228+ \(e :: SomeException) -> return $ SError e
232− let ctx' = updateContextEvent ctx streamData
230+ let ctx' = updateContextEvent ctx streamData
233− case streamData of
231+ case streamData of
234− SMore _ -> do
232+ SMore _ -> do
235− forkMaybe ctx' resume
233+ forkMaybe resume ctx'
236− loop ctx
234+ runContextWith ioaction ctx
237− _ -> resume ctx'
235+ _ -> resume ctx'
239-- | Run an IO action one or more times to generate a stream of tasks. The IO
237-- | Run an IO action one or more times to generate a stream of tasks. The IO
240-- action returns a 'StreamData'. When it returns an 'SMore' or 'SLast' a new
238-- action returns a 'StreamData'. When it returns an 'SMore' or 'SLast' a new
@@ -261,7 +259,7 @@ parallel ioaction = AsyncT $ do
261 -- we have to execute the io action and generate an event and then continue
259 -- we have to execute the io action and generate an event and then continue
262 -- in this thread or a new thread.
260 -- in this thread or a new thread.
263 Nothing -> do
261 Nothing -> do
264− lift $ genAsyncEvents context ioaction
262+ lift $ forkMaybe (runContextWith ioaction) context
265 loc <- getLocation
263 loc <- getLocation
266 when (loc /= RemoteNode) $ setLocation WaitingParent
264 when (loc /= RemoteNode) $ setLocation WaitingParent
267 return Nothing
265 return Nothing