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