-- found somewhere on the web

module Actor.Timeout where
 
import IO
import Control.Concurrent
import Control.Exception

parIO :: IO a -> IO a -> IO a
parIO a1 a2 = do     { m <- newEmptyMVar ;
                       c1 <- forkIO (child m a1) ;
                       c2 <- forkIO (child m a2) ;
                       r <- takeMVar m ;
                       throwTo c1 (AsyncException ThreadKilled) ;
                       throwTo c2 (AsyncException ThreadKilled) ;
                       return r  }
                 where
                    child m a = do { r <- a ; putMVar m r } 


timeout :: Int -> IO a -> IO (Maybe a)
timeout n a = parIO ( do { r <- a ; return (Just r) } )
                    ( do { threadDelay n ; return Nothing } ) 


main = do m <- newEmptyMVar
          res <- timeout 100 (readMVar m)
          case res of
             Nothing -> putStrLn "timeout"
             Just _  -> putStrLn "result"
          return ()