{-# 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 = (Compose ctx1 ctx2 a -> ctx1 (ctx2 a))
-> m (Compose ctx1 ctx2 a) -> m (ctx1 (ctx2 a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose ctx1 ctx2 a -> ctx1 (ctx2 a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (m (Compose ctx1 ctx2 a) -> m (ctx1 (ctx2 a)))
-> (ctx1 (ctx2 ()) -> m (Compose ctx1 ctx2 a))
-> ctx1 (ctx2 ())
-> m (ctx1 (ctx2 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler (Compose ctx1 ctx2) n m
-> sig n a -> Compose ctx1 ctx2 () -> m (Compose ctx1 ctx2 a)
forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg Compose ctx1 ctx2 (n x) -> m (Compose ctx1 ctx2 x)
Handler (Compose ctx1 ctx2) n m
hdl sig n a
sig (Compose ctx1 ctx2 () -> m (Compose ctx1 ctx2 a))
-> (ctx1 (ctx2 ()) -> Compose ctx1 ctx2 ())
-> ctx1 (ctx2 ())
-> m (Compose ctx1 ctx2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx1 (ctx2 ()) -> Compose ctx1 ctx2 ()
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 = Identity a -> a
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 = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> m (Identity a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler Identity m m -> sig m a -> Identity () -> m (Identity a)
forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg ((x -> Identity x) -> m x -> m (Identity x)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Identity x
forall a. a -> Identity a
Identity (m x -> m (Identity x))
-> (Identity (m x) -> m x) -> Identity (m x) -> m (Identity x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (m x) -> m x
forall a. Identity a -> a
runIdentity) (eff m a -> sig m a
forall (m :: * -> *) a. eff m a -> sig m a
forall (sub :: (* -> *) -> * -> *) (sup :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Member sub sup =>
sub m a -> sup m a
inj eff m a
sig) (() -> Identity ()
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) = Handler ctx n IO -> ctx () -> IO (ctx a)
forall (ctx :: * -> *).
Functor ctx =>
Handler ctx n IO -> ctx () -> IO (ctx a)
with ctx (n x) -> IO (ctx x)
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) = Handler ctx n Identity -> ctx () -> Identity (ctx a)
forall (ctx :: * -> *).
Functor ctx =>
Handler ctx n Identity -> ctx () -> Identity (ctx a)
with ctx (n x) -> Identity (ctx x)
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 = (a
Bool
True a -> ctx () -> ctx a
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) ctx a -> [ctx a] -> NonEmpty (ctx a)
forall a. a -> [a] -> NonEmpty a
:| [ a
Bool
False a -> ctx () -> ctx a
forall a b. a -> ctx b -> ctx a
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 ()
_ = Maybe (ctx a)
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)   -> e -> Either e (ctx a)
forall a b. a -> Either a b
Left e
e
    R (Catch n a
m e -> n a
h) -> (e -> Either e (ctx a))
-> (ctx a -> Either e (ctx a))
-> Either e (ctx a)
-> Either e (ctx a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ctx (n a) -> Either e (ctx a)
Handler ctx n (Either e)
hdl (ctx (n a) -> Either e (ctx a))
-> (e -> ctx (n a)) -> e -> Either e (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) (n a -> ctx (n a)) -> (e -> n a) -> e -> ctx (n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> n a
h) ctx a -> Either e (ctx a)
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ctx (n a) -> Either e (ctx a)
Handler ctx n (Either e)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
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       -> (r -> ctx () -> ctx r
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    Local r -> r
f n a
m -> ctx (n a) -> r -> ctx a
Handler ctx n ((->) r)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) (r -> ctx a) -> (r -> r) -> r -> ctx a
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 -> [ a
Bool
True a -> ctx () -> ctx a
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx, a
Bool
False a -> ctx () -> ctx a
forall a b. a -> ctx b -> ctx a
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 a
ctx ()
ctx)
    Listen n a
m   -> let (w
w, ctx a
a) = ctx (n a) -> (w, ctx a)
Handler ctx n ((,) w)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) in (w
w, (,) w
w (a -> a) -> ctx a -> ctx a
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) = ctx (n a) -> (w, ctx a)
Handler ctx n ((,) w)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
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))   -> e -> ExceptT e m (ctx a)
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)) -> ExceptT e m (ctx a)
-> (e -> ExceptT e m (ctx a)) -> ExceptT e m (ctx a)
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
Except.catchE (ctx (n a) -> ExceptT e m (ctx a)
Handler ctx n (ExceptT e m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) (ctx (n a) -> ExceptT e m (ctx a)
Handler ctx n (ExceptT e m)
hdl (ctx (n a) -> ExceptT e m (ctx a))
-> (e -> ctx (n a)) -> e -> ExceptT e m (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) (n a -> ctx (n a)) -> (e -> n a) -> e -> ctx (n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> n a
h)
    R sig n a
other           -> m (Either e (ctx a)) -> ExceptT e m (ctx a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
Except.ExceptT (m (Either e (ctx a)) -> ExceptT e m (ctx a))
-> m (Either e (ctx a)) -> ExceptT e m (ctx a)
forall a b. (a -> b) -> a -> b
$ Handler (Compose (Either e) ctx) n m
-> sig n a -> Either e (ctx ()) -> m (Either e (ctx a))
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 ((e -> m (Either e x))
-> (ExceptT e m x -> m (Either e x))
-> Either e (ExceptT e m x)
-> m (Either e x)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e x -> m (Either e x)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e x -> m (Either e x))
-> (e -> Either e x) -> e -> m (Either e x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e x
forall a b. a -> Either a b
Left) ExceptT e m x -> m (Either e x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT (forall {x}. Either e (ExceptT e m x) -> m (Either e x))
-> Handler ctx n (ExceptT e m)
-> Handler (Compose (Either e) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> ExceptT e m (ctx x)
Handler ctx n (ExceptT e m)
hdl) sig n a
other (ctx () -> Either e (ctx ())
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 -> m (Maybe (ctx a)) -> MaybeT m (ctx a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
Maybe.MaybeT (Maybe (ctx a) -> m (Maybe (ctx a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ctx a)
forall a. Maybe a
Nothing)
    R sig n a
other -> m (Maybe (ctx a)) -> MaybeT m (ctx a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
Maybe.MaybeT (m (Maybe (ctx a)) -> MaybeT m (ctx a))
-> m (Maybe (ctx a)) -> MaybeT m (ctx a)
forall a b. (a -> b) -> a -> b
$ Handler (Compose Maybe ctx) n m
-> sig n a -> Maybe (ctx ()) -> m (Maybe (ctx a))
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 (m (Maybe x)
-> (MaybeT m x -> m (Maybe x)) -> Maybe (MaybeT m x) -> m (Maybe x)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe x -> m (Maybe x)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe x
forall a. Maybe a
Nothing) MaybeT m x -> m (Maybe x)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
Maybe.runMaybeT (forall {x}. Maybe (MaybeT m x) -> m (Maybe x))
-> Handler ctx n (MaybeT m) -> Handler (Compose Maybe ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> MaybeT m (ctx x)
Handler ctx n (MaybeT m)
hdl) sig n a
other (ctx () -> Maybe (ctx ())
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         -> (r -> ctx a) -> ReaderT r m (ctx a)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
Reader.asks (r -> ctx () -> ctx r
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m) -> (r -> r) -> ReaderT r m (ctx a) -> ReaderT r m (ctx a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
Reader.local r -> r
f (ctx (n a) -> ReaderT r m (ctx a)
Handler ctx n (ReaderT r m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other       -> (r -> m (ctx a)) -> ReaderT r m (ctx a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
Reader.ReaderT ((r -> m (ctx a)) -> ReaderT r m (ctx a))
-> (r -> m (ctx a)) -> ReaderT r m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ r
r -> Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg ((ReaderT r m (ctx x) -> r -> m (ctx x)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`Reader.runReaderT` r
r) (ReaderT r m (ctx x) -> m (ctx x))
-> (ctx (n x) -> ReaderT r m (ctx x)) -> ctx (n x) -> m (ctx x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx (n x) -> ReaderT r m (ctx x)
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 -> b) -> RWSTF w s a -> RWSTF w s b)
-> (forall a b. a -> RWSTF w s b -> RWSTF w s a)
-> Functor (RWSTF w s)
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
$cfmap :: forall w s a b. (a -> b) -> RWSTF w s a -> RWSTF w s b
fmap :: forall a b. (a -> b) -> RWSTF w s a -> RWSTF w s b
$c<$ :: forall w s a b. a -> RWSTF w s b -> RWSTF w s a
<$ :: forall a b. a -> RWSTF w s b -> RWSTF w s a
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') = (a, s, w) -> RWSTF w s a
forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (a
a, s
s, w -> w -> w
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 -> b) -> Swap s a -> Swap s b)
-> (forall a b. a -> Swap s b -> Swap s a) -> Functor (Swap s)
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
$cfmap :: forall s a b. (a -> b) -> Swap s a -> Swap s b
fmap :: forall a b. (a -> b) -> Swap s a -> Swap s b
$c<$ :: forall s a b. a -> Swap s b -> Swap s a
<$ :: forall a b. a -> Swap s b -> Swap s a
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 = (,) ((ctx a, w) -> w
forall a b. (a, b) -> b
snd (ctx a, w)
p) (a -> (w, a)) -> ctx a -> ctx (w, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ctx a, w) -> ctx a
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              -> (r -> ctx a) -> RWST r w s m (ctx a)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
RWS.CPS.asks (r -> ctx () -> ctx r
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m)      -> (r -> r) -> RWST r w s m (ctx a) -> RWST r w s m (ctx a)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Tell w
w))     -> ctx a
ctx ()
ctx ctx a -> RWST r w s m () -> RWST r w s m (ctx a)
forall a b. a -> RWST r w s m b -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> RWST r w s m ()
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))   -> (ctx a, w) -> ctx a
(ctx a, w) -> ctx (w, a)
forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift ((ctx a, w) -> ctx a)
-> RWST r w s m (ctx a, w) -> RWST r w s m (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m (ctx a) -> RWST r w s m (ctx a, w)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Censor w -> w
f n a
m)) -> (w -> w) -> RWST r w s m (ctx a) -> RWST r w s m (ctx a)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (R (L State s n a
Get))      -> (s -> ctx a) -> RWST r w s m (ctx a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
RWS.CPS.gets (s -> ctx () -> ctx s
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R (R (L (Put s
s)))  -> ctx a
ctx ()
ctx ctx a -> RWST r w s m () -> RWST r w s m (ctx a)
forall a b. a -> RWST r w s m b -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s -> RWST r w s m ()
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))    -> (r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a)
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 ((r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a))
-> (r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> RWSTF w s (ctx a) -> (ctx a, s, w)
forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF (RWSTF w s (ctx a) -> (ctx a, s, w))
-> m (RWSTF w s (ctx a)) -> m (ctx a, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (RWSTF w s) ctx) n m
-> sig n a -> RWSTF w s (ctx ()) -> m (RWSTF w s (ctx a))
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)) -> w -> (x, s, w) -> RWSTF w s x
forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w ((x, s, w) -> RWSTF w s x) -> m (x, s, w) -> m (RWSTF w s x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m x -> r -> s -> m (x, s, w)
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 {x}. RWSTF w s (RWST r w s m x) -> m (RWSTF w s x))
-> Handler ctx n (RWST r w s m)
-> Handler (Compose (RWSTF w s) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> RWST r w s m (ctx x)
Handler ctx n (RWST r w s m)
hdl) sig n a
other ((ctx (), s, w) -> RWSTF w s (ctx ())
forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (ctx ()
ctx, s
s, w
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              -> (r -> ctx a) -> RWST r w s m (ctx a)
forall w (m :: * -> *) r a s.
(Monoid w, Monad m) =>
(r -> a) -> RWST r w s m a
RWS.Lazy.asks (r -> ctx () -> ctx r
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m)      -> (r -> r) -> RWST r w s m (ctx a) -> RWST r w s m (ctx a)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Tell w
w))     -> ctx a
ctx ()
ctx ctx a -> RWST r w s m () -> RWST r w s m (ctx a)
forall a b. a -> RWST r w s m b -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> RWST r w s m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.Lazy.tell w
w
    R (L (Listen n a
m))   -> (ctx a, w) -> ctx a
(ctx a, w) -> ctx (w, a)
forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift ((ctx a, w) -> ctx a)
-> RWST r w s m (ctx a, w) -> RWST r w s m (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m (ctx a) -> RWST r w s m (ctx a, w)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
RWS.Lazy.listen (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Censor w -> w
f n a
m)) -> (w -> w) -> RWST r w s m (ctx a) -> RWST r w s m (ctx a)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (R (L State s n a
Get))      -> (s -> ctx a) -> RWST r w s m (ctx a)
forall w (m :: * -> *) s a r.
(Monoid w, Monad m) =>
(s -> a) -> RWST r w s m a
RWS.Lazy.gets (s -> ctx () -> ctx s
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R (R (L (Put s
s)))  -> ctx a
ctx ()
ctx ctx a -> RWST r w s m () -> RWST r w s m (ctx a)
forall a b. a -> RWST r w s m b -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s -> RWST r w s m ()
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))    -> (r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.Lazy.RWST ((r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a))
-> (r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> RWSTF w s (ctx a) -> (ctx a, s, w)
forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF (RWSTF w s (ctx a) -> (ctx a, s, w))
-> m (RWSTF w s (ctx a)) -> m (ctx a, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (RWSTF w s) ctx) n m
-> sig n a -> RWSTF w s (ctx ()) -> m (RWSTF w s (ctx a))
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)) -> w -> (x, s, w) -> RWSTF w s x
forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w ((x, s, w) -> RWSTF w s x) -> m (x, s, w) -> m (RWSTF w s x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m x -> r -> s -> m (x, s, w)
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 {x}. RWSTF w s (RWST r w s m x) -> m (RWSTF w s x))
-> Handler ctx n (RWST r w s m)
-> Handler (Compose (RWSTF w s) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> RWST r w s m (ctx x)
Handler ctx n (RWST r w s m)
hdl) sig n a
other ((ctx (), s, w) -> RWSTF w s (ctx ())
forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (ctx ()
ctx, s
s, w
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              -> (r -> ctx a) -> RWST r w s m (ctx a)
forall w (m :: * -> *) r a s.
(Monoid w, Monad m) =>
(r -> a) -> RWST r w s m a
RWS.Strict.asks (r -> ctx () -> ctx r
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Local r -> r
f n a
m)      -> (r -> r) -> RWST r w s m (ctx a) -> RWST r w s m (ctx a)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Tell w
w))     -> ctx a
ctx ()
ctx ctx a -> RWST r w s m () -> RWST r w s m (ctx a)
forall a b. a -> RWST r w s m b -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> RWST r w s m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.Strict.tell w
w
    R (L (Listen n a
m))   -> (ctx a, w) -> ctx a
(ctx a, w) -> ctx (w, a)
forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift ((ctx a, w) -> ctx a)
-> RWST r w s m (ctx a, w) -> RWST r w s m (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m (ctx a) -> RWST r w s m (ctx a, w)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
RWS.Strict.listen (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (L (Censor w -> w
f n a
m)) -> (w -> w) -> RWST r w s m (ctx a) -> RWST r w s m (ctx a)
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 (ctx (n a) -> RWST r w s m (ctx a)
Handler ctx n (RWST r w s m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R (R (L State s n a
Get))      -> (s -> ctx a) -> RWST r w s m (ctx a)
forall w (m :: * -> *) s a r.
(Monoid w, Monad m) =>
(s -> a) -> RWST r w s m a
RWS.Strict.gets (s -> ctx () -> ctx s
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R (R (L (Put s
s)))  -> ctx a
ctx ()
ctx ctx a -> RWST r w s m () -> RWST r w s m (ctx a)
forall a b. a -> RWST r w s m b -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s -> RWST r w s m ()
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))    -> (r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWS.Strict.RWST ((r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a))
-> (r -> s -> m (ctx a, s, w)) -> RWST r w s m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> RWSTF w s (ctx a) -> (ctx a, s, w)
forall w s a. RWSTF w s a -> (a, s, w)
unRWSTF (RWSTF w s (ctx a) -> (ctx a, s, w))
-> m (RWSTF w s (ctx a)) -> m (ctx a, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (RWSTF w s) ctx) n m
-> sig n a -> RWSTF w s (ctx ()) -> m (RWSTF w s (ctx a))
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)) -> w -> (x, s, w) -> RWSTF w s x
forall w a s. Monoid w => w -> (a, s, w) -> RWSTF w s a
toRWSTF w
w ((x, s, w) -> RWSTF w s x) -> m (x, s, w) -> m (RWSTF w s x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m x -> r -> s -> m (x, s, w)
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 {x}. RWSTF w s (RWST r w s m x) -> m (RWSTF w s x))
-> Handler ctx n (RWST r w s m)
-> Handler (Compose (RWSTF w s) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> RWST r w s m (ctx x)
Handler ctx n (RWST r w s m)
hdl) sig n a
other ((ctx (), s, w) -> RWSTF w s (ctx ())
forall w s a. (a, s, w) -> RWSTF w s a
RWSTF (ctx ()
ctx, s
s, w
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     -> (s -> ctx a) -> StateT s m (ctx a)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.Lazy.gets (s -> ctx () -> ctx s
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Put s
s) -> ctx a
ctx ()
ctx ctx a -> StateT s m () -> StateT s m (ctx a)
forall a b. a -> StateT s m b -> StateT s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.Lazy.put s
s
    R sig n a
other   -> (s -> m (ctx a, s)) -> StateT s m (ctx a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.Lazy.StateT ((s -> m (ctx a, s)) -> StateT s m (ctx a))
-> (s -> m (ctx a, s)) -> StateT s m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ s
s -> Swap s (ctx a) -> (ctx a, s)
forall s a. Swap s a -> (a, s)
getSwap (Swap s (ctx a) -> (ctx a, s))
-> m (Swap s (ctx a)) -> m (ctx a, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (Swap s) ctx) n m
-> sig n a -> Swap s (ctx ()) -> m (Swap s (ctx a))
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 (((x, s) -> Swap s x) -> m (x, s) -> m (Swap s x)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, s) -> Swap s x
forall s a. (a, s) -> Swap s a
Swap (m (x, s) -> m (Swap s x))
-> (Swap s (StateT s m x) -> m (x, s))
-> Swap s (StateT s m x)
-> m (Swap s x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT s m x -> s -> m (x, s)) -> (StateT s m x, s) -> m (x, s)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry StateT s m x -> s -> m (x, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.Lazy.runStateT ((StateT s m x, s) -> m (x, s))
-> (Swap s (StateT s m x) -> (StateT s m x, s))
-> Swap s (StateT s m x)
-> m (x, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swap s (StateT s m x) -> (StateT s m x, s)
forall s a. Swap s a -> (a, s)
getSwap (forall {x}. Swap s (StateT s m x) -> m (Swap s x))
-> Handler ctx n (StateT s m) -> Handler (Compose (Swap s) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> StateT s m (ctx x)
Handler ctx n (StateT s m)
hdl) sig n a
other ((ctx (), s) -> Swap s (ctx ())
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     -> (s -> ctx a) -> StateT s m (ctx a)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.Strict.gets (s -> ctx () -> ctx s
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    L (Put s
s) -> ctx a
ctx ()
ctx ctx a -> StateT s m () -> StateT s m (ctx a)
forall a b. a -> StateT s m b -> StateT s m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.Strict.put s
s
    R sig n a
other   -> (s -> m (ctx a, s)) -> StateT s m (ctx a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
State.Strict.StateT ((s -> m (ctx a, s)) -> StateT s m (ctx a))
-> (s -> m (ctx a, s)) -> StateT s m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ s
s -> Swap s (ctx a) -> (ctx a, s)
forall s a. Swap s a -> (a, s)
getSwap (Swap s (ctx a) -> (ctx a, s))
-> m (Swap s (ctx a)) -> m (ctx a, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (Swap s) ctx) n m
-> sig n a -> Swap s (ctx ()) -> m (Swap s (ctx a))
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 (((x, s) -> Swap s x) -> m (x, s) -> m (Swap s x)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, s) -> Swap s x
forall s a. (a, s) -> Swap s a
Swap (m (x, s) -> m (Swap s x))
-> (Swap s (StateT s m x) -> m (x, s))
-> Swap s (StateT s m x)
-> m (Swap s x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT s m x -> s -> m (x, s)) -> (StateT s m x, s) -> m (x, s)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry StateT s m x -> s -> m (x, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.Strict.runStateT ((StateT s m x, s) -> m (x, s))
-> (Swap s (StateT s m x) -> (StateT s m x, s))
-> Swap s (StateT s m x)
-> m (x, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Swap s (StateT s m x) -> (StateT s m x, s)
forall s a. Swap s a -> (a, s)
getSwap (forall {x}. Swap s (StateT s m x) -> m (Swap s x))
-> Handler ctx n (StateT s m) -> Handler (Compose (Swap s) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> StateT s m (ctx x)
Handler ctx n (StateT s m)
hdl) sig n a
other ((ctx (), s) -> Swap s (ctx ())
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 a
ctx ()
ctx ctx a -> WriterT w m () -> WriterT w m (ctx a)
forall a b. a -> WriterT w m b -> WriterT w m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> WriterT w m ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
Writer.CPS.tell w
w
    L (Listen n a
m)   -> (ctx a, w) -> ctx a
(ctx a, w) -> ctx (w, a)
forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift ((ctx a, w) -> ctx a)
-> WriterT w m (ctx a, w) -> WriterT w m (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m (ctx a) -> WriterT w m (ctx a, w)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
Writer.CPS.listen (ctx (n a) -> WriterT w m (ctx a)
Handler ctx n (WriterT w m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    L (Censor w -> w
f n a
m) -> (w -> w) -> WriterT w m (ctx a) -> WriterT w m (ctx a)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(w -> w) -> WriterT w m a -> WriterT w m a
Writer.CPS.censor w -> w
f (ctx (n a) -> WriterT w m (ctx a)
Handler ctx n (WriterT w m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other        -> m (ctx a, w) -> WriterT w m (ctx a)
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
Writer.CPS.writerT (m (ctx a, w) -> WriterT w m (ctx a))
-> m (ctx a, w) -> WriterT w m (ctx a)
forall a b. (a -> b) -> a -> b
$ Swap w (ctx a) -> (ctx a, w)
forall s a. Swap s a -> (a, s)
getSwap (Swap w (ctx a) -> (ctx a, w))
-> m (Swap w (ctx a)) -> m (ctx a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (Swap w) ctx) n m
-> sig n a -> Swap w (ctx ()) -> m (Swap w (ctx a))
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)) -> (x, w) -> Swap w x
forall s a. (a, s) -> Swap s a
Swap ((x, w) -> Swap w x) -> ((x, w) -> (x, w)) -> (x, w) -> Swap w x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> (x, w) -> (x, w)
forall a b. (a -> b) -> (x, a) -> (x, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
s) ((x, w) -> Swap w x) -> m (x, w) -> m (Swap w x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m x -> m (x, w)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
Writer.CPS.runWriterT WriterT w m x
x) (forall {x}. Swap w (WriterT w m x) -> m (Swap w x))
-> Handler ctx n (WriterT w m)
-> Handler (Compose (Swap w) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> WriterT w m (ctx x)
Handler ctx n (WriterT w m)
hdl) sig n a
other ((ctx (), w) -> Swap w (ctx ())
forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, w
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 a
ctx ()
ctx ctx a -> WriterT w m () -> WriterT w m (ctx a)
forall a b. a -> WriterT w m b -> WriterT w m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.Lazy.tell w
w
    L (Listen n a
m)   -> (ctx a, w) -> ctx a
(ctx a, w) -> ctx (w, a)
forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift ((ctx a, w) -> ctx a)
-> WriterT w m (ctx a, w) -> WriterT w m (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m (ctx a) -> WriterT w m (ctx a, w)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Writer.Lazy.listen (ctx (n a) -> WriterT w m (ctx a)
Handler ctx n (WriterT w m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    L (Censor w -> w
f n a
m) -> (w -> w) -> WriterT w m (ctx a) -> WriterT w m (ctx a)
forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
Writer.Lazy.censor w -> w
f (ctx (n a) -> WriterT w m (ctx a)
Handler ctx n (WriterT w m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other        -> m (ctx a, w) -> WriterT w m (ctx a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Writer.Lazy.WriterT (m (ctx a, w) -> WriterT w m (ctx a))
-> m (ctx a, w) -> WriterT w m (ctx a)
forall a b. (a -> b) -> a -> b
$ Swap w (ctx a) -> (ctx a, w)
forall s a. Swap s a -> (a, s)
getSwap (Swap w (ctx a) -> (ctx a, w))
-> m (Swap w (ctx a)) -> m (ctx a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (Swap w) ctx) n m
-> sig n a -> Swap w (ctx ()) -> m (Swap w (ctx a))
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)) -> (x, w) -> Swap w x
forall s a. (a, s) -> Swap s a
Swap ((x, w) -> Swap w x) -> ((x, w) -> (x, w)) -> (x, w) -> Swap w x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> (x, w) -> (x, w)
forall a b. (a -> b) -> (x, a) -> (x, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
s) ((x, w) -> Swap w x) -> m (x, w) -> m (Swap w x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m x -> m (x, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Writer.Lazy.runWriterT WriterT w m x
x) (forall {x}. Swap w (WriterT w m x) -> m (Swap w x))
-> Handler ctx n (WriterT w m)
-> Handler (Compose (Swap w) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> WriterT w m (ctx x)
Handler ctx n (WriterT w m)
hdl) sig n a
other ((ctx (), w) -> Swap w (ctx ())
forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, w
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 a
ctx ()
ctx ctx a -> WriterT w m () -> WriterT w m (ctx a)
forall a b. a -> WriterT w m b -> WriterT w m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.Strict.tell w
w
    L (Listen n a
m)   -> (ctx a, w) -> ctx a
(ctx a, w) -> ctx (w, a)
forall (ctx :: * -> *) a w. Functor ctx => (ctx a, w) -> ctx (w, a)
swapAndLift ((ctx a, w) -> ctx a)
-> WriterT w m (ctx a, w) -> WriterT w m (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m (ctx a) -> WriterT w m (ctx a, w)
forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Writer.Strict.listen (ctx (n a) -> WriterT w m (ctx a)
Handler ctx n (WriterT w m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    L (Censor w -> w
f n a
m) -> (w -> w) -> WriterT w m (ctx a) -> WriterT w m (ctx a)
forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
Writer.Strict.censor w -> w
f (ctx (n a) -> WriterT w m (ctx a)
Handler ctx n (WriterT w m)
hdl (n a
m n a -> ctx () -> ctx (n a)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
    R sig n a
other        -> m (ctx a, w) -> WriterT w m (ctx a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Writer.Strict.WriterT (m (ctx a, w) -> WriterT w m (ctx a))
-> m (ctx a, w) -> WriterT w m (ctx a)
forall a b. (a -> b) -> a -> b
$ Swap w (ctx a) -> (ctx a, w)
forall s a. Swap s a -> (a, s)
getSwap (Swap w (ctx a) -> (ctx a, w))
-> m (Swap w (ctx a)) -> m (ctx a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (Swap w) ctx) n m
-> sig n a -> Swap w (ctx ()) -> m (Swap w (ctx a))
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)) -> (x, w) -> Swap w x
forall s a. (a, s) -> Swap s a
Swap ((x, w) -> Swap w x) -> ((x, w) -> (x, w)) -> (x, w) -> Swap w x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> (x, w) -> (x, w)
forall a b. (a -> b) -> (x, a) -> (x, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
s) ((x, w) -> Swap w x) -> m (x, w) -> m (Swap w x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m x -> m (x, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Writer.Strict.runWriterT WriterT w m x
x) (forall {x}. Swap w (WriterT w m x) -> m (Swap w x))
-> Handler ctx n (WriterT w m)
-> Handler (Compose (Swap w) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> WriterT w m (ctx x)
Handler ctx n (WriterT w m)
hdl) sig n a
other ((ctx (), w) -> Swap w (ctx ())
forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, w
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 a
ctx ()
ctx ctx a -> AccumT w m () -> AccumT w m (ctx a)
forall a b. a -> AccumT w m b -> AccumT w m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ w -> AccumT w m ()
forall (m :: * -> *) w. Monad m => w -> AccumT w m ()
Accum.add w
w
    L Accum w n a
Look    -> (w -> ctx a) -> AccumT w m (ctx a)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
(w -> a) -> AccumT w m a
Accum.looks (w -> ctx () -> ctx w
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R sig n a
other   -> (w -> m (ctx a, w)) -> AccumT w m (ctx a)
forall w (m :: * -> *) a. (w -> m (a, w)) -> AccumT w m a
Accum.AccumT ((w -> m (ctx a, w)) -> AccumT w m (ctx a))
-> (w -> m (ctx a, w)) -> AccumT w m (ctx a)
forall a b. (a -> b) -> a -> b
$ \w
w -> Swap w (ctx a) -> (ctx a, w)
forall s a. Swap s a -> (a, s)
getSwap (Swap w (ctx a) -> (ctx a, w))
-> m (Swap w (ctx a)) -> m (ctx a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Compose (Swap w) ctx) n m
-> sig n a -> Swap w (ctx ()) -> m (Swap w (ctx a))
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)) -> (x, w) -> Swap w x
forall s a. (a, s) -> Swap s a
Swap ((x, w) -> Swap w x) -> ((x, w) -> (x, w)) -> (x, w) -> Swap w x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (w -> w) -> (x, w) -> (x, w)
forall a b. (a -> b) -> (x, a) -> (x, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
s) ((x, w) -> Swap w x) -> m (x, w) -> m (Swap w x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccumT w m x -> w -> m (x, w)
forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
Accum.runAccumT AccumT w m x
x w
s) (forall {x}. Swap w (AccumT w m x) -> m (Swap w x))
-> Handler ctx n (AccumT w m) -> Handler (Compose (Swap w) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> AccumT w m (ctx x)
Handler ctx n (AccumT w m)
hdl) sig n a
other ((ctx (), w) -> Swap w (ctx ())
forall s a. (a, s) -> Swap s a
Swap (ctx ()
ctx, w
w))
  {-# INLINE alg #-}
#endif