Simplistic timed computations

Timed.hs

module Timed (timed) where

import Control.Concurrent

-- | Fork a process that should return some value within some time limit.
--
-- > timed 10 (threadDelay 100 >> return "takes too long") = Nothing
-- > timed 100 (threadDelay 10 >> return "in time") = Just "in time"
timed :: Int -- microseconds
      -> IO a
      -> IO (Maybe a)
timed s f = do
  -- set up a race between two threads to put a value into a box;
  -- return whatever value is put into the box first.
  box <- newEmptyMVar
  th1 <- forkIO (f >>= putMVar box . Just)
  th2 <- forkIO (threadDelay s >> killThread th1 >> putMVar box Nothing)
  res <- takeMVar box -- will block until f completes or we time out
  killThread th2      -- in case th1 completes first
  return res