hsdev-0.3.3.1: src/Control/Concurrent/Util.hs

module Control.Concurrent.Util (
	fork, timeout, sync
	) where

import Control.Concurrent
import Control.Concurrent.Async
import Control.Monad
import Control.Monad.IO.Class

fork :: MonadIO m => IO () -> m ()
fork = liftIO . void . forkIO

timeout :: Int -> IO a -> IO (Maybe a)
timeout 0 act = liftM Just act
timeout tm act = liftM (either Just (const Nothing)) $ race act (threadDelay tm)

sync :: MonadIO m => (IO () -> m a) -> m a
sync act = do
	syncVar <- liftIO newEmptyMVar
	r <- act $ putMVar syncVar ()
	liftIO $ takeMVar syncVar
	return r