{-# LANGUAGE CPP #-}
module Control.Effect.Type.WriterPrim
  ( -- * Effects

    WriterPrim(..)

    -- * Threading utilities

  , threadWriterPrim
  , threadWriterPrimViaClass

    -- * Combinators for 'Algebra's

    -- Intended to be used for custom 'Control.Effect.Carrier' instances when

    -- defining 'algPrims'.

  , algListenPrimIntoWriterPrim
  ) where

import Control.Monad.Trans
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Except (ExceptT)
import qualified Control.Monad.Trans.State.Strict as SSt
import qualified Control.Monad.Trans.State.Lazy as LSt
import qualified Control.Monad.Trans.Writer.Lazy as LWr
import qualified Control.Monad.Trans.Writer.Strict as SWr
import qualified Control.Monad.Trans.Writer.CPS as CPSWr
import Control.Monad.Writer.Class
import Control.Effect.Internal.ViaAlg
import Control.Effect.Internal.Reflection
import Control.Effect.Internal.Union
import Control.Effect.Type.ListenPrim

-- | A primitive effect that may be used for

-- interpreters of connected 'Control.Effect.Writer.Tell',

-- 'Control.Effect.Writer.Listen', and 'Control.Effect.Writer.Pass' effects.

--

-- This combines 'Control.Effect.Writer.Tell' and

-- 'Control.Effect.Writer.Listen' and 'Control.Effect.Writer.Pass'.

-- This may be relevant if there are monad transformers that may only lift

-- 'Control.Effect.Writer.pass' if they also have access to

-- 'Control.Effect.Writer.listen' and 'Control.Effect.Writer.tell'.

--

-- __'WriterPrim' is only used as a primitive effect.__

-- If you define a 'Control.Effect.Carrier' that relies on a novel

-- non-trivial monad transformer @t@, then you need to make

-- a @'Monoid' o => 'ThreadsEff' t ('WriterPrim' o)@ instance (if possible).

-- 'threadWriterPrim' and 'threadWriterPrimViaClass' can help you with that.

--

-- The following threading constraints accept 'WriterPrim':

--

-- * 'Control.Effect.ReaderThreads'

-- * 'Control.Effect.State.StateThreads'

-- * 'Control.Effect.State.StateLazyThreads'

-- * 'Control.Effect.Error.ErrorThreads'

-- * 'Control.Effect.Writer.WriterThreads'

-- * 'Control.Effect.Writer.WriterLazyThreads'

-- * 'Control.Effect.NonDet.NonDetThreads'

data WriterPrim o :: Effect where
  WriterPrimTell   :: o             -> WriterPrim o m ()
  WriterPrimListen :: m a           -> WriterPrim o m (o, a)
  WriterPrimPass   :: m (o -> o, a) -> WriterPrim o m a

-- | Construct a valid definition of 'threadEff' for a

-- @'ThreadsEff' t ('WriterPrim' o)@ instance only be specifying how

-- 'WriterPrimPass' should be lifted.

--

-- This relies on an existing @'ThreadsEff' t ('ListenPrim' o)@ instance.

threadWriterPrim :: forall o t m a
                  . ( MonadTrans t
                    , ThreadsEff t (ListenPrim o)
                    , Monad m
                    )
                 => ( (forall x. WriterPrim o m x -> m x)
                    -> t m (o -> o, a) -> t m a
                    )
                 -> (forall x. WriterPrim o m x -> m x)
                 -> WriterPrim o (t m) a -> t m a
threadWriterPrim :: ((forall x. WriterPrim o m x -> m x) -> t m (o -> o, a) -> t m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (t m) a
-> t m a
threadWriterPrim (forall x. WriterPrim o m x -> m x) -> t m (o -> o, a) -> t m a
h forall x. WriterPrim o m x -> m x
alg = \case
  WriterPrimTell o
o   -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterPrim o m () -> m ()
forall x. WriterPrim o m x -> m x
alg (o -> WriterPrim o m ()
forall o (m :: * -> *). o -> WriterPrim o m ()
WriterPrimTell o
o))
  WriterPrimListen t m a
m -> ((forall x. ListenPrim o m x -> m x)
-> ListenPrim o (t m) (o, a) -> t m (o, a)
forall (t :: (* -> *) -> * -> *) (e :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(ThreadsEff t e, Monad m) =>
(forall x. e m x -> m x) -> e (t m) a -> t m a
`threadEff` (t m a -> ListenPrim o (t m) (o, a)
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen t m a
m)) ((forall x. ListenPrim o m x -> m x) -> t m (o, a))
-> (forall x. ListenPrim o m x -> m x) -> t m (o, a)
forall a b. (a -> b) -> a -> b
$ \case
    ListenPrimTell   o
o  -> WriterPrim o m () -> m ()
forall x. WriterPrim o m x -> m x
alg (o -> WriterPrim o m ()
forall o (m :: * -> *). o -> WriterPrim o m ()
WriterPrimTell o
o)
    ListenPrimListen m a
m' -> WriterPrim o m (o, a) -> m (o, a)
forall x. WriterPrim o m x -> m x
alg (m a -> WriterPrim o m (o, a)
forall (m :: * -> *) a o. m a -> WriterPrim o m (o, a)
WriterPrimListen m a
m')
  WriterPrimPass t m (o -> o, a)
m -> (forall x. WriterPrim o m x -> m x) -> t m (o -> o, a) -> t m a
h forall x. WriterPrim o m x -> m x
alg t m (o -> o, a)
m
{-# INLINE threadWriterPrim #-}

instance ( Reifies s (ReifiedEffAlgebra (WriterPrim o) m)
         , Monoid o
         , Monad m
         )
      => MonadWriter o (ViaAlg s (WriterPrim o) m) where
  tell :: o -> ViaAlg s (WriterPrim o) m ()
tell o
o = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
    ReifiedEffAlgebra forall x. WriterPrim o m x -> m x
alg -> (WriterPrim o m () -> m ())
-> WriterPrim o (ViaAlg s (WriterPrim o) m) ()
-> ViaAlg s (WriterPrim o) m ()
forall (n :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg WriterPrim o m () -> m ()
forall x. WriterPrim o m x -> m x
alg (o -> WriterPrim o (ViaAlg s (WriterPrim o) m) ()
forall o (m :: * -> *). o -> WriterPrim o m ()
WriterPrimTell o
o)
  {-# INLINE tell #-}

  listen :: ViaAlg s (WriterPrim o) m a -> ViaAlg s (WriterPrim o) m (a, o)
listen ViaAlg s (WriterPrim o) m a
m = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
    ReifiedEffAlgebra forall x. WriterPrim o m x -> m x
alg ->
      ((o, a) -> (a, o))
-> ViaAlg s (WriterPrim o) m (o, a)
-> ViaAlg s (WriterPrim o) m (a, o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(o
s, a
a) -> (a
a, o
s)) (ViaAlg s (WriterPrim o) m (o, a)
 -> ViaAlg s (WriterPrim o) m (a, o))
-> ViaAlg s (WriterPrim o) m (o, a)
-> ViaAlg s (WriterPrim o) m (a, o)
forall a b. (a -> b) -> a -> b
$ (WriterPrim o m (o, a) -> m (o, a))
-> WriterPrim o (ViaAlg s (WriterPrim o) m) (o, a)
-> ViaAlg s (WriterPrim o) m (o, a)
forall (n :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg WriterPrim o m (o, a) -> m (o, a)
forall x. WriterPrim o m x -> m x
alg (ViaAlg s (WriterPrim o) m a
-> WriterPrim o (ViaAlg s (WriterPrim o) m) (o, a)
forall (m :: * -> *) a o. m a -> WriterPrim o m (o, a)
WriterPrimListen ViaAlg s (WriterPrim o) m a
m)
  {-# INLINE listen #-}

  pass :: ViaAlg s (WriterPrim o) m (a, o -> o)
-> ViaAlg s (WriterPrim o) m a
pass ViaAlg s (WriterPrim o) m (a, o -> o)
m = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
    ReifiedEffAlgebra forall x. WriterPrim o m x -> m x
alg ->
      (WriterPrim o m a -> m a)
-> WriterPrim o (ViaAlg s (WriterPrim o) m) a
-> ViaAlg s (WriterPrim o) m a
forall (n :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg WriterPrim o m a -> m a
forall x. WriterPrim o m x -> m x
alg (ViaAlg s (WriterPrim o) m (o -> o, a)
-> WriterPrim o (ViaAlg s (WriterPrim o) m) a
forall (m :: * -> *) o a. m (o -> o, a) -> WriterPrim o m a
WriterPrimPass (((a, o -> o) -> (o -> o, a))
-> ViaAlg s (WriterPrim o) m (a, o -> o)
-> ViaAlg s (WriterPrim o) m (o -> o, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
a,o -> o
f) -> (o -> o
f, a
a)) ViaAlg s (WriterPrim o) m (a, o -> o)
m))
  {-# INLINE pass #-}

-- | A valid definition of 'threadEff' for a

-- @'Monoid' o => 'ThreadsEff' ('WriterPrim' o) t@ instance,

-- given that @t@ lifts @'MonadWriter' w@.

threadWriterPrimViaClass :: forall o t m a
                          . (Monoid o, MonadTrans t, Monad m)
                         => ( RepresentationalT t
                            , forall b. MonadWriter o b => MonadWriter o (t b)
                            )
                         => (forall x. WriterPrim o m x -> m x)
                         -> WriterPrim o (t m) a -> t m a
threadWriterPrimViaClass :: (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (t m) a -> t m a
threadWriterPrimViaClass forall x. WriterPrim o m x -> m x
alg = \case
  WriterPrimTell o
o   -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterPrim o m () -> m ()
forall x. WriterPrim o m x -> m x
alg (o -> WriterPrim o m ()
forall o (m :: * -> *). o -> WriterPrim o m ()
WriterPrimTell o
o))
  WriterPrimListen t m a
m ->
    ReifiedEffAlgebra (WriterPrim o) m
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (WriterPrim o) m)) =>
    pr s -> t m a)
-> t m a
forall a r.
a
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s a) =>
    pr s -> r)
-> r
reify ((forall x. WriterPrim o m x -> m x)
-> ReifiedEffAlgebra (WriterPrim o) m
forall k (e :: (k -> *) -> k -> *) (m :: k -> *).
(forall (x :: k). e m x -> m x) -> ReifiedEffAlgebra e m
ReifiedEffAlgebra forall x. WriterPrim o m x -> m x
alg) ((forall s (pr :: * -> *).
  (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (WriterPrim o) m)) =>
  pr s -> t m a)
 -> t m a)
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (WriterPrim o) m)) =>
    pr s -> t m a)
-> t m a
forall a b. (a -> b) -> a -> b
$ \(pr s
_ :: pr s) ->
        t (ViaAlg s (WriterPrim o) m) (o, a) -> t m (o, a)
forall s (e :: (* -> *) -> * -> *) (t :: (* -> *) -> * -> *)
       (m :: * -> *) a.
RepresentationalT t =>
t (ViaAlg s e m) a -> t m a
unViaAlgT
      (t (ViaAlg s (WriterPrim o) m) (o, a) -> t m (o, a))
-> t (ViaAlg s (WriterPrim o) m) (o, a) -> t m (o, a)
forall a b. (a -> b) -> a -> b
$ ((a, o) -> (o, a))
-> t (ViaAlg s (WriterPrim o) m) (a, o)
-> t (ViaAlg s (WriterPrim o) m) (o, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
f, o
a) -> (o
a, a
f))
      (t (ViaAlg s (WriterPrim o) m) (a, o)
 -> t (ViaAlg s (WriterPrim o) m) (o, a))
-> t (ViaAlg s (WriterPrim o) m) (a, o)
-> t (ViaAlg s (WriterPrim o) m) (o, a)
forall a b. (a -> b) -> a -> b
$ t (ViaAlg s (WriterPrim o) m) a
-> t (ViaAlg s (WriterPrim o) m) (a, o)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
      (t (ViaAlg s (WriterPrim o) m) a
 -> t (ViaAlg s (WriterPrim o) m) (a, o))
-> t (ViaAlg s (WriterPrim o) m) a
-> t (ViaAlg s (WriterPrim o) m) (a, o)
forall a b. (a -> b) -> a -> b
$ t m a -> t (ViaAlg s (WriterPrim o) m) a
forall s (e :: (* -> *) -> * -> *) (t :: (* -> *) -> * -> *)
       (m :: * -> *) a.
RepresentationalT t =>
t m a -> t (ViaAlg s e m) a
viaAlgT @s @(WriterPrim o) t m a
m
  WriterPrimPass t m (o -> o, a)
m ->
    ReifiedEffAlgebra (WriterPrim o) m
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (WriterPrim o) m)) =>
    pr s -> t m a)
-> t m a
forall a r.
a
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s a) =>
    pr s -> r)
-> r
reify ((forall x. WriterPrim o m x -> m x)
-> ReifiedEffAlgebra (WriterPrim o) m
forall k (e :: (k -> *) -> k -> *) (m :: k -> *).
(forall (x :: k). e m x -> m x) -> ReifiedEffAlgebra e m
ReifiedEffAlgebra forall x. WriterPrim o m x -> m x
alg) ((forall s (pr :: * -> *).
  (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (WriterPrim o) m)) =>
  pr s -> t m a)
 -> t m a)
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (WriterPrim o) m)) =>
    pr s -> t m a)
-> t m a
forall a b. (a -> b) -> a -> b
$ \(pr s
_ :: pr s) ->
        t (ViaAlg s (WriterPrim o) m) a -> t m a
forall s (e :: (* -> *) -> * -> *) (t :: (* -> *) -> * -> *)
       (m :: * -> *) a.
RepresentationalT t =>
t (ViaAlg s e m) a -> t m a
unViaAlgT
      (t (ViaAlg s (WriterPrim o) m) a -> t m a)
-> t (ViaAlg s (WriterPrim o) m) a -> t m a
forall a b. (a -> b) -> a -> b
$ t (ViaAlg s (WriterPrim o) m) (a, o -> o)
-> t (ViaAlg s (WriterPrim o) m) a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass
      (t (ViaAlg s (WriterPrim o) m) (a, o -> o)
 -> t (ViaAlg s (WriterPrim o) m) a)
-> t (ViaAlg s (WriterPrim o) m) (a, o -> o)
-> t (ViaAlg s (WriterPrim o) m) a
forall a b. (a -> b) -> a -> b
$ ((o -> o, a) -> (a, o -> o))
-> t (ViaAlg s (WriterPrim o) m) (o -> o, a)
-> t (ViaAlg s (WriterPrim o) m) (a, o -> o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(o -> o
f, a
a) -> (a
a, o -> o
f))
      (t (ViaAlg s (WriterPrim o) m) (o -> o, a)
 -> t (ViaAlg s (WriterPrim o) m) (a, o -> o))
-> t (ViaAlg s (WriterPrim o) m) (o -> o, a)
-> t (ViaAlg s (WriterPrim o) m) (a, o -> o)
forall a b. (a -> b) -> a -> b
$ t m (o -> o, a) -> t (ViaAlg s (WriterPrim o) m) (o -> o, a)
forall s (e :: (* -> *) -> * -> *) (t :: (* -> *) -> * -> *)
       (m :: * -> *) a.
RepresentationalT t =>
t m a -> t (ViaAlg s e m) a
viaAlgT @s @(WriterPrim o) t m (o -> o, a)
m
{-# INLINE threadWriterPrimViaClass #-}

#define THREAD_WRITERPRIM(monadT)                              \
instance Monoid threadedMonoid                                 \
      => ThreadsEff (monadT) (WriterPrim threadedMonoid) where \
  threadEff = threadWriterPrimViaClass;                        \
  {-# INLINE threadEff #-}

THREAD_WRITERPRIM(ReaderT i)
THREAD_WRITERPRIM(ExceptT e)
THREAD_WRITERPRIM(LSt.StateT s)
THREAD_WRITERPRIM(SSt.StateT s)

instance Monoid s => ThreadsEff (LWr.WriterT s) (WriterPrim o) where
  threadEff :: (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a -> WriterT s m a
threadEff = ((forall x. WriterPrim o m x -> m x)
 -> WriterT s m (o -> o, a) -> WriterT s m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a
-> WriterT s m a
forall o (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, ThreadsEff t (ListenPrim o), Monad m) =>
((forall x. WriterPrim o m x -> m x) -> t m (o -> o, a) -> t m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (t m) a
-> t m a
threadWriterPrim (((forall x. WriterPrim o m x -> m x)
  -> WriterT s m (o -> o, a) -> WriterT s m a)
 -> (forall x. WriterPrim o m x -> m x)
 -> WriterPrim o (WriterT s m) a
 -> WriterT s m a)
-> ((forall x. WriterPrim o m x -> m x)
    -> WriterT s m (o -> o, a) -> WriterT s m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a
-> WriterT s m a
forall a b. (a -> b) -> a -> b
$ \forall x. WriterPrim o m x -> m x
alg WriterT s m (o -> o, a)
m ->
      m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LWr.WriterT
    (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ WriterPrim o m (a, s) -> m (a, s)
forall x. WriterPrim o m x -> m x
alg
    (WriterPrim o m (a, s) -> m (a, s))
-> WriterPrim o m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ m (o -> o, (a, s)) -> WriterPrim o m (a, s)
forall (m :: * -> *) o a. m (o -> o, a) -> WriterPrim o m a
WriterPrimPass
    (m (o -> o, (a, s)) -> WriterPrim o m (a, s))
-> m (o -> o, (a, s)) -> WriterPrim o m (a, s)
forall a b. (a -> b) -> a -> b
$ (((o -> o, a), s) -> (o -> o, (a, s)))
-> m ((o -> o, a), s) -> m (o -> o, (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((o -> o
f,a
a), s
s) -> (o -> o
f, (a
a, s
s)))
    (m ((o -> o, a), s) -> m (o -> o, (a, s)))
-> m ((o -> o, a), s) -> m (o -> o, (a, s))
forall a b. (a -> b) -> a -> b
$ WriterT s m (o -> o, a) -> m ((o -> o, a), s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LWr.runWriterT WriterT s m (o -> o, a)
m
  {-# INLINE threadEff #-}

instance Monoid s => ThreadsEff (SWr.WriterT s) (WriterPrim o) where
  threadEff :: (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a -> WriterT s m a
threadEff = ((forall x. WriterPrim o m x -> m x)
 -> WriterT s m (o -> o, a) -> WriterT s m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a
-> WriterT s m a
forall o (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, ThreadsEff t (ListenPrim o), Monad m) =>
((forall x. WriterPrim o m x -> m x) -> t m (o -> o, a) -> t m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (t m) a
-> t m a
threadWriterPrim (((forall x. WriterPrim o m x -> m x)
  -> WriterT s m (o -> o, a) -> WriterT s m a)
 -> (forall x. WriterPrim o m x -> m x)
 -> WriterPrim o (WriterT s m) a
 -> WriterT s m a)
-> ((forall x. WriterPrim o m x -> m x)
    -> WriterT s m (o -> o, a) -> WriterT s m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a
-> WriterT s m a
forall a b. (a -> b) -> a -> b
$ \forall x. WriterPrim o m x -> m x
alg WriterT s m (o -> o, a)
m ->
      m (a, s) -> WriterT s m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
SWr.WriterT
    (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ WriterPrim o m (a, s) -> m (a, s)
forall x. WriterPrim o m x -> m x
alg
    (WriterPrim o m (a, s) -> m (a, s))
-> WriterPrim o m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ m (o -> o, (a, s)) -> WriterPrim o m (a, s)
forall (m :: * -> *) o a. m (o -> o, a) -> WriterPrim o m a
WriterPrimPass
    (m (o -> o, (a, s)) -> WriterPrim o m (a, s))
-> m (o -> o, (a, s)) -> WriterPrim o m (a, s)
forall a b. (a -> b) -> a -> b
$ (((o -> o, a), s) -> (o -> o, (a, s)))
-> m ((o -> o, a), s) -> m (o -> o, (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((o -> o
f,a
a), s
s) -> (o -> o
f, (a
a, s
s)))
    (m ((o -> o, a), s) -> m (o -> o, (a, s)))
-> m ((o -> o, a), s) -> m (o -> o, (a, s))
forall a b. (a -> b) -> a -> b
$ WriterT s m (o -> o, a) -> m ((o -> o, a), s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SWr.runWriterT WriterT s m (o -> o, a)
m
  {-# INLINE threadEff #-}

instance Monoid s => ThreadsEff (CPSWr.WriterT s) (WriterPrim o) where
  threadEff :: (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a -> WriterT s m a
threadEff = ((forall x. WriterPrim o m x -> m x)
 -> WriterT s m (o -> o, a) -> WriterT s m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a
-> WriterT s m a
forall o (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, ThreadsEff t (ListenPrim o), Monad m) =>
((forall x. WriterPrim o m x -> m x) -> t m (o -> o, a) -> t m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (t m) a
-> t m a
threadWriterPrim (((forall x. WriterPrim o m x -> m x)
  -> WriterT s m (o -> o, a) -> WriterT s m a)
 -> (forall x. WriterPrim o m x -> m x)
 -> WriterPrim o (WriterT s m) a
 -> WriterT s m a)
-> ((forall x. WriterPrim o m x -> m x)
    -> WriterT s m (o -> o, a) -> WriterT s m a)
-> (forall x. WriterPrim o m x -> m x)
-> WriterPrim o (WriterT s m) a
-> WriterT s m a
forall a b. (a -> b) -> a -> b
$ \forall x. WriterPrim o m x -> m x
alg WriterT s m (o -> o, a)
m ->
      m (a, s) -> WriterT s m a
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
CPSWr.writerT
    (m (a, s) -> WriterT s m a) -> m (a, s) -> WriterT s m a
forall a b. (a -> b) -> a -> b
$ WriterPrim o m (a, s) -> m (a, s)
forall x. WriterPrim o m x -> m x
alg
    (WriterPrim o m (a, s) -> m (a, s))
-> WriterPrim o m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ m (o -> o, (a, s)) -> WriterPrim o m (a, s)
forall (m :: * -> *) o a. m (o -> o, a) -> WriterPrim o m a
WriterPrimPass
    (m (o -> o, (a, s)) -> WriterPrim o m (a, s))
-> m (o -> o, (a, s)) -> WriterPrim o m (a, s)
forall a b. (a -> b) -> a -> b
$ (((o -> o, a), s) -> (o -> o, (a, s)))
-> m ((o -> o, a), s) -> m (o -> o, (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((o -> o
f,a
a), s
s) -> (o -> o
f, (a
a, s
s)))
    (m ((o -> o, a), s) -> m (o -> o, (a, s)))
-> m ((o -> o, a), s) -> m (o -> o, (a, s))
forall a b. (a -> b) -> a -> b
$ WriterT s m (o -> o, a) -> m ((o -> o, a), s)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPSWr.runWriterT WriterT s m (o -> o, a)
m
  {-# INLINE threadEff #-}

-- | Rewrite an 'Algebra' where the topmost effect is 'ListenPrim' into

-- an 'Algebra' where the topmost effect is 'WriterPrim' by providing

-- an implementation of 'WriterPrimPass'.

algListenPrimIntoWriterPrim :: Algebra' (ListenPrim o ': p) m a
                            -> (m (o -> o, a) -> m a)
                            -> Algebra' (WriterPrim o ': p) m a
algListenPrimIntoWriterPrim :: Algebra' (ListenPrim o : p) m a
-> (m (o -> o, a) -> m a) -> Algebra' (WriterPrim o : p) m a
algListenPrimIntoWriterPrim Algebra' (ListenPrim o : p) m a
alg m (o -> o, a) -> m a
h = Algebra' p m a
-> (WriterPrim o m a -> m a) -> Algebra' (WriterPrim o : p) m a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (Algebra' (ListenPrim o : p) m a -> Algebra' p m a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Algebra' (e : r) m a -> Algebra' r m a
weakenAlg Algebra' (ListenPrim o : p) m a
alg) ((WriterPrim o m a -> m a) -> Algebra' (WriterPrim o : p) m a)
-> (WriterPrim o m a -> m a) -> Algebra' (WriterPrim o : p) m a
forall a b. (a -> b) -> a -> b
$ \case
  WriterPrimTell o
o   -> (Algebra' (ListenPrim o : p) m a
alg Algebra' (ListenPrim o : p) m a
-> (ListenPrim o m a -> Union (ListenPrim o : p) m a)
-> ListenPrim o m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListenPrim o m a -> Union (ListenPrim o : p) m a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj) (o -> ListenPrim o m ()
forall o (m :: * -> *). o -> ListenPrim o m ()
ListenPrimTell o
o)
  WriterPrimListen m a
m -> (Algebra' (ListenPrim o : p) m a
alg Algebra' (ListenPrim o : p) m a
-> (ListenPrim o m a -> Union (ListenPrim o : p) m a)
-> ListenPrim o m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListenPrim o m a -> Union (ListenPrim o : p) m a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj) (m a -> ListenPrim o m (o, a)
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen m a
m)
  WriterPrimPass m (o -> o, a)
m   -> m (o -> o, a) -> m a
h m (o -> o, a)
m
{-# INLINE algListenPrimIntoWriterPrim #-}