@@ -7,7 +7,7 @@ module Duct.Threads
77 , async
88 , sample
99 , sync
10− , react
10+ --, react
1111 , threads
1212 )
1313where
@@ -88,9 +88,6 @@ resume ctx = do
8888 -- XXX change the return type to 'a' instead of '[a]'
8989 liftIO $ atomically $ writeTChan chan (PassOnResult (Right r))
9090
91−updateContextEvent :: Context -> a -> Context
92−updateContextEvent ctx evdata = ctx { event = Just $ unsafeCoerce evdata }
93−
9491------------------------------------------------------------------------------
9592-- Thread Management (creation, reaping and killing)
9693------------------------------------------------------------------------------
@@ -343,7 +340,7 @@ loopContextWith ioaction ctx = do
343340 streamData <- liftIO $ ioaction `catch`
344341 \(e :: SomeException) -> return $ SError e
345342
346− let ctx' = updateContextEvent ctx streamData
343+ let ctx' = setContextMailBox ctx streamData
347344 case streamData of
348345 SMore _ -> do
349346 resumeContextWith (\x -> resume x >> return Nothing) ctx'
@@ -364,30 +361,30 @@ loopContextWith ioaction ctx = do
364361parallel :: (Monad m, MonadIO m, MonadBaseControl IO m, MonadThrow m)
365362 => IO (StreamData a) -> AsyncT m (StreamData a)
366363parallel ioaction = AsyncT $ do
367− -- We retrieve the context here and pass it on so that we can resume it
368− -- later. Control resumes at this place when we resume this context after
369− -- generating the event data from the ioaction.
370− context <- get
371− case event context of
372− -- We have already executed the ioaction in the parent thread and put its
373− -- result in the context and now we are continuing the context in a new
374− -- thread. Just return the result of the ioaction stored in the 'event'
375− -- field.
376− j@(Just _) -> do
377− put context { event = Nothing }
378− return $ unsafeCoerce j
379−
380− -- We have to execute the io action and generate an event and then continue
381− -- in this thread or a new thread.
382− Nothing -> do
383− lift $ resumeContextWith (loopContextWith ioaction) context
384−
385− -- We will never reach here if we continued the context in the same
386− -- thread. If we started a new thread then the parent thread reaches
387− -- here.
388− loc <- getLocation
389− when (loc /= RemoteNode) $ setLocation WaitingParent
390− return Nothing
364+ -- We retrieve the context here and pass it on so that we can resume it
365+ -- later. Control resumes at this place when we resume this context in a
366+ -- new thread or in the same thread after generating the event data from
367+ -- the ioaction.
368+ mb <- takeContextMailBox
369+ case mb of
370+ -- We have already executed the ioaction in the parent thread and put
371+ -- its result in the context and now we are continuing the context in a
372+ -- new thread. Just return the result of the ioaction stored in the
373+ -- 'event' field.
374+ Right x -> return (Just x)
375+
376+ -- We have to execute the io action, generate event data, put it in the
377+ -- context mailbox and then continue from the point where this context
378+ -- was retreieved, in this thread or a new thread.
379+ Left ctx -> do
380+ lift $ resumeContextWith (loopContextWith ioaction) ctx
381+
382+ -- We will never reach here if we continued the context in the same
383+ -- thread. If we started a new thread then the parent thread
384+ -- reaches here.
385+ loc <- getLocation
386+ when (loc /= RemoteNode) $ setLocation WaitingParent
387+ return Nothing
391388
392389-- | An task stream generator that produces an infinite stream of tasks by
393390-- running an IO computation in a loop. A task is triggered carrying the output
@@ -452,6 +449,7 @@ sample action interval = do
452449-- into the transient monad using 'react'. Every time the callback is called it
453450-- generates a new task for the transient monad.
454451--
452+{-
455453react
456454 :: (Monad m, MonadIO m)
457455 => ((eventdata -> m response) -> m ())
@@ -472,6 +470,8 @@ react setHandler iob = AsyncT $ do
472470 put context{event=Nothing}
473471 return $ unsafeCoerce j
474472
473+-}
474+
475475------------------------------------------------------------------------------
476476-- Controlling thread quota
477477------------------------------------------------------------------------------