{-# 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 { Effly m a -> m a
runEffly :: m a }
  deriving ( a -> Effly m b -> Effly m a
(a -> b) -> Effly m a -> Effly m b
(forall a b. (a -> b) -> Effly m a -> Effly m b)
-> (forall a b. a -> Effly m b -> Effly m a) -> Functor (Effly m)
forall a b. a -> Effly m b -> Effly m a
forall a b. (a -> b) -> Effly m a -> Effly m b
forall (m :: * -> *) a b. Functor m => a -> Effly m b -> Effly m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Effly m a -> Effly m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Effly m b -> Effly m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> Effly m b -> Effly m a
fmap :: (a -> b) -> Effly m a -> Effly m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Effly m a -> Effly m b
Functor, Functor (Effly m)
a -> Effly m a
Functor (Effly m)
-> (forall a. a -> Effly m a)
-> (forall a b. Effly m (a -> b) -> Effly m a -> Effly m b)
-> (forall a b c.
    (a -> b -> c) -> Effly m a -> Effly m b -> Effly m c)
-> (forall a b. Effly m a -> Effly m b -> Effly m b)
-> (forall a b. Effly m a -> Effly m b -> Effly m a)
-> Applicative (Effly m)
Effly m a -> Effly m b -> Effly m b
Effly m a -> Effly m b -> Effly m a
Effly m (a -> b) -> Effly m a -> Effly m b
(a -> b -> c) -> Effly m a -> Effly m b -> Effly m c
forall a. a -> Effly m a
forall a b. Effly m a -> Effly m b -> Effly m a
forall a b. Effly m a -> Effly m b -> Effly m b
forall a b. Effly m (a -> b) -> Effly m a -> Effly m b
forall a b c. (a -> b -> c) -> Effly m a -> Effly m b -> Effly m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (Effly m)
forall (m :: * -> *) a. Applicative m => a -> Effly m a
forall (m :: * -> *) a b.
Applicative m =>
Effly m a -> Effly m b -> Effly m a
forall (m :: * -> *) a b.
Applicative m =>
Effly m a -> Effly m b -> Effly m b
forall (m :: * -> *) a b.
Applicative m =>
Effly m (a -> b) -> Effly m a -> Effly m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Effly m a -> Effly m b -> Effly m c
<* :: Effly m a -> Effly m b -> Effly m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
Effly m a -> Effly m b -> Effly m a
*> :: Effly m a -> Effly m b -> Effly m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
Effly m a -> Effly m b -> Effly m b
liftA2 :: (a -> b -> c) -> Effly m a -> Effly m b -> Effly m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Effly m a -> Effly m b -> Effly m c
<*> :: Effly m (a -> b) -> Effly m a -> Effly m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
Effly m (a -> b) -> Effly m a -> Effly m b
pure :: a -> Effly m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> Effly m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (Effly m)
Applicative, Applicative (Effly m)
a -> Effly m a
Applicative (Effly m)
-> (forall a b. Effly m a -> (a -> Effly m b) -> Effly m b)
-> (forall a b. Effly m a -> Effly m b -> Effly m b)
-> (forall a. a -> Effly m a)
-> Monad (Effly m)
Effly m a -> (a -> Effly m b) -> Effly m b
Effly m a -> Effly m b -> Effly m b
forall a. a -> Effly m a
forall a b. Effly m a -> Effly m b -> Effly m b
forall a b. Effly m a -> (a -> Effly m b) -> Effly m b
forall (m :: * -> *). Monad m => Applicative (Effly m)
forall (m :: * -> *) a. Monad m => a -> Effly m a
forall (m :: * -> *) a b.
Monad m =>
Effly m a -> Effly m b -> Effly m b
forall (m :: * -> *) a b.
Monad m =>
Effly m a -> (a -> Effly m b) -> Effly m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Effly m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Effly m a
>> :: Effly m a -> Effly m b -> Effly m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Effly m a -> Effly m b -> Effly m b
>>= :: Effly m a -> (a -> Effly m b) -> Effly m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Effly m a -> (a -> Effly m b) -> Effly m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (Effly m)
Monad
           -- , MonadThrow, MonadCatch, MonadMask -- TODO: Should we keep these?
           , MonadBase b, MonadBaseControl b
           , Monad (Effly m)
Monad (Effly m)
-> (forall a. Algebra' (Prims (Effly m)) (Effly m) a)
-> (forall (z :: * -> *) a.
    Monad z =>
    Reformulation' (Derivs (Effly m)) (Prims (Effly m)) (Effly m) z a)
-> (forall a. Algebra' (Derivs (Effly m)) (Effly m) a)
-> Carrier (Effly m)
Algebra' (Derivs (Effly m)) (Effly m) a
Algebra' (Prims (Effly m)) (Effly m) a
Reformulation' (Derivs (Effly m)) (Prims (Effly m)) (Effly m) z a
forall a. Algebra' (Derivs (Effly m)) (Effly m) a
forall a. Algebra' (Prims (Effly m)) (Effly m) a
forall (m :: * -> *).
Monad m
-> (forall a. Algebra' (Prims m) m a)
-> (forall (z :: * -> *) a.
    Monad z =>
    Reformulation' (Derivs m) (Prims m) m z a)
-> (forall a. Algebra' (Derivs m) m a)
-> Carrier m
forall (m :: * -> *). Carrier m => Monad (Effly m)
forall (m :: * -> *) a.
Carrier m =>
Algebra' (Derivs (Effly m)) (Effly m) a
forall (m :: * -> *) a.
Carrier m =>
Algebra' (Prims (Effly m)) (Effly m) a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs (Effly m)) (Prims (Effly m)) (Effly m) z a
forall (z :: * -> *) a.
Monad z =>
Reformulation' (Derivs (Effly m)) (Prims (Effly m)) (Effly m) z a
algDerivs :: Algebra' (Derivs (Effly m)) (Effly m) a
$calgDerivs :: forall (m :: * -> *) a.
Carrier m =>
Algebra' (Derivs (Effly m)) (Effly m) a
reformulate :: Reformulation' (Derivs (Effly m)) (Prims (Effly m)) (Effly m) z a
$creformulate :: forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs (Effly m)) (Prims (Effly m)) (Effly m) z a
algPrims :: Algebra' (Prims (Effly m)) (Effly m) a
$calgPrims :: forall (m :: * -> *) a.
Carrier m =>
Algebra' (Prims (Effly m)) (Effly m) a
$cp1Carrier :: forall (m :: * -> *). Carrier m => Monad (Effly m)
Carrier
           )
  deriving (m a -> Effly m a
(forall (m :: * -> *) a. Monad m => m a -> Effly m a)
-> MonadTrans Effly
forall (m :: * -> *) a. Monad m => m a -> Effly m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Effly m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> Effly m a
MonadTrans, MonadTrans Effly
m (StT Effly a) -> Effly m a
MonadTrans Effly
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run Effly -> m a) -> Effly m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT Effly a) -> Effly m a)
-> MonadTransControl Effly
(Run Effly -> m a) -> Effly m a
forall (m :: * -> *) a. Monad m => m (StT Effly a) -> Effly m a
forall (m :: * -> *) a. Monad m => (Run Effly -> m a) -> Effly m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT Effly a) -> Effly m a
$crestoreT :: forall (m :: * -> *) a. Monad m => m (StT Effly a) -> Effly m a
liftWith :: (Run Effly -> m a) -> Effly m a
$cliftWith :: forall (m :: * -> *) a. Monad m => (Run Effly -> m a) -> Effly m a
$cp1MonadTransControl :: MonadTrans Effly
MonadTransControl) via IdentityT

instance Eff Alt m => Alternative (Effly m) where
  empty :: Effly m a
empty = Alt (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send Alt (Effly m) a
forall k (m :: k -> *) (a :: k). Alt m a
Empty
  {-# INLINE empty #-}

  Effly m a
ma <|> :: Effly m a -> Effly m a -> Effly m a
<|> Effly m a
mb = Alt (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Effly m a -> Effly m a -> Alt (Effly m) a
forall k (m :: k -> *) (a :: k). m a -> m a -> Alt m a
Alt Effly m a
ma Effly m a
mb)
  {-# INLINE (<|>) #-}

instance Eff Alt m => MonadPlus (Effly m)

instance Eff (Embed IO) m => MonadIO (Effly m) where
  liftIO :: IO a -> Effly m a
liftIO = Embed IO (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Embed IO (Effly m) a -> Effly m a)
-> (IO a -> Embed IO (Effly m) a) -> IO a -> Effly m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IO a -> Embed IO (Effly m) a
forall k k (b :: k -> *) (a :: k) (m :: k). b a -> Embed b m a
Embed
  {-# INLINE liftIO #-}

instance Eff Fix m => MonadFix (Effly m) where
  mfix :: (a -> Effly m a) -> Effly m a
mfix = Fix (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Fix (Effly m) a -> Effly m a)
-> ((a -> Effly m a) -> Fix (Effly m) a)
-> (a -> Effly m a)
-> Effly m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# (a -> Effly m a) -> Fix (Effly m) a
forall a (m :: * -> *). (a -> m a) -> Fix m a
Fix
  {-# INLINE mfix #-}

instance Eff Fail m => Fail.MonadFail (Effly m) where
  fail :: String -> Effly m a
fail = Fail (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Fail (Effly m) a -> Effly m a)
-> (String -> Fail (Effly m) a) -> String -> Effly m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# String -> Fail (Effly m) a
forall k k (m :: k) (a :: k). String -> Fail m a
Fail
  {-# INLINE fail #-}

instance Eff ErrorIO m => MonadThrow (Effly m) where
  throwM :: e -> Effly m a
throwM = ErrorIO (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (ErrorIO (Effly m) a -> Effly m a)
-> (e -> ErrorIO (Effly m) a) -> e -> Effly m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorIO (Effly m) a
forall k e (m :: k -> *) (a :: k). Exception e => e -> ErrorIO m a
ThrowIO
  {-# INLINE throwM #-}

instance Eff ErrorIO m => MonadCatch (Effly m) where
  catch :: Effly m a -> (e -> Effly m a) -> Effly m a
catch Effly m a
m e -> Effly m a
h = ErrorIO (Effly m) a -> Effly m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Effly m a -> (e -> Effly m a) -> ErrorIO (Effly m) a
forall k e (m :: k -> *) (a :: k).
Exception e =>
m a -> (e -> m a) -> ErrorIO m a
CatchIO Effly m a
m e -> Effly m a
h)
  {-# INLINE catch #-}

instance Effs '[Mask, Bracket, ErrorIO] m => MonadMask (Effly m) where
  mask :: ((forall a. Effly m a -> Effly m a) -> Effly m b) -> Effly m b
mask (forall a. Effly m a -> Effly m a) -> Effly m b
main = Mask (Effly m) b -> Effly m b
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (MaskMode
-> ((forall a. Effly m a -> Effly m a) -> Effly m b)
-> Mask (Effly m) b
forall k (m :: k -> *) (a :: k).
MaskMode -> ((forall (x :: k). m x -> m x) -> m a) -> Mask m a
Mask MaskMode
InterruptibleMask (forall a. Effly m a -> Effly m a) -> Effly m b
main)
  {-# INLINE mask #-}

  uninterruptibleMask :: ((forall a. Effly m a -> Effly m a) -> Effly m b) -> Effly m b
uninterruptibleMask (forall a. Effly m a -> Effly m a) -> Effly m b
main = Mask (Effly m) b -> Effly m b
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (MaskMode
-> ((forall a. Effly m a -> Effly m a) -> Effly m b)
-> Mask (Effly m) b
forall k (m :: k -> *) (a :: k).
MaskMode -> ((forall (x :: k). m x -> m x) -> m a) -> Mask m a
Mask MaskMode
UninterruptibleMask (forall a. Effly m a -> Effly m a) -> Effly m b
main)
  {-# INLINE uninterruptibleMask #-}

  generalBracket :: Effly m a
-> (a -> ExitCase b -> Effly m c)
-> (a -> Effly m b)
-> Effly m (b, c)
generalBracket Effly m a
acquire a -> ExitCase b -> Effly m c
release a -> Effly m b
use =
    Bracket (Effly m) (b, c) -> Effly m (b, c)
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Effly m a
-> (a -> ExitCase b -> Effly m c)
-> (a -> Effly m b)
-> Bracket (Effly m) (b, c)
forall (m :: * -> *) a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> Bracket m (b, c)
GeneralBracket Effly m a
acquire a -> ExitCase b -> Effly m c
release a -> Effly m b
use)
  {-# INLINE generalBracket #-}