{-# 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.Writer.Lazy as L
import qualified Control.Monad.Trans.Writer.CPS as S
import Control.Effect.Machinery (G, Tagger(Tagger), makeTaggedEffect)
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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *). (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 :: * -> *) 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 :: * -> *) 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 :: * -> *) a.
(Monoid w, Monad m) =>
(w -> w) -> WriterT w m a -> WriterT w m a
S.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 :: * -> *) a.
Writer' tag w m =>
m a -> m (w, a)
listen' @tag m a
action
(b, a) -> m (b, a)
forall (f :: * -> *) 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 :: * -> *) a.
Writer' tag w m =>
(w -> b) -> m a -> m (b, a)
forall w b (m :: * -> *) a.
Writer' G w m =>
(w -> b) -> m a -> m (b, a)
listens' @G
{-# INLINE listens #-}