{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo Koyoneda
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

This module defines the t'Eff' monad and related fundamental types and functions.
Please refer to the documentation of the [top-level module]("Control.Monad.Hefty").
-}
module Control.Monad.Hefty.Types where

import Control.Applicative (Alternative, empty, (<|>))
import Control.Effect (SendFOE, SendHOE, sendFOE, sendHOE, type (~>))
import Control.Effect.Key (ByKey (ByKey), SendFOEBy, SendHOEBy, key, sendFOEBy, sendHOEBy)
import Control.Monad (MonadPlus)
import Control.Monad.Error.Class (MonadError, catchError, throwError)
import Control.Monad.Fix (MonadFix, mfix)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.RWS (MonadRWS)
import Control.Monad.Reader.Class (MonadReader, ask, local)
import Control.Monad.State.Class (MonadState, get, put)
import Control.Monad.Writer.Class (MonadWriter, listen, pass, tell)
import Data.Effect.Except (Catch, Throw, catch'', throw'')
import Data.Effect.Fail (Fail)
import Data.Effect.Fail qualified as E
import Data.Effect.Fix (Fix)
import Data.Effect.Fix qualified as E
import Data.Effect.Key (Key (Key), KeyH (KeyH))
import Data.Effect.NonDet (ChooseH, Empty, chooseH)
import Data.Effect.NonDet qualified as E
import Data.Effect.OpenUnion.Internal (ElemAt)
import Data.Effect.OpenUnion.Internal.FO (MemberBy, Union, inj, inj0, injN, type (<|))
import Data.Effect.OpenUnion.Internal.HO (MemberHBy, UnionH, inj0H, injH, injNH, type (<<|))
import Data.Effect.OpenUnion.Sum (SumToRecUnionList)
import Data.Effect.Reader (Ask, Local, ask'', local'')
import Data.Effect.State (State, get'', put'')
import Data.Effect.Unlift (UnliftIO)
import Data.Effect.Unlift qualified as E
import Data.Effect.Writer (Tell, WriterH, listen'', tell'')
import Data.FTCQueue (FTCQueue, tsingleton, (|>))
import Data.Function ((&))
import Data.Kind (Type)
import Data.Tuple (swap)
import GHC.TypeNats (KnownNat)
import UnliftIO (MonadUnliftIO, withRunInIO)

{- | The 'Eff' monad represents computations with effects.
It supports higher-order effects @eh@ and first-order effects @ef@.
-}
data Eff eh ef a
    = -- | A pure value.
      Val a
    | -- | An effectful operation, which can be either a higher-order effect or a first-order effect.
      forall x. Op
        (Either (UnionH eh (Eff eh ef) x) (Union ef x))
        (FTCQueue (Eff eh ef) x a)
        -- ^ the continuation of the operation.

infixr 4 :!!

{- | Type-level infix operator for 'Eff'.
Allows writing @eh :!! ef@ instead of @Eff eh ef@.
-}
type (:!!) = Eff

infixr 5 !!

{- | An infix operator version of t`Eff` for sum notation.

Example:

@Span t'Control.Monad.Hefty.Types.!!' FileSystem t'Data.Effect.OpenUnion.Sum.+' Time t'Data.Effect.OpenUnion.Sum.+' Log t'Data.Effect.OpenUnion.Sum.+' t'IO' t'Control.Effect.~>' t'IO'@
-}
type eh !! ef = SumToRecUnionList UnionH eh :!! SumToRecUnionList Union ef

infixr 3 $
infixr 4 $$

-- | Type-level infix applcation for functors.
type (f :: Type -> Type) $ a = f a

-- | Type-level infix applcation for higher-order functors.
type (h :: (Type -> Type) -> Type -> Type) $$ f = h f

{- | Type alias for an interpreter function.

@Interpreter e m ans@ transforms an effect @e@ into a computation in @m@ where the result type (answer type) is @ans@.
-}
type Interpreter e m (ans :: Type) = forall x. e x -> (x -> m ans) -> m ans

{- | Type alias for an elaborator function.

An 'Elaborator' is an interpreter for higher-order effects.
-}
type Elaborator e m ans = Interpreter (e m) m ans

infix 2 ~~>

-- | Type alias for a natural transformation style elaborator.
type e ~~> f = e f ~> f

-- | Send a first-order effect @e@ to the t`Eff` carrier.
send :: (e <| ef) => e ~> Eff eh ef
send :: forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e <| ef) =>
e ~> Eff eh ef
send = Union ef x -> Eff eh ef x
forall (ef :: [EffectF]) a (eh :: [EffectH]).
Union ef a -> Eff eh ef a
sendUnion (Union ef x -> Eff eh ef x)
-> (e x -> Union ef x) -> e x -> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e x -> Union ef x
forall a. e a -> Union ef a
forall (e :: EffectF) (es :: [EffectF]) a.
Member e es =>
e a -> Union es a
inj
{-# INLINE send #-}

-- | Send a higher-order effect @e@ to the t`Eff` carrier.
sendH :: (e <<| eh) => e (Eff eh ef) ~> Eff eh ef
sendH :: forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
(e <<| eh) =>
e (Eff eh ef) ~> Eff eh ef
sendH = UnionH eh (Eff eh ef) x -> Eff eh ef x
forall (eh :: [EffectH]) (ef :: [EffectF]) a.
UnionH eh (Eff eh ef) a -> Eff eh ef a
sendUnionH (UnionH eh (Eff eh ef) x -> Eff eh ef x)
-> (e (Eff eh ef) x -> UnionH eh (Eff eh ef) x)
-> e (Eff eh ef) x
-> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e (Eff eh ef) x -> UnionH eh (Eff eh ef) x
forall (f :: EffectF) a. e f a -> UnionH eh f a
forall (e :: EffectH) (es :: [EffectH]) (f :: EffectF) a.
MemberH e es =>
e f a -> UnionH es f a
injH
{-# INLINE sendH #-}

-- | Send the first-order effect @e@ at the head of the list to the t`Eff` carrier.
send0 :: e ~> Eff eh (e ': ef)
send0 :: forall (e :: EffectF) (eh :: [EffectH]) (ef :: [EffectF]) x.
e x -> Eff eh (e : ef) x
send0 = Union (e : ef) x -> Eff eh (e : ef) x
forall (ef :: [EffectF]) a (eh :: [EffectH]).
Union ef a -> Eff eh ef a
sendUnion (Union (e : ef) x -> Eff eh (e : ef) x)
-> (e x -> Union (e : ef) x) -> e x -> Eff eh (e : ef) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e x -> Union (e : ef) x
forall (e :: EffectF) (es :: [EffectF]) a. e a -> Union (e : es) a
inj0
{-# INLINE send0 #-}

-- | Send the higher-order effect @e@ at the head of the list to the t`Eff` carrier.
send0H :: e (Eff (e ': eh) ef) ~> Eff (e ': eh) ef
send0H :: forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]) x.
e (Eff (e : eh) ef) x -> Eff (e : eh) ef x
send0H = UnionH (e : eh) (Eff (e : eh) ef) x -> Eff (e : eh) ef x
forall (eh :: [EffectH]) (ef :: [EffectF]) a.
UnionH eh (Eff eh ef) a -> Eff eh ef a
sendUnionH (UnionH (e : eh) (Eff (e : eh) ef) x -> Eff (e : eh) ef x)
-> (e (Eff (e : eh) ef) x -> UnionH (e : eh) (Eff (e : eh) ef) x)
-> e (Eff (e : eh) ef) x
-> Eff (e : eh) ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e (Eff (e : eh) ef) x -> UnionH (e : eh) (Eff (e : eh) ef) x
forall (e :: EffectH) (es :: [EffectH]) (f :: EffectF) a.
e f a -> UnionH (e : es) f a
inj0H
{-# INLINE send0H #-}

-- | Send the @i@-th first-order effect in the list to the t`Eff` carrier.
sendN :: forall i ef eh. (KnownNat i) => ElemAt i ef ~> Eff eh ef
sendN :: forall (i :: Nat) (ef :: [EffectF]) (eh :: [EffectH]).
KnownNat i =>
ElemAt i ef ~> Eff eh ef
sendN = Union ef x -> Eff eh ef x
forall (ef :: [EffectF]) a (eh :: [EffectH]).
Union ef a -> Eff eh ef a
sendUnion (Union ef x -> Eff eh ef x)
-> (ElemAt i ef x -> Union ef x) -> ElemAt i ef x -> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (i :: Nat) (es :: [EffectF]) a.
KnownNat i =>
ElemAt i es a -> Union es a
injN @i
{-# INLINE sendN #-}

-- | Send the @i@-th higher-order effect in the list to the t`Eff` carrier.
sendNH :: forall i eh ef. (KnownNat i) => ElemAt i eh (Eff eh ef) ~> Eff eh ef
sendNH :: forall (i :: Nat) (eh :: [EffectH]) (ef :: [EffectF]).
KnownNat i =>
ElemAt i eh (Eff eh ef) ~> Eff eh ef
sendNH = UnionH eh (Eff eh ef) x -> Eff eh ef x
forall (eh :: [EffectH]) (ef :: [EffectF]) a.
UnionH eh (Eff eh ef) a -> Eff eh ef a
sendUnionH (UnionH eh (Eff eh ef) x -> Eff eh ef x)
-> (ElemAt i eh (Eff eh ef) x -> UnionH eh (Eff eh ef) x)
-> ElemAt i eh (Eff eh ef) x
-> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (i :: Nat) (es :: [EffectH]) (f :: EffectF) a.
KnownNat i =>
ElemAt i es f a -> UnionH es f a
injNH @i
{-# INLINE sendNH #-}

-- | Send an open union of all first-order effects to the t`Eff` carrier.
sendUnion :: Union ef a -> Eff eh ef a
sendUnion :: forall (ef :: [EffectF]) a (eh :: [EffectH]).
Union ef a -> Eff eh ef a
sendUnion = (a -> Eff eh ef a) -> Union ef a -> Eff eh ef a
forall a (eh :: [EffectH]) (ef :: [EffectF]) ans.
(a -> Eff eh ef ans) -> Union ef a -> Eff eh ef ans
sendUnionBy a -> Eff eh ef a
forall a. a -> Eff eh ef a
forall (f :: EffectF) a. Applicative f => a -> f a
pure
{-# INLINE sendUnion #-}

-- | Send an open union of all first-order effects, along with its continuation, to the t`Eff` carrier.
sendUnionBy :: (a -> Eff eh ef ans) -> Union ef a -> Eff eh ef ans
sendUnionBy :: forall a (eh :: [EffectH]) (ef :: [EffectF]) ans.
(a -> Eff eh ef ans) -> Union ef a -> Eff eh ef ans
sendUnionBy a -> Eff eh ef ans
k Union ef a
u = Either (UnionH eh (Eff eh ef) a) (Union ef a)
-> FTCQueue (Eff eh ef) a ans -> Eff eh ef ans
forall (eh :: [EffectH]) (ef :: [EffectF]) a x.
Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x a -> Eff eh ef a
Op (Union ef a -> Either (UnionH eh (Eff eh ef) a) (Union ef a)
forall a b. b -> Either a b
Right Union ef a
u) ((a -> Eff eh ef ans) -> FTCQueue (Eff eh ef) a ans
forall a (m :: EffectF) b. (a -> m b) -> FTCQueue m a b
tsingleton a -> Eff eh ef ans
k)
{-# INLINE sendUnionBy #-}

-- | Send an open union of all higher-order effects to the t`Eff` carrier.
sendUnionH :: UnionH eh (Eff eh ef) a -> Eff eh ef a
sendUnionH :: forall (eh :: [EffectH]) (ef :: [EffectF]) a.
UnionH eh (Eff eh ef) a -> Eff eh ef a
sendUnionH = (a -> Eff eh ef a) -> UnionH eh (Eff eh ef) a -> Eff eh ef a
forall a (eh :: [EffectH]) (ef :: [EffectF]) ans.
(a -> Eff eh ef ans) -> UnionH eh (Eff eh ef) a -> Eff eh ef ans
sendUnionHBy a -> Eff eh ef a
forall a. a -> Eff eh ef a
forall (f :: EffectF) a. Applicative f => a -> f a
pure
{-# INLINE sendUnionH #-}

-- | Send an open union of all higher-order effects, along with its continuation, to the t`Eff` carrier.
sendUnionHBy :: (a -> Eff eh ef ans) -> UnionH eh (Eff eh ef) a -> Eff eh ef ans
sendUnionHBy :: forall a (eh :: [EffectH]) (ef :: [EffectF]) ans.
(a -> Eff eh ef ans) -> UnionH eh (Eff eh ef) a -> Eff eh ef ans
sendUnionHBy a -> Eff eh ef ans
k UnionH eh (Eff eh ef) a
u = Either (UnionH eh (Eff eh ef) a) (Union ef a)
-> FTCQueue (Eff eh ef) a ans -> Eff eh ef ans
forall (eh :: [EffectH]) (ef :: [EffectF]) a x.
Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x a -> Eff eh ef a
Op (UnionH eh (Eff eh ef) a
-> Either (UnionH eh (Eff eh ef) a) (Union ef a)
forall a b. a -> Either a b
Left UnionH eh (Eff eh ef) a
u) ((a -> Eff eh ef ans) -> FTCQueue (Eff eh ef) a ans
forall a (m :: EffectF) b. (a -> m b) -> FTCQueue m a b
tsingleton a -> Eff eh ef ans
k)
{-# INLINE sendUnionHBy #-}

instance Functor (Eff eh ef) where
    fmap :: forall a b. (a -> b) -> Eff eh ef a -> Eff eh ef b
fmap a -> b
f = \case
        Val a
x -> b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a. a -> Eff eh ef a
Val (a -> b
f a
x)
        Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
u FTCQueue (Eff eh ef) x a
q -> Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a x.
Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x a -> Eff eh ef a
Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
u (FTCQueue (Eff eh ef) x a
q FTCQueue (Eff eh ef) x a
-> (a -> Eff eh ef b) -> FTCQueue (Eff eh ef) x b
forall (m :: EffectF) a x b.
FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
|> (b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a. a -> Eff eh ef a
Val (b -> Eff eh ef b) -> (a -> b) -> a -> Eff eh ef b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
    {-# INLINE fmap #-}

instance Applicative (Eff eh ef) where
    pure :: forall a. a -> Eff eh ef a
pure = a -> Eff eh ef a
forall (eh :: [EffectH]) (ef :: [EffectF]) a. a -> Eff eh ef a
Val
    {-# INLINE pure #-}

    Val a -> b
f <*> :: forall a b. Eff eh ef (a -> b) -> Eff eh ef a -> Eff eh ef b
<*> Val a
x = b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a. a -> Eff eh ef a
Val (b -> Eff eh ef b) -> b -> Eff eh ef b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
    Val a -> b
f <*> Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
u FTCQueue (Eff eh ef) x a
q = Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a x.
Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x a -> Eff eh ef a
Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
u (FTCQueue (Eff eh ef) x a
q FTCQueue (Eff eh ef) x a
-> (a -> Eff eh ef b) -> FTCQueue (Eff eh ef) x b
forall (m :: EffectF) a x b.
FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
|> (b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a. a -> Eff eh ef a
Val (b -> Eff eh ef b) -> (a -> b) -> a -> Eff eh ef b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
    Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
u FTCQueue (Eff eh ef) x (a -> b)
q <*> Eff eh ef a
m = Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a x.
Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x a -> Eff eh ef a
Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
u (FTCQueue (Eff eh ef) x (a -> b)
q FTCQueue (Eff eh ef) x (a -> b)
-> ((a -> b) -> Eff eh ef b) -> FTCQueue (Eff eh ef) x b
forall (m :: EffectF) a x b.
FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
|> ((a -> b) -> Eff eh ef a -> Eff eh ef b
forall (f :: EffectF) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff eh ef a
m))
    {-# INLINE (<*>) #-}

instance Monad (Eff eh ef) where
    Eff eh ef a
m >>= :: forall a b. Eff eh ef a -> (a -> Eff eh ef b) -> Eff eh ef b
>>= a -> Eff eh ef b
k = case Eff eh ef a
m of
        Val a
x -> a -> Eff eh ef b
k a
x
        Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
e FTCQueue (Eff eh ef) x a
q -> Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x b -> Eff eh ef b
forall (eh :: [EffectH]) (ef :: [EffectF]) a x.
Either (UnionH eh (Eff eh ef) x) (Union ef x)
-> FTCQueue (Eff eh ef) x a -> Eff eh ef a
Op Either (UnionH eh (Eff eh ef) x) (Union ef x)
e (FTCQueue (Eff eh ef) x a
q FTCQueue (Eff eh ef) x a
-> (a -> Eff eh ef b) -> FTCQueue (Eff eh ef) x b
forall (m :: EffectF) a x b.
FTCQueue m a x -> (x -> m b) -> FTCQueue m a b
|> a -> Eff eh ef b
k)
    {-# INLINE (>>=) #-}

instance (e <| ef) => SendFOE e (Eff eh ef) where
    sendFOE :: forall a. e a -> Eff eh ef a
sendFOE = e a -> Eff eh ef a
forall a. e a -> Eff eh ef a
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e <| ef) =>
e ~> Eff eh ef
send
    {-# INLINE sendFOE #-}

instance (e <<| eh) => SendHOE e (Eff eh ef) where
    sendHOE :: forall a. e (Eff eh ef) a -> Eff eh ef a
sendHOE = e (Eff eh ef) a -> Eff eh ef a
forall a. e (Eff eh ef) a -> Eff eh ef a
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
(e <<| eh) =>
e (Eff eh ef) ~> Eff eh ef
sendH
    {-# INLINE sendHOE #-}

instance (MemberBy key e ef) => SendFOEBy key e (Eff eh ef) where
    sendFOEBy :: forall a. e a -> Eff eh ef a
sendFOEBy = Key key e a -> Eff eh ef a
Key key e ~> Eff eh ef
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e <| ef) =>
e ~> Eff eh ef
send (Key key e a -> Eff eh ef a)
-> (e a -> Key key e a) -> e a -> Eff eh ef a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (key :: k) (ins :: EffectF) a. ins a -> Key key ins a
forall {k} (key :: k) (ins :: EffectF) a. ins a -> Key key ins a
Key @key
    {-# INLINE sendFOEBy #-}

instance (MemberHBy key e eh) => SendHOEBy key e (Eff eh ef) where
    sendHOEBy :: forall a. e (Eff eh ef) a -> Eff eh ef a
sendHOEBy = KeyH key e (Eff eh ef) a -> Eff eh ef a
KeyH key e (Eff eh ef) ~> Eff eh ef
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
(e <<| eh) =>
e (Eff eh ef) ~> Eff eh ef
sendH (KeyH key e (Eff eh ef) a -> Eff eh ef a)
-> (e (Eff eh ef) a -> KeyH key e (Eff eh ef) a)
-> e (Eff eh ef) a
-> Eff eh ef a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (key :: k) (sig :: EffectH) (f :: EffectF) a.
sig f a -> KeyH key sig f a
forall {k} (key :: k) (sig :: EffectH) (f :: EffectF) a.
sig f a -> KeyH key sig f a
KeyH @key
    {-# INLINE sendHOEBy #-}

instance
    ( SendFOEBy ReaderKey (Ask r) (Eff eh ef)
    , SendHOEBy ReaderKey (Local r) (Eff eh ef)
    )
    => MonadReader r (Eff eh ef)
    where
    ask :: Eff eh ef r
ask = forall {k} (key :: k) r (f :: EffectF).
SendFOEBy key (Ask r) f =>
f r
forall key r (f :: EffectF). SendFOEBy key (Ask r) f => f r
ask'' @ReaderKey
    local :: forall a. (r -> r) -> Eff eh ef a -> Eff eh ef a
local = forall {k} (key :: k) r a (f :: EffectF).
SendHOEBy key (Local r) f =>
(r -> r) -> f a -> f a
forall key r a (f :: EffectF).
SendHOEBy key (Local r) f =>
(r -> r) -> f a -> f a
local'' @ReaderKey
    {-# INLINE ask #-}
    {-# INLINE local #-}

{- | A key to be attached to the effect targeted by the t`MonadReader` instance.

Since t`MonadReader` has a functional dependency on @r@, this is needed to uniquely specify @r@.
-}
data ReaderKey

instance
    ( SendFOEBy WriterKey (Tell w) (Eff eh ef)
    , SendHOEBy WriterKey (WriterH w) (Eff eh ef)
    , Monoid w
    )
    => MonadWriter w (Eff eh ef)
    where
    tell :: w -> Eff eh ef ()
tell = forall {k} (key :: k) w (f :: EffectF).
SendFOEBy key (Tell w) f =>
w -> f ()
forall key w (f :: EffectF). SendFOEBy key (Tell w) f => w -> f ()
tell'' @WriterKey
    listen :: forall a. Eff eh ef a -> Eff eh ef (a, w)
listen = ((w, a) -> (a, w)) -> Eff eh ef (w, a) -> Eff eh ef (a, w)
forall a b. (a -> b) -> Eff eh ef a -> Eff eh ef b
forall (f :: EffectF) a b. Functor f => (a -> b) -> f a -> f b
fmap (w, a) -> (a, w)
forall a b. (a, b) -> (b, a)
swap (Eff eh ef (w, a) -> Eff eh ef (a, w))
-> (Eff eh ef a -> Eff eh ef (w, a))
-> Eff eh ef a
-> Eff eh ef (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (key :: k) a w (f :: EffectF).
SendHOEBy key (WriterH w) f =>
f a -> f (w, a)
forall key a w (f :: EffectF).
SendHOEBy key (WriterH w) f =>
f a -> f (w, a)
listen'' @WriterKey
    pass :: forall a. Eff eh ef (a, w -> w) -> Eff eh ef a
pass Eff eh ef (a, w -> w)
m = ByKey WriterKey (Eff eh ef) (a, w -> w)
-> ByKey WriterKey (Eff eh ef) a
forall a.
ByKey WriterKey (Eff eh ef) (a, w -> w)
-> ByKey WriterKey (Eff eh ef) a
forall w (m :: EffectF) a. MonadWriter w m => m (a, w -> w) -> m a
pass (Eff eh ef (a, w -> w) -> ByKey WriterKey (Eff eh ef) (a, w -> w)
forall {k} (key :: k) (f :: EffectF) a. f a -> ByKey key f a
ByKey Eff eh ef (a, w -> w)
m) ByKey WriterKey (Eff eh ef) a
-> (ByKey WriterKey (Eff eh ef) a -> Eff eh ef a) -> Eff eh ef a
forall a b. a -> (a -> b) -> b
& forall {k} (key :: k) (f :: EffectF) a. ByKey key f a -> f a
forall key (f :: EffectF) a. ByKey key f a -> f a
key @WriterKey
    {-# INLINE tell #-}
    {-# INLINE listen #-}

{- | A key to be attached to the effect targeted by the t'Control.Monad.Writer.Class.MonadWriter' instance.

Since t'Control.Monad.Writer.Class.MonadWriter' has a functional dependency on @w@, this is needed to uniquely specify @w@.
-}
data WriterKey

instance
    (SendFOEBy StateKey (State s) (Eff eh ef))
    => MonadState s (Eff eh ef)
    where
    get :: Eff eh ef s
get = forall {k} (key :: k) s (f :: EffectF).
SendFOEBy key (State s) f =>
f s
forall key s (f :: EffectF). SendFOEBy key (State s) f => f s
get'' @StateKey
    put :: s -> Eff eh ef ()
put = forall {k} (key :: k) s (f :: EffectF).
SendFOEBy key (State s) f =>
s -> f ()
forall key s (f :: EffectF). SendFOEBy key (State s) f => s -> f ()
put'' @StateKey
    {-# INLINE get #-}
    {-# INLINE put #-}

{- | A key to be attached to the effect targeted by the t`MonadState` instance.

Since t`MonadState` has a functional dependency on @s@, this is needed to uniquely specify @s@.
-}
data StateKey

instance
    ( SendFOEBy ErrorKey (Throw e) (Eff eh ef)
    , SendHOEBy ErrorKey (Catch e) (Eff eh ef)
    )
    => MonadError e (Eff eh ef)
    where
    throwError :: forall a. e -> Eff eh ef a
throwError = forall {k} (key :: k) e a (f :: EffectF).
SendFOEBy key (Throw e) f =>
e -> f a
forall key e a (f :: EffectF).
SendFOEBy key (Throw e) f =>
e -> f a
throw'' @ErrorKey
    catchError :: forall a. Eff eh ef a -> (e -> Eff eh ef a) -> Eff eh ef a
catchError = forall {k} (key :: k) a e (f :: EffectF).
SendHOEBy key (Catch e) f =>
f a -> (e -> f a) -> f a
forall key a e (f :: EffectF).
SendHOEBy key (Catch e) f =>
f a -> (e -> f a) -> f a
catch'' @ErrorKey
    {-# INLINE throwError #-}
    {-# INLINE catchError #-}

{- | A key to be attached to the effect targeted by the t`Control.Monad.Error.Class.MonadError` instance.

Since t`Control.Monad.Error.Class.MonadError` has a functional dependency on @e@, this is needed to uniquely specify @e@.
-}
data ErrorKey

instance
    ( SendFOEBy ReaderKey (Ask r) (Eff eh ef)
    , SendHOEBy ReaderKey (Local r) (Eff eh ef)
    , SendFOEBy WriterKey (Tell w) (Eff eh ef)
    , SendHOEBy WriterKey (WriterH w) (Eff eh ef)
    , SendFOEBy StateKey (State s) (Eff eh ef)
    , Monoid w
    )
    => MonadRWS r w s (Eff eh ef)

instance (Empty <| ef, ChooseH <<| eh) => Alternative (Eff eh ef) where
    empty :: forall a. Eff eh ef a
empty = Eff eh ef a
forall a (f :: EffectF). SendFOE Empty f => f a
E.empty
    Eff eh ef a
a <|> :: forall a. Eff eh ef a -> Eff eh ef a -> Eff eh ef a
<|> Eff eh ef a
b = Eff eh ef a -> Eff eh ef a -> Eff eh ef a
forall a (f :: EffectF). SendHOE ChooseH f => f a -> f a -> f a
chooseH Eff eh ef a
a Eff eh ef a
b
    {-# INLINE empty #-}
    {-# INLINE (<|>) #-}

instance (Empty <| ef, ChooseH <<| eh) => MonadPlus (Eff eh ef)

instance (IO <| ef) => MonadIO (Eff eh ef) where
    liftIO :: forall a. IO a -> Eff eh ef a
liftIO = IO a -> Eff eh ef a
forall a. IO a -> Eff eh ef a
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e <| ef) =>
e ~> Eff eh ef
send
    {-# INLINE liftIO #-}

instance (Fail <| ef) => MonadFail (Eff eh ef) where
    fail :: forall a. String -> Eff eh ef a
fail = String -> Eff eh ef a
forall a (f :: EffectF). SendFOE Fail f => String -> f a
E.fail
    {-# INLINE fail #-}

instance (Fix <<| eh) => MonadFix (Eff eh ef) where
    mfix :: forall a. (a -> Eff eh ef a) -> Eff eh ef a
mfix = (a -> Eff eh ef a) -> Eff eh ef a
forall a (f :: EffectF). SendHOE Fix f => (a -> f a) -> f a
E.mfix

instance (UnliftIO <<| eh, IO <| ef) => MonadUnliftIO (Eff eh ef) where
    withRunInIO :: forall b. ((forall a. Eff eh ef a -> IO a) -> IO b) -> Eff eh ef b
withRunInIO = ((forall a. Eff eh ef a -> IO a) -> IO b) -> Eff eh ef b
forall (f :: EffectF) a.
(UnliftIO <<: f) =>
((f ~> IO) -> IO a) -> f a
E.withRunInIO
    {-# INLINE withRunInIO #-}