{-# LANGUAGE UndecidableInstances #-}
module Effectful.Class.Writer where
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Effectful.Internal.Has
import Effectful.Internal.Monad
import qualified Effectful.Writer as W
class Monad m => MonadWriter w m where
{-# MINIMAL (writer | tell), listen #-}
writer :: (a, w) -> m a
writer (a
a, w
w) = do
w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
w
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
tell :: w -> m ()
tell w
w = ((), w) -> m ()
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer ((), w
w)
listen :: m a -> m (a, w)
instance {-# OVERLAPPABLE #-}
( MonadWriter w m
, MonadTransControl t
, Monad (t m)
) => MonadWriter w (t m) where
writer :: (a, w) -> t m a
writer = m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> ((a, w) -> m a) -> (a, w) -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
tell :: w -> t m ()
tell = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (w -> m ()) -> w -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: t m a -> t m (a, w)
listen t m a
m = do
(StT t a
stT, w
w) <- (Run t -> m (StT t a, w)) -> t m (StT t a, w)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t -> m (StT t a, w)) -> t m (StT t a, w))
-> (Run t -> m (StT t a, w)) -> t m (StT t a, w)
forall a b. (a -> b) -> a -> b
$ \Run t
run -> m (StT t a) -> m (StT t a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (t m a -> m (StT t a)
Run t
run t m a
m)
(, w
w) (a -> (a, w)) -> t m a -> t m (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (StT t a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (StT t a -> m (StT t a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StT t a
stT)
instance (W.Writer w :> es, Monoid w) => MonadWriter w (Eff es) where
writer :: (a, w) -> Eff es a
writer = (a, w) -> Eff es a
forall w (es :: [*]) a.
(Writer w :> es, Monoid w) =>
(a, w) -> Eff es a
W.writer
tell :: w -> Eff es ()
tell = w -> Eff es ()
forall w (es :: [*]). (Writer w :> es, Monoid w) => w -> Eff es ()
W.tell
listen :: Eff es a -> Eff es (a, w)
listen = Eff es a -> Eff es (a, w)
forall w (es :: [*]) a.
(Writer w :> es, Monoid w) =>
Eff es a -> Eff es (a, w)
W.listen
listens :: MonadWriter w m => (w -> b) -> m a -> m (a, b)
listens :: (w -> b) -> m a -> m (a, b)
listens w -> b
f m a
m = do
(a
a, w
w) <- m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m a
m
(a, b) -> m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, w -> b
f w
w)