Control/Monad/Writer.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  Control.Monad.Writer
   4 -- Copyright   :  (c) Andy Gill 2001,
   5 --                (c) Oregon Graduate Institute of Science and Technology, 2001
   6 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable ( requires mulit-parameter type classes,
  11 --                               requires functional dependencies )
  12 --
  13 -- $Id: Writer.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
  14 --
  15 -- The MonadWriter class.
  16 --
  17 --        Inspired by the paper
  18 --        \em{Functional Programming with Overloading and
  19 --            Higher-Order Polymorphism},
  20 --          \A[HREF="http://www.cse.ogi.edu/~mpj"]{Mark P Jones},
  21 --                Advanced School of Functional Programming, 1995.}
  22 -----------------------------------------------------------------------------
  23
  24 module Control.Monad.Writer (
  25         MonadWriter(..),
  26         listens,
  27         censor,
  28         Writer(..),
  29         runWriter,
  30         execWriter,
  31         mapWriter,
  32         WriterT(..),
  33         runWriterT,
  34         execWriterT,
  35         mapWriterT,
  36         module Control.Monad,
  37         module Control.Monad.Monoid,
  38         module Control.Monad.Fix,
  39         module Control.Monad.Trans,
  40   ) where
  41
  42 import Prelude
  43
  44 import Control.Monad
  45 import Control.Monad.Monoid
  46 import Control.Monad.Fix
  47 import Control.Monad.Trans
  48 import Control.Monad.Reader
  49
  50 -- ---------------------------------------------------------------------------
  51 -- MonadWriter class
  52 --
  53 -- tell is like tell on the MUD's it shouts to monad
  54 -- what you want to be heard. The monad carries this 'packet'
  55 -- upwards, merging it if needed (hence the Monoid requirement)}
  56 --
  57 -- listen listens to a monad acting, and returns what the monad "said".
  58 --
  59 -- pass lets you provide a writer transformer which changes internals of
  60 -- the written object.
  61
  62 class (Monoid w, Monad m) => MonadWriter w m | m -> w where
  63         tell   :: w -> m ()
  64         listen :: m a -> m (a, w)
  65         pass   :: m (a, w -> w) -> m a
  66
  67 listens :: (MonadWriter w m) => (w -> w) -> m a -> m (a, w)
  68 listens f m = do
  69         (a, w) <- listen m
  70         return (a, f w)
  71
  72 censor :: (MonadWriter w m) => (w -> w) -> m a -> m a
  73 censor f m = pass $ do
  74         a <- m
  75         return (a, f)
  76
  77 -- ---------------------------------------------------------------------------
  78 -- Our parameterizable writer monad
  79
  80 newtype Writer w a = Writer { runWriter :: (a, w) }
  81
  82
  83 instance Functor (Writer w) where
  84         fmap f m = Writer $ let (a, w) = runWriter m in (f a, w)
  85
  86 instance (Monoid w) => Monad (Writer w) where
  87         return a = Writer (a, mempty)
  88         m >>= k  = Writer $ let
  89                 (a, w)  = runWriter m
  90                 (b, w') = runWriter (k a)
  91                 in (b, w `mappend` w')
  92
  93 instance (Monoid w) => MonadFix (Writer w) where
  94         mfix m = Writer $ let (a, w) = runWriter (m a) in (a, w)
  95
  96 instance (Monoid w) => MonadWriter w (Writer w) where
  97         tell   w = Writer ((), w)
  98         listen m = Writer $ let (a, w) = runWriter m in ((a, w), w)
  99         pass   m = Writer $ let ((a, f), w) = runWriter m in (a, f w)
 100
 101
 102 execWriter :: Writer w a -> w
 103 execWriter m = snd (runWriter m)
 104
 105 mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
 106 mapWriter f m = Writer $ f (runWriter m)
 107
 108 -- ---------------------------------------------------------------------------
 109 -- Our parameterizable writer monad, with an inner monad
 110
 111 newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
 112
 113
 114 instance (Monad m) => Functor (WriterT w m) where
 115         fmap f m = WriterT $ do
 116                 (a, w) <- runWriterT m
 117                 return (f a, w)
 118
 119 instance (Monoid w, Monad m) => Monad (WriterT w m) where
 120         return a = WriterT $ return (a, mempty)
 121         m >>= k  = WriterT $ do
 122                 (a, w)  <- runWriterT m
 123                 (b, w') <- runWriterT (k a)
 124                 return (b, w `mappend` w')
 125         fail msg = WriterT $ fail msg
 126
 127 instance (Monoid w, MonadPlus m) => MonadPlus (WriterT w m) where
 128         mzero       = WriterT mzero
 129         m `mplus` n = WriterT $ runWriterT m `mplus` runWriterT n
 130
 131 instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where
 132         mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a)
 133
 134 instance (Monoid w, Monad m) => MonadWriter w (WriterT w m) where
 135         tell   w = WriterT $ return ((), w)
 136         listen m = WriterT $ do
 137                 (a, w) <- runWriterT m
 138                 return ((a, w), w)
 139         pass   m = WriterT $ do
 140                 ((a, f), w) <- runWriterT m
 141                 return (a, f w)
 142
 143 instance (Monoid w) => MonadTrans (WriterT w) where
 144         lift m = WriterT $ do
 145                 a <- m
 146                 return (a, mempty)
 147
 148 instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
 149         liftIO = lift . liftIO
 150
 151 instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where
 152         ask       = lift ask
 153         local f m = WriterT $ local f (runWriterT m)
 154
 155
 156 execWriterT :: Monad m => WriterT w m a -> m w
 157 execWriterT m = do
 158         (_, w) <- runWriterT m
 159         return w
 160
 161 mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
 162 mapWriterT f m = WriterT $ f (runWriterT m)
 163
 164 -- ---------------------------------------------------------------------------
 165 -- MonadWriter instances for other monad transformers
 166
 167 instance (MonadWriter w m) => MonadWriter w (ReaderT r m) where
 168         tell     = lift . tell
 169         listen m = ReaderT $ \w -> listen (runReaderT m w)
 170         pass   m = ReaderT $ \w -> pass   (runReaderT m w)