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 :: IO () -> m ()
fork = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO () -> IO ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO

timeout :: Int -> IO a -> IO (Maybe a)
timeout :: Int -> IO a -> IO (Maybe a)
timeout Int
0 IO a
act = (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just IO a
act
timeout Int
tm IO a
act = (Either a () -> Maybe a) -> IO (Either a ()) -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> Maybe a) -> (() -> Maybe a) -> Either a () -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)) (IO (Either a ()) -> IO (Maybe a))
-> IO (Either a ()) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO () -> IO (Either a ())
forall a b. IO a -> IO b -> IO (Either a b)
race IO a
act (Int -> IO ()
threadDelay Int
tm)

sync :: MonadIO m => (IO () -> m a) -> m a
sync :: (IO () -> m a) -> m a
sync IO () -> m a
act = do
	MVar ()
syncVar <- IO (MVar ()) -> m (MVar ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
	a
r <- IO () -> m a
act (IO () -> m a) -> IO () -> m a
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
syncVar ()
	IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
syncVar
	a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r