1 -----------------------------------------------------------------------------
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)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : non-portable ( requires mulit-parameter type classes,
11 -- requires functional dependencies )
13 -- $Id: Writer.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
15 -- The MonadWriter class.
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 -----------------------------------------------------------------------------
24 module Control.Monad.Writer (
37 module Control.Monad.Monoid,
38 module Control.Monad.Fix,
39 module Control.Monad.Trans,
45 import Control.Monad.Monoid
46 import Control.Monad.Fix
47 import Control.Monad.Trans
48 import Control.Monad.Reader
50 -- ---------------------------------------------------------------------------
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)}
57 -- listen listens to a monad acting, and returns what the monad "said".
59 -- pass lets you provide a writer transformer which changes internals of
60 -- the written object.
62 class (Monoid w, Monad m) => MonadWriter w m | m -> w where
64 listen :: m a -> m (a, w)
65 pass :: m (a, w -> w) -> m a
67 listens :: (MonadWriter w m) => (w -> w) -> m a -> m (a, w)
72 censor :: (MonadWriter w m) => (w -> w) -> m a -> m a
73 censor f m = pass $ do
77 -- ---------------------------------------------------------------------------
78 -- Our parameterizable writer monad
80 newtype Writer w a = Writer { runWriter :: (a, w) }
83 instance Functor (Writer w) where
84 fmap f m = Writer $ let (a, w) = runWriter m in (f a, w)
86 instance (Monoid w) => Monad (Writer w) where
87 return a = Writer (a, mempty)
88 m >>= k = Writer $ let
90 (b, w') = runWriter (k a)
91 in (b, w `mappend` w')
93 instance (Monoid w) => MonadFix (Writer w) where
94 mfix m = Writer $ let (a, w) = runWriter (m a) in (a, w)
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)
102 execWriter :: Writer w a -> w
103 execWriter m = snd (runWriter m)
105 mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
106 mapWriter f m = Writer $ f (runWriter m)
108 -- ---------------------------------------------------------------------------
109 -- Our parameterizable writer monad, with an inner monad
111 newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
114 instance (Monad m) => Functor (WriterT w m) where
115 fmap f m = WriterT $ do
116 (a, w) <- runWriterT m
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
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
131 instance (Monoid w, MonadFix m) => MonadFix (WriterT w m) where
132 mfix m = WriterT $ mfix $ \ ~(a, _) -> runWriterT (m a)
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
139 pass m = WriterT $ do
140 ((a, f), w) <- runWriterT m
143 instance (Monoid w) => MonadTrans (WriterT w) where
144 lift m = WriterT $ do
148 instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
149 liftIO = lift . liftIO
151 instance (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where
153 local f m = WriterT $ local f (runWriterT m)
156 execWriterT :: Monad m => WriterT w m a -> m w
158 (_, w) <- runWriterT m
161 mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
162 mapWriterT f m = WriterT $ f (runWriterT m)
164 -- ---------------------------------------------------------------------------
165 -- MonadWriter instances for other monad transformers
167 instance (MonadWriter w m) => MonadWriter w (ReaderT r m) where
169 listen m = ReaderT $ \w -> listen (runReaderT m w)
170 pass m = ReaderT $ \w -> pass (runReaderT m w)