{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.Fork.Class
    ( MonadFork (..)
    )
where

import           Control.Concurrent (ThreadId, forkIO)
import           Control.Monad (liftM)
import           Control.Monad.Trans.Control
                     ( MonadBaseControl
                     , MonadTransControl
                     , liftBaseDiscard
                     , liftWith
                     )

------------------------------------------------------------------------------
-- | The 'MonadFork' type class, for monads which support a fork operation.
--
-- The instance for 'IO' is simply 'forkIO', while several very overlapping
-- instances are provided for composite monads, using the monad-control
-- package.
--
-- An example of a monad which has a 'MonadFork' instance that is not simply
-- a lifted form of 'forkIO' is the @ResourceT@ monad from the conduit
-- package, which defines the operation @resourceForkIO@. The instances
-- defined here, using the OverlappingInstances extension, will correctly
-- handle the case of monads transformed on top of @ResourceT@ (assuming a
-- definition exists for @ResourceT@).
class MonadFork m where
    fork :: m () -> m ThreadId


------------------------------------------------------------------------------
instance MonadFork IO where
    fork = forkIO


------------------------------------------------------------------------------
instance (MonadFork b, MonadBaseControl b m) => MonadFork m where
    fork = liftBaseDiscard fork


------------------------------------------------------------------------------
instance (MonadTransControl t, MonadFork m, Monad m) => MonadFork (t m) where
    fork m = liftWith $ \run -> fork $ liftM (const ()) $ run m