{-# LANGUAGE TemplateHaskell #-}
module Control.Effect.Writer
(
Writer'(..)
, Writer
, tell
, listen
, censor
, listens'
, listens
, tagWriter'
, retagWriter'
, untagWriter'
) where
import Data.Tuple (swap)
import qualified Control.Monad.Trans.RWS.CPS as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Lazy as L
import qualified Control.Monad.Trans.Writer.CPS as S
import Control.Effect.Machinery
class Monad m => Writer' tag w m | tag m -> w where
tell' :: w -> m ()
listen' :: m a -> m (w, a)
censor' :: (w -> w)
-> m a
-> m a
makeTaggedEffect ''Writer'
instance (Monad m, Monoid w) => Writer' tag w (L.WriterT w m) where
tell' :: w -> WriterT w m ()
tell' = w -> WriterT w m ()
forall (m :: SomeMonad) w. Monad m => w -> WriterT w m ()
L.tell
{-# INLINE tell' #-}
listen' :: WriterT w m a -> WriterT w m (w, a)
listen' = ((a, w) -> (w, a)) -> WriterT w m (a, w) -> WriterT w m (w, a)
forall (f :: SomeMonad) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> (w, a)
forall a b. (a, b) -> (b, a)
swap (WriterT w m (a, w) -> WriterT w m (w, a))
-> (WriterT w m a -> WriterT w m (a, w))
-> WriterT w m a
-> WriterT w m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> WriterT w m (a, w)
forall (m :: SomeMonad) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
L.listen
{-# INLINE listen' #-}
censor' :: (w -> w) -> WriterT w m a -> WriterT w m a
censor' = (w -> w) -> WriterT w m a -> WriterT w m a
forall (m :: SomeMonad) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
L.censor
{-# INLINE censor' #-}
instance (Monad m, Monoid w) => Writer' tag w (S.WriterT w m) where
tell' :: w -> WriterT w m ()
tell' = w -> WriterT w m ()
forall w (m :: SomeMonad).
(Monoid w, Monad m) =>
w -> WriterT w m ()
S.tell
{-# INLINE tell' #-}
listen' :: WriterT w m a -> WriterT w m (w, a)
listen' = ((a, w) -> (w, a)) -> WriterT w m (a, w) -> WriterT w m (w, a)
forall (f :: SomeMonad) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> (w, a)
forall a b. (a, b) -> (b, a)
swap (WriterT w m (a, w) -> WriterT w m (w, a))
-> (WriterT w m a -> WriterT w m (a, w))
-> WriterT w m a
-> WriterT w m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> WriterT w m (a, w)
forall w (m :: SomeMonad) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
S.listen
{-# INLINE listen' #-}
censor' :: (w -> w) -> WriterT w m a -> WriterT w m a
censor' = (w -> w) -> WriterT w m a -> WriterT w m a
forall w (m :: SomeMonad) a.
(Monoid w, Monad m) =>
(w -> w) -> WriterT w m a -> WriterT w m a
S.censor
{-# INLINE censor' #-}
instance (Monad m, Monoid w) => Writer' tag w (Lazy.RWST r w s m) where
tell' :: w -> RWST r w s m ()
tell' = w -> RWST r w s m ()
forall (m :: SomeMonad) w r s. Monad m => w -> RWST r w s m ()
Lazy.tell
{-# INLINE tell' #-}
listen' :: RWST r w s m a -> RWST r w s m (w, a)
listen' = ((a, w) -> (w, a)) -> RWST r w s m (a, w) -> RWST r w s m (w, a)
forall (f :: SomeMonad) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> (w, a)
forall a b. (a, b) -> (b, a)
swap (RWST r w s m (a, w) -> RWST r w s m (w, a))
-> (RWST r w s m a -> RWST r w s m (a, w))
-> RWST r w s m a
-> RWST r w s m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST r w s m a -> RWST r w s m (a, w)
forall (m :: SomeMonad) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
Lazy.listen
{-# INLINE listen' #-}
censor' :: (w -> w) -> RWST r w s m a -> RWST r w s m a
censor' = (w -> w) -> RWST r w s m a -> RWST r w s m a
forall (m :: SomeMonad) w r s a.
Monad m =>
(w -> w) -> RWST r w s m a -> RWST r w s m a
Lazy.censor
{-# INLINE censor' #-}
instance (Monad m, Monoid w) => Writer' tag w (Strict.RWST r w s m) where
tell' :: w -> RWST r w s m ()
tell' = w -> RWST r w s m ()
forall w (m :: SomeMonad) r s.
(Monoid w, Monad m) =>
w -> RWST r w s m ()
Strict.tell
{-# INLINE tell' #-}
listen' :: RWST r w s m a -> RWST r w s m (w, a)
listen' = ((a, w) -> (w, a)) -> RWST r w s m (a, w) -> RWST r w s m (w, a)
forall (f :: SomeMonad) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> (w, a)
forall a b. (a, b) -> (b, a)
swap (RWST r w s m (a, w) -> RWST r w s m (w, a))
-> (RWST r w s m a -> RWST r w s m (a, w))
-> RWST r w s m a
-> RWST r w s m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RWST r w s m a -> RWST r w s m (a, w)
forall w (m :: SomeMonad) r s a.
(Monoid w, Monad m) =>
RWST r w s m a -> RWST r w s m (a, w)
Strict.listen
{-# INLINE listen' #-}
censor' :: (w -> w) -> RWST r w s m a -> RWST r w s m a
censor' = (w -> w) -> RWST r w s m a -> RWST r w s m a
forall w (m :: SomeMonad) r s a.
(Monoid w, Monad m) =>
(w -> w) -> RWST r w s m a -> RWST r w s m a
Strict.censor
{-# INLINE censor' #-}
listens' :: forall tag w b m a. Writer' tag w m
=> (w -> b)
-> m a
-> m (b, a)
listens' :: (w -> b) -> m a -> m (b, a)
listens' f :: w -> b
f action :: m a
action = do
~(w :: w
w, a :: a
a) <- m a -> m (w, a)
forall k (tag :: k) w (m :: SomeMonad) a.
Writer' tag w m =>
m a -> m (w, a)
listen' @tag m a
action
(b, a) -> m (b, a)
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure (w -> b
f w
w, a
a)
{-# INLINE listens' #-}
listens :: Writer w m => (w -> b) -> m a -> m (b, a)
listens :: (w -> b) -> m a -> m (b, a)
listens = forall k (tag :: k) w b (m :: SomeMonad) a.
Writer' tag w m =>
(w -> b) -> m a -> m (b, a)
forall w b (m :: SomeMonad) a.
Writer' G w m =>
(w -> b) -> m a -> m (b, a)
listens' @G
{-# INLINE listens #-}