-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Writer.Class
-- Copyright   :  (c) Andy Gill 2001,
--                (c) Oregon Graduate Institute of Science and Technology, 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  ross@soi.city.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (type families)
--
-- The MonadWriter class.
--
--      Inspired by the paper
--      /Functional Programming with Overloading and
--          Higher-Order Polymorphism/,
--        Mark P Jones (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>)
--          Advanced School of Functional Programming, 1995.
-----------------------------------------------------------------------------

module Control.Monad.Writer.Class (
    MonadWriter(..),
    listens,
    censor,
  ) where

import Control.Monad.Trans.Except as Except
import Control.Monad.Trans.Identity as Identity
import Control.Monad.Trans.Maybe as Maybe
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (
        RWST, tell, listen, pass)
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (
        RWST, tell, listen, pass)
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy (
        WriterT, tell, listen, pass)
import qualified Control.Monad.Trans.Writer.Strict as Strict (
        WriterT, tell, listen, pass)
import Control.Monad.Trans (lift)

-- ---------------------------------------------------------------------------
-- MonadWriter class

class (Monoid (WriterType m), Monad m) => MonadWriter m where
    type WriterType m

    -- | Shout to the monad what you want to be heard. The monad carries
    -- this packet upwards, merging it if needed (hence the 'Monoid'
    -- requirement).
    tell   :: WriterType m -> m ()

    -- | Listen to a monad acting, and return what the monad "said".
    listen :: m a -> m (a, WriterType m)

    -- | Provide a writer transformer which changes internals of the
    -- written object.
    pass   :: m (a, WriterType m -> WriterType m) -> m a

-- | @'listens' f m@ is an action that executes the action @m@ and adds
-- the result of applying @f@ to the output to the value of the computation.
--
-- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
--
listens :: (MonadWriter m) => (WriterType m -> b) -> m a -> m (a, b)
listens :: forall (m :: * -> *) b a.
MonadWriter m =>
(WriterType m -> b) -> m a -> m (a, b)
listens WriterType m -> b
f m a
m = do
    ~(a
a, WriterType m
w) <- forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen m a
m
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, WriterType m -> b
f WriterType m
w)

-- | @'censor' f m@ is an action that executes the action @m@ and
-- applies the function @f@ to its output, leaving the return value
-- unchanged.
--
-- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@
--
censor :: (MonadWriter m) => (WriterType m -> WriterType m) -> m a -> m a
censor :: forall (m :: * -> *) a.
MonadWriter m =>
(WriterType m -> WriterType m) -> m a -> m a
censor WriterType m -> WriterType m
f m a
m = forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass forall a b. (a -> b) -> a -> b
$ do
    a
a <- m a
m
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, WriterType m -> WriterType m
f)

instance (Monoid w, Monad m) => MonadWriter (Lazy.WriterT w m) where
    type WriterType (Lazy.WriterT w m) = w
    tell :: WriterType (WriterT w m) -> WriterT w m ()
tell   = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Lazy.tell
    listen :: forall a.
WriterT w m a -> WriterT w m (a, WriterType (WriterT w m))
listen = forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Lazy.listen
    pass :: forall a.
WriterT
  w m (a, WriterType (WriterT w m) -> WriterType (WriterT w m))
-> WriterT w m a
pass   = forall (m :: * -> *) w a.
Monad m =>
WriterT w m (a, w -> w) -> WriterT w m a
Lazy.pass

instance (Monoid w, Monad m) => MonadWriter (Strict.WriterT w m) where
    type WriterType (Strict.WriterT w m) = w
    tell :: WriterType (WriterT w m) -> WriterT w m ()
tell   = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Strict.tell
    listen :: forall a.
WriterT w m a -> WriterT w m (a, WriterType (WriterT w m))
listen = forall (m :: * -> *) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
Strict.listen
    pass :: forall a.
WriterT
  w m (a, WriterType (WriterT w m) -> WriterType (WriterT w m))
-> WriterT w m a
pass   = forall (m :: * -> *) w a.
Monad m =>
WriterT w m (a, w -> w) -> WriterT w m a
Strict.pass

instance (Monoid w, Monad m) => MonadWriter (LazyRWS.RWST r w s m) where
    type WriterType (LazyRWS.RWST r w s m) = w
    tell :: WriterType (RWST r w s m) -> RWST r w s m ()
tell   = forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
LazyRWS.tell
    listen :: forall a.
RWST r w s m a -> RWST r w s m (a, WriterType (RWST r w s m))
listen = forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
LazyRWS.listen
    pass :: forall a.
RWST
  r w s m (a, WriterType (RWST r w s m) -> WriterType (RWST r w s m))
-> RWST r w s m a
pass   = forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m (a, w -> w) -> RWST r w s m a
LazyRWS.pass

instance (Monoid w, Monad m) => MonadWriter (StrictRWS.RWST r w s m) where
    type WriterType (StrictRWS.RWST r w s m) = w
    tell :: WriterType (RWST r w s m) -> RWST r w s m ()
tell   = forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
StrictRWS.tell
    listen :: forall a.
RWST r w s m a -> RWST r w s m (a, WriterType (RWST r w s m))
listen = forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> RWST r w s m (a, w)
StrictRWS.listen
    pass :: forall a.
RWST
  r w s m (a, WriterType (RWST r w s m) -> WriterType (RWST r w s m))
-> RWST r w s m a
pass   = forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m (a, w -> w) -> RWST r w s m a
StrictRWS.pass

-- ---------------------------------------------------------------------------
-- Instances for other mtl transformers

instance (MonadWriter m) => MonadWriter (ExceptT e m) where
    type WriterType (ExceptT e m) = WriterType m
    tell :: WriterType (ExceptT e m) -> ExceptT e m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: forall a.
ExceptT e m a -> ExceptT e m (a, WriterType (ExceptT e m))
listen = forall (m :: * -> *) w e a.
Monad m =>
Listen w m (Either e a) -> Listen w (ExceptT e m) a
Except.liftListen forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: forall a.
ExceptT
  e m (a, WriterType (ExceptT e m) -> WriterType (ExceptT e m))
-> ExceptT e m a
pass   = forall (m :: * -> *) w e a.
Monad m =>
Pass w m (Either e a) -> Pass w (ExceptT e m) a
Except.liftPass forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (IdentityT m) where
    type WriterType (IdentityT m) = WriterType m
    tell :: WriterType (IdentityT m) -> IdentityT m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: forall a.
IdentityT m a -> IdentityT m (a, WriterType (IdentityT m))
listen = forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
Identity.mapIdentityT forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: forall a.
IdentityT
  m (a, WriterType (IdentityT m) -> WriterType (IdentityT m))
-> IdentityT m a
pass   = forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
Identity.mapIdentityT forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (MaybeT m) where
    type WriterType (MaybeT m) = WriterType m
    tell :: WriterType (MaybeT m) -> MaybeT m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: forall a. MaybeT m a -> MaybeT m (a, WriterType (MaybeT m))
listen = forall (m :: * -> *) w a.
Monad m =>
Listen w m (Maybe a) -> Listen w (MaybeT m) a
Maybe.liftListen forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: forall a.
MaybeT m (a, WriterType (MaybeT m) -> WriterType (MaybeT m))
-> MaybeT m a
pass   = forall (m :: * -> *) w a.
Monad m =>
Pass w m (Maybe a) -> Pass w (MaybeT m) a
Maybe.liftPass forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (ReaderT r m) where
    type WriterType (ReaderT r m) = WriterType m
    tell :: WriterType (ReaderT r m) -> ReaderT r m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: forall a.
ReaderT r m a -> ReaderT r m (a, WriterType (ReaderT r m))
listen = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: forall a.
ReaderT
  r m (a, WriterType (ReaderT r m) -> WriterType (ReaderT r m))
-> ReaderT r m a
pass   = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (Lazy.StateT s m) where
    type WriterType (Lazy.StateT s m) = WriterType m
    tell :: WriterType (StateT s m) -> StateT s m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: forall a. StateT s m a -> StateT s m (a, WriterType (StateT s m))
listen = forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
Lazy.liftListen forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: forall a.
StateT s m (a, WriterType (StateT s m) -> WriterType (StateT s m))
-> StateT s m a
pass   = forall (m :: * -> *) w a s.
Monad m =>
Pass w m (a, s) -> Pass w (StateT s m) a
Lazy.liftPass forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass

instance (MonadWriter m) => MonadWriter (Strict.StateT s m) where
    type WriterType (Strict.StateT s m) = WriterType m
    tell :: WriterType (StateT s m) -> StateT s m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
tell
    listen :: forall a. StateT s m a -> StateT s m (a, WriterType (StateT s m))
listen = forall (m :: * -> *) w a s.
Monad m =>
Listen w m (a, s) -> Listen w (StateT s m) a
Strict.liftListen forall (m :: * -> *) a. MonadWriter m => m a -> m (a, WriterType m)
listen
    pass :: forall a.
StateT s m (a, WriterType (StateT s m) -> WriterType (StateT s m))
-> StateT s m a
pass   = forall (m :: * -> *) w a s.
Monad m =>
Pass w m (a, s) -> Pass w (StateT s m) a
Strict.liftPass forall (m :: * -> *) a.
MonadWriter m =>
m (a, WriterType m -> WriterType m) -> m a
pass