content: {-# LANGUAGE MagicHash #-}
  -- !!! test tryTakeMVar
  
  import Control.Concurrent
  import Control.Exception
  
  import GHC.Exts         ( fork# )
  import GHC.IO           ( IO(..) )
  import GHC.Conc         ( ThreadId(..) )
  
  main = do
    m <- newEmptyMVar
    r <- timeout 5 (tryTakeMVar m) (putStrLn "timed out!" >> return Nothing)
    print (r :: Maybe Int)
  
    m <- newMVar True
    r <- timeout 5 (tryTakeMVar m) (putStrLn "timed out!" >> return Nothing)
    print r
  
  timeout
     :: Int       -- secs
     -> IO a      -- action to run
     -> IO a      -- action to run on timeout
     -> IO a
  
  timeout secs action on_timeout
    = do
      threadid <- myThreadId
      timeout <- forkIO $ do threadDelay (secs * 1000000)
                             throwTo threadid (ErrorCall "__timeout")
      ( do result <- action
           killThread timeout
           return result
        )
        `Control.Exception.catch`
          \exception -> case fromException exception of
                         Just (ErrorCall "__timeout") -> on_timeout
                         _other -> do killThread timeout
                                      throw exception
  
  