
There's a lot to reply to here... The main reason we don't currently have a timeout combinator in Control.Concurrent is that I haven't yet found one I was happy with (admitedly I haven't tried that hard). The difficulties normally arise with nesting: you want a timeout combinator that nests properly, for composability, and preferably also one that is invisible. So 'timeout N E' should behave exactly the same as E as long as E doesn't time out. Three difficulties with this: 1. if E raises an exception, you want the exception propagated to the parent. 2. if another thread throws an exception to this thread, E should receive the exception. 3. E should get the same result from myThreadId. It sounds like you've got 1, but not 2 and 3. Your timeout nests (which is good!) but it's not completely invisible. Still, I think we should have a timeout, even an imperfect one, since it is clearly a useful thing to have. We should document what its properties are carefully, though. Cheers, Simon Peter Simons wrote:
timeout :: Microseconds -> IO a -> IO (Maybe a)
..., forces the programmer to deal with a timeout condition in-place. My impression is that code reliability is furthered by making error conditions explicit, so I tend to prefer that kind of signature. It is not a strong preference, however.
How do others feel about this topic?
By the way, I have created Trac ticket #980 for this proposal.
I have also had an interesting insight into the child thread problem. I took exception forwarding out of the code because the notion of child and parent threads felt insufficiently well defined. Just because a thread started another one, it doesn't mean that this particular thread is necessarily the correct error handler for the child thread.
Now I realize: the thread responsible for handling the child thread's errors is the one who accesses the child's return value.
This is one of the rare occasions where significant functionality can be added by making the code simpler. :-)
type AsyncMVar a = MVar (Either Exception a)
data Async a = Child ThreadId (AsyncMVar a)
forkAsync' :: IO a -> AsyncMVar a -> IO (Async a) forkAsync' f mv = fmap (\p -> Child p mv) (forkIO f') where f' = block (try f >>= tryPutMVar mv >> return ())
forkAsync :: IO a -> IO (Async a) forkAsync f = newEmptyMVar >>= forkAsync' f
throwToAsync :: Async a -> Exception -> IO () throwToAsync (Child pid _) = throwTo pid
killAsync :: Async a -> IO () killAsync (Child pid _) = killThread pid
isReadyAsync :: Async a -> IO Bool isReadyAsync (Child _ mv) = fmap not (isEmptyMVar mv)
waitForAsync :: Async a -> IO a waitForAsync (Child _ sync) = fmap (either throw id) (readMVar sync)
-- Run both computations in parallel and return the @a@ value -- of the computation that terminates first. An exception in -- either of the two computations aborts the entire parIO -- computation.
parIO :: IO a -> IO a -> IO a parIO f g = do sync <- newEmptyMVar bracket (forkAsync' f sync) (killAsync) (\_ -> bracket (forkAsync' g sync) (killAsync) (waitForAsync))
type MicroSeconds = Int
timeout :: MicroSeconds -> IO a -> IO (Maybe a) timeout n f | n < 0 = fmap Just f | n == 0 = return Nothing | otherwise = (fmap Just f) `parIO` (threadDelay n >> return Nothing)
The need for "a" to be a Monoid is gone, and exceptions propagate nicely too.
Peter