module Control.Monad.Fork where

import Control.Exception.Safe
import HPrelude

class (Monad m, Functor (Fork m)) => MonadFork m where
  type Fork m :: Type -> Type

  -- suspend :: m a -> m (f a)
  fork :: m a -> m (Fork m a)
  join :: Fork m a -> m a

class (MonadFork m, MonadThrow m) => MonadKill m where
  kill :: (Exception e) => e -> Fork m a -> m ()

instance MonadFork IO where
  type Fork IO = Async
  fork :: forall a. IO a -> IO (Fork IO a)
fork = IO a -> IO (Async a)
IO a -> IO (Fork IO a)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async
  join :: forall a. Fork IO a -> IO a
join = Async a -> IO a
Fork IO a -> IO a
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait

instance MonadKill IO where
  kill :: forall e a. Exception e => e -> Fork IO a -> IO ()
kill = (Async a -> e -> IO ()) -> e -> Async a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Async a -> e -> IO ()
forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Async a -> e -> m ()
cancelWith