Timeout

[D.J.Steinitz]

There seem to be a few variants of timeout around.
I've copied the one from asynchronous exceptions.

Is this the right one to use? There didn't seem to be
a library version which I thought there should have been.

I'd welcome any advice.

Dominic.

module ConcurrUtil(eitherIO,
                   timeout) where

import Prelude hiding (catch)
import Exception
import Concurrent

data EitherRet a b = A a | B b | X Exception

eitherIO :: IO a -> IO b -> IO (Either a b)
eitherIO a b =
   do m <- newEmptyMVar
      block 
         (do a_id <- forkIO (catch (do r <- unblock a
	                               putMVar m (A r))
                                   (\e -> putMVar m (X e)))
             b_id <- forkIO (catch (do r <- unblock b
                                       putMVar m (B r))
                                   (\e -> putMVar m (X e)))
             let loop = catch (takeMVar m)
	                      (\e -> do throwTo a_id e
	                                throwTo b_id e
			                loop)
             r <- loop
             killThread a_id
             killThread b_id
             case r of 
	        A r -> return (Left r)
	        B r -> return (Right r)
	        X e -> throw e)

timeout :: Int -> IO a -> IO (Maybe a)
timeout t a =
   do r <- eitherIO (threadDelay t) a
      case r of
         Left _  -> return Nothing
	 Right a -> return (Just a)