content: {-# LANGUAGE DerivingVia #-}
  {-# OPTIONS_HADDOCK not-home #-}
  module Control.Effect.Internal.Effly where
  
  import Control.Applicative
  import Control.Monad
  import Control.Monad.Fix
  import qualified Control.Monad.Fail as Fail
  import Control.Monad.Base
  import Control.Monad.Trans
  import Control.Monad.Trans.Identity
  import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
  import qualified Control.Monad.Catch
  import Control.Monad.Trans.Control hiding (embed)
  
  import Control.Effect.Type.Alt
  import Control.Effect.Type.ErrorIO
  import Control.Effect.Type.Mask
  import Control.Effect.Type.Bracket
  import Control.Effect.Type.Embed
  import Control.Effect.Type.Fail
  import Control.Effect.Type.Fix
  import Control.Effect.Internal
  import Control.Effect.Internal.Utils
  
  -- | A newtype wrapper with instances based around the effects of @m@
  -- when possible; 'Effly' as in "Effectfully."
  --
  -- This is often useful for making use of these instances inside of
  -- interpreter handlers, or within application code.
  newtype Effly m a = Effly { runEffly :: m a }
    deriving ( Functor, Applicative, Monad
             -- , MonadThrow, MonadCatch, MonadMask -- TODO: Should we keep these?
             , MonadBase b, MonadBaseControl b
             , Carrier
             )
    deriving (MonadTrans, MonadTransControl) via IdentityT
  
  instance Eff Alt m => Alternative (Effly m) where
    empty = send Empty
    {-# INLINE empty #-}
  
    ma <|> mb = send (Alt ma mb)
    {-# INLINE (<|>) #-}
  
  instance Eff Alt m => MonadPlus (Effly m)
  
  instance Eff (Embed IO) m => MonadIO (Effly m) where
    liftIO = send .# Embed
    {-# INLINE liftIO #-}
  
  instance Eff Fix m => MonadFix (Effly m) where
    mfix = send .# Fix
    {-# INLINE mfix #-}
  
  instance Eff Fail m => Fail.MonadFail (Effly m) where
    fail = send .# Fail
    {-# INLINE fail #-}
  
  instance Eff ErrorIO m => MonadThrow (Effly m) where
    throwM = send . ThrowIO
    {-# INLINE throwM #-}
  
  instance Eff ErrorIO m => MonadCatch (Effly m) where
    catch m h = send (CatchIO m h)
    {-# INLINE catch #-}
  
  instance Effs '[Mask, Bracket, ErrorIO] m => MonadMask (Effly m) where
    mask main = send (Mask InterruptibleMask main)
    {-# INLINE mask #-}
  
    uninterruptibleMask main = send (Mask UninterruptibleMask main)
    {-# INLINE uninterruptibleMask #-}
  
    generalBracket acquire release use =
      send (GeneralBracket acquire release use)
    {-# INLINE generalBracket #-}
  