{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Algebra
( Algebra(..)
, thread
, run
, Has
, send
, 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
class Monad m => Algebra sig m | m -> sig where
alg
:: Functor ctx
=> Handler ctx n m
-> sig n a
-> ctx ()
-> m (ctx a)
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 :: Identity a -> a
run :: forall a. Identity a -> a
run = Identity a -> a
forall a. Identity a -> a
runIdentity
{-# INLINE run #-}
type Has eff sig m = (Members eff sig, Algebra sig m)
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 #-}
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 #-}
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)
deriving instance Algebra sig m => Algebra sig (Ap m)
#endif
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