{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- | The 'Algebra' class is the mechanism with which effects are interpreted.

An instance of the 'Algebra' class defines an interpretation of an effect signature atop a given monad.

@since 1.0.0.0
-}
module Control.Algebra
( Algebra(..)
, thread
, run
, Has
, send
  -- * Re-exports
, Handler
, (~<~)
, (:+:) (..)
) where

import           Control.Algebra.Handler
#if MIN_VERSION_transformers(0,5,4)
import           Control.Effect.Accum.Internal
#endif
import           Control.Effect.Catch.Internal
import           Control.Effect.Choose.Internal
import           Control.Effect.Empty.Internal
import           Control.Effect.Error.Internal
import           Control.Effect.Lift.Internal
import           Control.Effect.NonDet.Internal
import           Control.Effect.Reader.Internal
import           Control.Effect.State.Internal
import           Control.Effect.Sum ((:+:)(..), Member(..), Members)
import           Control.Effect.Throw.Internal
import           Control.Effect.Writer.Internal
#if MIN_VERSION_transformers(0,5,4)
import qualified Control.Monad.Trans.Accum as Accum
#endif
import qualified Control.Monad.Trans.Except as Except
import qualified Control.Monad.Trans.Identity as Identity
import qualified Control.Monad.Trans.Maybe as Maybe
import qualified Control.Monad.Trans.Reader as Reader
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.RWS.CPS as RWS.CPS
#endif
import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
import qualified Control.Monad.Trans.State.Lazy as State.Lazy
import qualified Control.Monad.Trans.State.Strict as State.Strict
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.Writer.CPS as Writer.CPS
#endif
import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
import           Data.Functor.Compose
import           Data.Functor.Identity
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Monoid

-- | The class of carriers (results) for algebras (effect handlers) over signatures (effects), whose actions are given by the 'alg' method.
--
-- @since 1.0.0.0
class Monad m => Algebra sig m | m -> sig where
  -- | Interpret an effect, running any nested actions using a 'Handler' starting from an initial state in @ctx@.
  --
  -- Instances receive a signature of effects containing actions in @n@ which can be lowered to @m@ using the passed 'Handler' and initial context. Continuations in @n@ can be handled after mapping into contexts returned from previous actions.
  --
  -- For example, considering the 'Algebra' instance for @'Either' e@:
  --
  -- > instance Algebra (Error e) (Either e) where
  -- >   alg hdl sig ctx = case sig of
  -- >     L (Throw e)   -> Left e
  -- >     R (Catch m h) -> either (hdl . (<$ ctx) . h) pure (hdl (m <$ ctx))
  --
  -- The 'Catch' case holds actions @m :: n x@ and @h :: e -> n x@ (for some existentially-quantified type @x@), and a continuation @k :: x -> n a@. The algebra must return @m (ctx a)@, so we have to ultimately use and lower the continuation in order to produce that type. The continuation takes an @x@, which we can get from either of the actions, after lowering them to values in @'Either' e@.
  --
  -- To that end, the algebra lifts both the action @m@ and the result of the error handler @h@ into the initial context @ctx@ before lowering them with @hdl@. The continuation @k@ is 'fmap'ed into the resulting context and then itself lowered with @hdl@.
  --
  -- By contrast, the 'Throw' case can simply return a value in 'Left', since there is no continuation to call—it represents an exceptional return—and @'Left' e :: forall a . Either e a@ (i.e. 'Left' is polymorphic in @a@).
  --
  -- Instances for monad transformers will most likely handle a signature containing multiple effects, with the tail of the signature handled by whatever monad the transformer wraps. In these cases, the tail of the signature can be delegated most conveniently using 'thread'; see the 'Algebra' instances for @transformers@ types such as 'Reader.ReaderT' and 'Except.ExceptT' for details.
  alg
    :: Functor ctx
    => Handler ctx n m -- ^ A 'Handler' lowering computations inside the effect into the carrier type @m@.
    -> sig n a         -- ^ The effect signature to be interpreted.
    -> ctx ()          -- ^ The initial state.
    -> m (ctx a)       -- ^ The interpretation of the effect in @m@.

-- | Thread a composed handler and input state through the algebra for some underlying signature.
--
-- @since 1.1.0.0
thread
  :: ( Functor ctx1
     , Functor ctx2
     , Algebra sig m
     )
  => Handler (Compose ctx1 ctx2) n m
  -> sig n a
  -> ctx1 (ctx2 ())
  -> m (ctx1 (ctx2 a))
thread :: forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread Handler (Compose ctx1 ctx2) n m
hdl sig n a
sig = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg Handler (Compose ctx1 ctx2) n m
hdl sig n a
sig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose
{-# INLINE thread #-}


-- | Run an action exhausted of effects to produce its final result value.
--
-- @since 1.0.0.0
run :: Identity a -> a
run :: forall a. Identity a -> a
run = forall a. Identity a -> a
runIdentity
{-# INLINE run #-}


-- | @m@ is a carrier for @sig@ containing @eff@.
--
-- Note that if @eff@ is a sum, it will be decomposed into multiple 'Member' constraints. While this technically allows one to combine multiple unrelated effects into a single 'Has' constraint, doing so has two significant drawbacks:
--
-- 1. Due to [a problem with recursive type families](https://gitlab.haskell.org/ghc/ghc/issues/8095), this can lead to significantly slower compiles.
--
-- 2. It defeats @ghc@’s warnings for redundant constraints, and thus can lead to a proliferation of redundant constraints as code is changed.
--
-- @since 1.0.0.0
type Has eff sig m = (Members eff sig, Algebra sig m)

-- | Construct a request for an effect to be interpreted by some handler later on.
--
-- @since 0.1.0.0
send :: (Member eff sig, Algebra sig m) => eff m a -> m a
send :: forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send eff m a
sig = forall a. Identity a -> a
runIdentity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity) (forall (sub :: (* -> *) -> * -> *) (sup :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Member sub sup =>
sub m a -> sup m a
inj eff m a
sig) (forall a. a -> Identity a
Identity ())
{-# INLINE send #-}


-- base

instance Algebra (Lift IO) IO where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n IO -> Lift IO n a -> ctx () -> IO (ctx a)
alg Handler ctx n IO
hdl (LiftWith forall (ctx :: * -> *).
Functor ctx =>
Handler ctx n IO -> ctx () -> IO (ctx a)
with) = forall (ctx :: * -> *).
Functor ctx =>
Handler ctx n IO -> ctx () -> IO (ctx a)
with Handler ctx n IO
hdl
  {-# INLINE alg #-}

instance Algebra (Lift Identity) Identity where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n Identity
-> Lift Identity n a -> ctx () -> Identity (ctx a)
alg Handler ctx n Identity
hdl (LiftWith forall (ctx :: * -> *).
Functor ctx =>
Handler ctx n Identity -> ctx () -> Identity (ctx a)
with) = forall (ctx :: * -> *).
Functor ctx =>
Handler ctx n Identity -> ctx () -> Identity (ctx a)
with Handler ctx n Identity
hdl
  {-# INLINE alg #-}

instance Algebra Choose NonEmpty where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n NonEmpty -> Choose n a -> ctx () -> NonEmpty (ctx a)
alg Handler ctx n NonEmpty
_ Choose n a
Choose ctx ()
ctx = (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) forall a. a -> [a] -> NonEmpty a
:| [ Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx ]
  {-# INLINE alg #-}

instance Algebra Empty Maybe where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n Maybe -> Empty n a -> ctx () -> Maybe (ctx a)
alg Handler ctx n Maybe
_ Empty n a
Empty ctx ()
_ = forall a. Maybe a
Nothing
  {-# INLINE alg #-}

instance Algebra (Error e) (Either e) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (Either e)
-> Error e n a -> ctx () -> Either e (ctx a)
alg Handler ctx n (Either e)
hdl Error e n a
sig ctx ()
ctx = case Error e n a
sig of
    L (Throw e
e)   -> forall a b. a -> Either a b
Left e
e
    R (Catch n a
m e -> n a
h) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Handler ctx n (Either e)
hdl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> n a
h) forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handler ctx n (Either e)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
  {-# INLINE alg #-}

instance Algebra (Reader r) ((->) r) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n ((->) r) -> Reader r n a -> ctx () -> r -> ctx a
alg Handler ctx n ((->) r)
hdl Reader r n a
sig ctx ()
ctx = case Reader r n a
sig of
    Reader r n a
Ask       -> (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    Local r -> r
f n a
m -> Handler ctx n ((->) r)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> r
f
  {-# INLINE alg #-}

instance Algebra NonDet [] where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n [] -> NonDet n a -> ctx () -> [ctx a]
alg Handler ctx n []
_ NonDet n a
sig ctx ()
ctx = case NonDet n a
sig of
    L Empty n a
Empty  -> []
    R Choose n a
Choose -> [ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx, Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx ]
  {-# INLINE alg #-}

instance Monoid w => Algebra (Writer w) ((,) w) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n ((,) w) -> Writer w n a -> ctx () -> (w, ctx a)
alg Handler ctx n ((,) w)
hdl Writer w n a
sig ctx ()
ctx = case Writer w n a
sig of
    Tell w
w     -> (w
w, ctx ()
ctx)
    Listen n a
m   -> let (w
w, ctx a
a) = Handler ctx n ((,) w)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) in (w
w, (,) w
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx a
a)
    Censor w -> w
f n a
m -> let (w
w, ctx a
a) = Handler ctx n ((,) w)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) in (w -> w
f w
w, ctx a
a)
  {-# INLINE alg #-}


-- transformers

instance Algebra sig m => Algebra (Error e :+: sig) (Except.ExceptT e m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (ExceptT e m)
-> (:+:) (Error e) sig n a -> ctx () -> ExceptT e m (ctx a)
alg Handler ctx n (ExceptT e m)
hdl (:+:) (Error e) sig n a
sig ctx ()
ctx = case (:+:) (Error e) sig n a
sig of
    L (L (Throw e
e))   -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE e
e
    L (R (Catch n a
m e -> n a
h)) -> forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
Except.catchE (Handler ctx n (ExceptT e m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) (Handler ctx n (ExceptT e m)
hdl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> n a
h)
    R sig n a
other           -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
Except.ExceptT forall a b. (a -> b) -> a -> b
$ forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (ExceptT e m)
hdl) sig n a
other (forall a b. b -> Either a b
Right ctx ()
ctx)
  {-# INLINE alg #-}


deriving instance Algebra sig m => Algebra sig (Identity.IdentityT m)

#if MIN_VERSION_base(4,12,0)
-- | This instance permits effectful actions to be lifted into the 'Ap' monad
-- given a monoidal return type, which can provide clarity when chaining calls
-- to 'mappend'.
--
-- > mappend <$> act1 <*> (mappend <$> act2 <*> act3)
--
-- is equivalent to
--
-- > getAp (act1 <> act2 <> act3)
--
-- @since 1.0.1.0
deriving instance Algebra sig m => Algebra sig (Ap m)
#endif

-- | This instance permits effectful actions to be lifted into the 'Alt' monad,
-- which eases the invocation of repeated alternation with 'Control.Applicative.<|>':
--
-- > a <|> b <|> c <|> d
--
-- is equivalent to
--
-- > getAlt (mconcat [a, b, c, d])
--
-- @since 1.0.1.0
deriving instance Algebra sig m => Algebra sig (Alt m)


instance Algebra sig m => Algebra (Empty :+: sig) (Maybe.MaybeT m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (MaybeT m)
-> (:+:) Empty sig n a -> ctx () -> MaybeT m (ctx a)
alg Handler ctx n (MaybeT m)
hdl (:+:) Empty sig n a
sig ctx ()
ctx = case (:+:) Empty sig n a
sig of
    L Empty n a
Empty -> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
Maybe.MaybeT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
    R sig n a
other -> forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
Maybe.MaybeT forall a b. (a -> b) -> a -> b
$ forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
Maybe.runMaybeT forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (MaybeT m)
hdl) sig n a
other (forall a. a -> Maybe a
Just ctx ()
ctx)
  {-# INLINE alg #-}


instance Algebra sig m => Algebra (Reader r :+: sig) (Reader.ReaderT r m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (ReaderT r m)
-> (:+:) (Reader r) sig n a -> ctx () -> ReaderT r m (ctx a)
alg Handler ctx n (ReaderT r m)
hdl (:+:) (Reader r) sig n a
sig ctx ()
ctx = case (:+:) (Reader r) sig n a
sig of
    L Reader r n a
Ask         -> forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
Reader.asks (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m) -> forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
Reader.local r -> r
f (Handler ctx n (ReaderT r m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other       -> forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg ((forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`Reader.runReaderT` r
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n (ReaderT r m)
hdl) sig n a
other ctx ()
ctx
  {-# INLINE alg #-}


newtype RWSTF w s a = RWSTF { forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF :: (a, s, w) }
  deriving (forall a b. a -> RWSTF w s b -> RWSTF w s a
forall a b. (a -> b) -> RWSTF w s a -> RWSTF w s b
forall w s a b. a -> RWSTF w s b -> RWSTF w s a
forall w s a b. (a -> b) -> RWSTF w s a -> RWSTF w s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RWSTF w s b -> RWSTF w s a
$c<$ :: forall w s a b. a -> RWSTF w s b -> RWSTF w s a
fmap :: forall a b. (a -> b) -> RWSTF w s a -> RWSTF w s b
$cfmap :: forall w s a b. (a -> b) -> RWSTF w s a -> RWSTF w s b
Functor)

toRWSTF :: Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF :: forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w (a
a, s
s, w
w') = forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (a
a, s
s, forall a. Monoid a => a -> a -> a
mappend w
w w
w')
{-# INLINE toRWSTF #-}

newtype Swap s a = Swap { forall s a. Swap s a -> (a, s)
getSwap :: (a, s) }
  deriving (forall a b. a -> Swap s b -> Swap s a
forall a b. (a -> b) -> Swap s a -> Swap s b
forall s a b. a -> Swap s b -> Swap s a
forall s a b. (a -> b) -> Swap s a -> Swap s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Swap s b -> Swap s a
$c<$ :: forall s a b. a -> Swap s b -> Swap s a
fmap :: forall a b. (a -> b) -> Swap s a -> Swap s b
$cfmap :: forall s a b. (a -> b) -> Swap s a -> Swap s b
Functor)

swapAndLift :: Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift :: forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift (ctx a, w)
p = (,) (forall a b. (a, b) -> b
snd (ctx a, w)
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst (ctx a, w)
p
{-# INLINE swapAndLift #-}

#if MIN_VERSION_transformers(0,5,6)
instance (Algebra sig m, Monoid w) => Algebra (Reader r :+: Writer w :+: State s :+: sig) (RWS.CPS.RWST r w s m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (RWST r w s m)
-> (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
-> ctx ()
-> RWST r w s m (ctx a)
alg Handler ctx n (RWST r w s m)
hdl (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
sig ctx ()
ctx = case (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
sig of
    L Reader r n a
Ask              -> forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
RWS.CPS.asks (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m)      -> forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
RWS.CPS.local r -> r
f (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Tell w
w))     -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall w (m :: * -> *) r s.
(Monoid w, Monad m) =>
w -> RWST r w s m ()
RWS.CPS.tell w
w
    R (L (Listen n a
m))   -> forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) r s a.
(Monoid w, Monad m) =>
RWST r w s m a -> RWST r w s m (a, w)
RWS.CPS.listen (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Censor w -> w
f n a
m)) -> forall w (m :: * -> *) r s a.
(Monoid w, Monad m) =>
(w -> w) -> RWST r w s m a -> RWST r w s m a
RWS.CPS.censor w -> w
f (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (R (L State s n a
Get))      -> forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
RWS.CPS.gets (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R (R (L (Put s
s)))  -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s r w. Monad m => s -> RWST r w s m ()
RWS.CPS.put s
s
    R (R (R sig n a
other))    -> forall (m :: * -> *) w r s a.
(Functor m, Monoid w) =>
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.CPS.rwsT forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\ (RWSTF (RWST r w s m x
x, s
s, w
w)) -> forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w r s (m :: * -> *) a.
Monoid w =>
RWST r w s m a -> r -> s -> m (a, s, w)
RWS.CPS.runRWST RWST r w s m x
x r
r s
s) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (RWST r w s m)
hdl) sig n a
other (forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (ctx ()
ctx, s
s, forall a. Monoid a => a
mempty))
  {-# INLINE alg #-}
#endif

instance (Algebra sig m, Monoid w) => Algebra (Reader r :+: Writer w :+: State s :+: sig) (RWS.Lazy.RWST r w s m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (RWST r w s m)
-> (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
-> ctx ()
-> RWST r w s m (ctx a)
alg Handler ctx n (RWST r w s m)
hdl (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
sig ctx ()
ctx = case (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
sig of
    L Reader r n a
Ask              -> forall w (m :: * -> *) r a s.
(Monoid w, Monad m) =>
(r -> a) -> RWST r w s m a
RWS.Lazy.asks (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m)      -> forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
RWS.Lazy.local r -> r
f (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Tell w
w))     -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.Lazy.tell w
w
    R (L (Listen n a
m))   -> forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
RWS.Lazy.listen (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Censor w -> w
f n a
m)) -> forall (m :: * -> *) w r s a.
Monad m =>
(w -> w) -> RWST r w s m a -> RWST r w s m a
RWS.Lazy.censor w -> w
f (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (R (L State s n a
Get))      -> forall w (m :: * -> *) s a r.
(Monoid w, Monad m) =>
(s -> a) -> RWST r w s m a
RWS.Lazy.gets (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R (R (L (Put s
s)))  -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWS.Lazy.put s
s
    R (R (R sig n a
other))    -> forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.Lazy.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\ (RWSTF (RWST r w s m x
x, s
s, w
w)) -> forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWS.Lazy.runRWST RWST r w s m x
x r
r s
s) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (RWST r w s m)
hdl) sig n a
other (forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (ctx ()
ctx, s
s, forall a. Monoid a => a
mempty))
  {-# INLINE alg #-}

instance (Algebra sig m, Monoid w) => Algebra (Reader r :+: Writer w :+: State s :+: sig) (RWS.Strict.RWST r w s m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (RWST r w s m)
-> (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
-> ctx ()
-> RWST r w s m (ctx a)
alg Handler ctx n (RWST r w s m)
hdl (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
sig ctx ()
ctx = case (:+:) (Reader r) (Writer w :+: (State s :+: sig)) n a
sig of
    L Reader r n a
Ask              -> forall w (m :: * -> *) r a s.
(Monoid w, Monad m) =>
(r -> a) -> RWST r w s m a
RWS.Strict.asks (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m)      -> forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
RWS.Strict.local r -> r
f (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Tell w
w))     -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.Strict.tell w
w
    R (L (Listen n a
m))   -> forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
RWS.Strict.listen (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Censor w -> w
f n a
m)) -> forall (m :: * -> *) w r s a.
Monad m =>
(w -> w) -> RWST r w s m a -> RWST r w s m a
RWS.Strict.censor w -> w
f (Handler ctx n (RWST r w s m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (R (L State s n a
Get))      -> forall w (m :: * -> *) s a r.
(Monoid w, Monad m) =>
(s -> a) -> RWST r w s m a
RWS.Strict.gets (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R (R (L (Put s
s)))  -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWS.Strict.put s
s
    R (R (R sig n a
other))    -> forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.Strict.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\ (RWSTF (RWST r w s m x
x, s
s, w
w)) -> forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWS.Strict.runRWST RWST r w s m x
x r
r s
s) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (RWST r w s m)
hdl) sig n a
other (forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (ctx ()
ctx, s
s, forall a. Monoid a => a
mempty))
  {-# INLINE alg #-}


instance Algebra sig m => Algebra (State s :+: sig) (State.Lazy.StateT s m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (StateT s m)
-> (:+:) (State s) sig n a -> ctx () -> StateT s m (ctx a)
alg Handler ctx n (StateT s m)
hdl (:+:) (State s) sig n a
sig ctx ()
ctx = case (:+:) (State s) sig n a
sig of
    L State s n a
Get     -> forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.Lazy.gets (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Put s
s) -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.Lazy.put s
s
    R sig n a
other   -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.Lazy.StateT forall a b. (a -> b) -> a -> b
$ \ s
s -> forall s a. Swap s a -> (a, s)
getSwap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. (a, s) -> Swap s a
Swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.Lazy.runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Swap s a -> (a, s)
getSwap forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (StateT s m)
hdl) sig n a
other (forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, s
s))
  {-# INLINE alg #-}

instance Algebra sig m => Algebra (State s :+: sig) (State.Strict.StateT s m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (StateT s m)
-> (:+:) (State s) sig n a -> ctx () -> StateT s m (ctx a)
alg Handler ctx n (StateT s m)
hdl (:+:) (State s) sig n a
sig ctx ()
ctx = case (:+:) (State s) sig n a
sig of
    L State s n a
Get     -> forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.Strict.gets (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Put s
s) -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.Strict.put s
s
    R sig n a
other   -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.Strict.StateT forall a b. (a -> b) -> a -> b
$ \ s
s -> forall s a. Swap s a -> (a, s)
getSwap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. (a, s) -> Swap s a
Swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.Strict.runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Swap s a -> (a, s)
getSwap forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (StateT s m)
hdl) sig n a
other (forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, s
s))
  {-# INLINE alg #-}


#if MIN_VERSION_transformers(0,5,6)
instance (Algebra sig m, Monoid w) => Algebra (Writer w :+: sig) (Writer.CPS.WriterT w m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (WriterT w m)
-> (:+:) (Writer w) sig n a -> ctx () -> WriterT w m (ctx a)
alg Handler ctx n (WriterT w m)
hdl (:+:) (Writer w) sig n a
sig ctx ()
ctx = case (:+:) (Writer w) sig n a
sig of
    L (Tell w
w)     -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
Writer.CPS.tell w
w
    L (Listen n a
m)   -> forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
Writer.CPS.listen (Handler ctx n (WriterT w m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    L (Censor w -> w
f n a
m) -> forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(w -> w) -> WriterT w m a -> WriterT w m a
Writer.CPS.censor w -> w
f (Handler ctx n (WriterT w m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other        -> forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
Writer.CPS.writerT forall a b. (a -> b) -> a -> b
$ forall s a. Swap s a -> (a, s)
getSwap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\ (Swap (WriterT w m x
x, w
s)) -> forall s a. (a, s) -> Swap s a
Swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend w
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
Writer.CPS.runWriterT WriterT w m x
x) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (WriterT w m)
hdl) sig n a
other (forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, forall a. Monoid a => a
mempty))
  {-# INLINE alg #-}
#endif

instance (Algebra sig m, Monoid w) => Algebra (Writer w :+: sig) (Writer.Lazy.WriterT w m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (WriterT w m)
-> (:+:) (Writer w) sig n a -> ctx () -> WriterT w m (ctx a)
alg Handler ctx n (WriterT w m)
hdl (:+:) (Writer w) sig n a
sig ctx ()
ctx = case (:+:) (Writer w) sig n a
sig of
    L (Tell w
w)     -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.Lazy.tell w
w
    L (Listen n a
m)   -> forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Writer.Lazy.listen (Handler ctx n (WriterT w m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    L (Censor w -> w
f n a
m) -> forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
Writer.Lazy.censor w -> w
f (Handler ctx n (WriterT w m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other        -> forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Writer.Lazy.WriterT forall a b. (a -> b) -> a -> b
$ forall s a. Swap s a -> (a, s)
getSwap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\ (Swap (WriterT w m x
x, w
s)) -> forall s a. (a, s) -> Swap s a
Swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend w
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Writer.Lazy.runWriterT WriterT w m x
x) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (WriterT w m)
hdl) sig n a
other (forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, forall a. Monoid a => a
mempty))
  {-# INLINE alg #-}

instance (Algebra sig m, Monoid w) => Algebra (Writer w :+: sig) (Writer.Strict.WriterT w m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (WriterT w m)
-> (:+:) (Writer w) sig n a -> ctx () -> WriterT w m (ctx a)
alg Handler ctx n (WriterT w m)
hdl (:+:) (Writer w) sig n a
sig ctx ()
ctx = case (:+:) (Writer w) sig n a
sig of
    L (Tell w
w)     -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.Strict.tell w
w
    L (Listen n a
m)   -> forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Writer.Strict.listen (Handler ctx n (WriterT w m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    L (Censor w -> w
f n a
m) -> forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
Writer.Strict.censor w -> w
f (Handler ctx n (WriterT w m)
hdl (n a
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other        -> forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Writer.Strict.WriterT forall a b. (a -> b) -> a -> b
$ forall s a. Swap s a -> (a, s)
getSwap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\ (Swap (WriterT w m x
x, w
s)) -> forall s a. (a, s) -> Swap s a
Swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend w
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Writer.Strict.runWriterT WriterT w m x
x) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (WriterT w m)
hdl) sig n a
other (forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, forall a. Monoid a => a
mempty))
  {-# INLINE alg #-}

#if MIN_VERSION_transformers(0,5,4)
instance (Algebra sig m, Monoid w) => Algebra (Accum w :+: sig) (Accum.AccumT w m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (AccumT w m)
-> (:+:) (Accum w) sig n a -> ctx () -> AccumT w m (ctx a)
alg Handler ctx n (AccumT w m)
hdl (:+:) (Accum w) sig n a
sig ctx ()
ctx = case (:+:) (Accum w) sig n a
sig of
    L (Add w
w) -> ctx ()
ctx forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) w. Monad m => w -> AccumT w m ()
Accum.add w
w
    L Accum w n a
Look    -> forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(w -> a) -> AccumT w m a
Accum.looks (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R sig n a
other   -> forall w (m :: * -> *) a. (w -> m (a, w)) -> AccumT w m a
Accum.AccumT forall a b. (a -> b) -> a -> b
$ \w
w -> forall s a. Swap s a -> (a, s)
getSwap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread ((\(Swap (AccumT w m x
x, w
s)) -> forall s a. (a, s) -> Swap s a
Swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend w
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
Accum.runAccumT AccumT w m x
x w
s) forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (AccumT w m)
hdl) sig n a
other (forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, w
w))
  {-# INLINE alg #-}
#endif