e1bf7374fd1aa7522955878c96936749e91d7fd9
[packages/mtl.git] / Control / Monad / Writer / Class.hs
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE UndecidableInstances #-}
3 -- Search for UndecidableInstances to see why this is needed
4
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : Control.Monad.Writer.Class
8 -- Copyright : (c) Andy Gill 2001,
9 -- (c) Oregon Graduate Institute of Science and Technology, 2001
10 -- License : BSD-style (see the file LICENSE)
11 --
12 -- Maintainer : libraries@haskell.org
13 -- Stability : experimental
14 -- Portability : non-portable (multi-param classes, functional dependencies)
15 --
16 -- The MonadWriter class.
17 --
18 -- Inspired by the paper
19 -- /Functional Programming with Overloading and Higher-Order Polymorphism/,
20 -- Mark P Jones (<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>)
21 -- Advanced School of Functional Programming, 1995.
22 -----------------------------------------------------------------------------
23
24 module Control.Monad.Writer.Class (
25 MonadWriter(..),
26 listens,
27 censor,
28 ) where
29
30 import Control.Monad.Trans.Error as Error
31 import Control.Monad.Trans.Except as Except
32 import Control.Monad.Trans.Identity as Identity
33 import Control.Monad.Trans.Maybe as Maybe
34 import Control.Monad.Trans.Reader
35 import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (
36 RWST, writer, tell, listen, pass)
37 import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (
38 RWST, writer, tell, listen, pass)
39 import Control.Monad.Trans.State.Lazy as Lazy
40 import Control.Monad.Trans.State.Strict as Strict
41 import qualified Control.Monad.Trans.Writer.Lazy as Lazy (
42 WriterT, writer, tell, listen, pass)
43 import qualified Control.Monad.Trans.Writer.Strict as Strict (
44 WriterT, writer, tell, listen, pass)
45
46 import Control.Monad.Trans.Class (lift)
47 import Control.Monad
48 import Data.Monoid
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 #if __GLASGOW_HASKELL__ >= 707
64 {-# MINIMAL (writer | tell), listen, pass #-}
65 #endif
66 -- | @'writer' (a,w)@ embeds a simple writer action.
67 writer :: (a,w) -> m a
68 writer ~(a, w) = do
69 tell w
70 return a
71
72 -- | @'tell' w@ is an action that produces the output @w@.
73 tell :: w -> m ()
74 tell w = writer ((),w)
75
76 -- | @'listen' m@ is an action that executes the action @m@ and adds
77 -- its output to the value of the computation.
78 listen :: m a -> m (a, w)
79 -- | @'pass' m@ is an action that executes the action @m@, which
80 -- returns a value and a function, and returns the value, applying
81 -- the function to the output.
82 pass :: m (a, w -> w) -> m a
83
84 -- | @'listens' f m@ is an action that executes the action @m@ and adds
85 -- the result of applying @f@ to the output to the value of the computation.
86 --
87 -- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@
88 listens :: MonadWriter w m => (w -> b) -> m a -> m (a, b)
89 listens f m = do
90 ~(a, w) <- listen m
91 return (a, f w)
92
93 -- | @'censor' f m@ is an action that executes the action @m@ and
94 -- applies the function @f@ to its output, leaving the return value
95 -- unchanged.
96 --
97 -- * @'censor' f m = 'pass' ('liftM' (\\x -> (x,f)) m)@
98 censor :: MonadWriter w m => (w -> w) -> m a -> m a
99 censor f m = pass $ do
100 a <- m
101 return (a, f)
102
103 instance (Monoid w, Monad m) => MonadWriter w (Lazy.WriterT w m) where
104 writer = Lazy.writer
105 tell = Lazy.tell
106 listen = Lazy.listen
107 pass = Lazy.pass
108
109 instance (Monoid w, Monad m) => MonadWriter w (Strict.WriterT w m) where
110 writer = Strict.writer
111 tell = Strict.tell
112 listen = Strict.listen
113 pass = Strict.pass
114
115 instance (Monoid w, Monad m) => MonadWriter w (LazyRWS.RWST r w s m) where
116 writer = LazyRWS.writer
117 tell = LazyRWS.tell
118 listen = LazyRWS.listen
119 pass = LazyRWS.pass
120
121 instance (Monoid w, Monad m) => MonadWriter w (StrictRWS.RWST r w s m) where
122 writer = StrictRWS.writer
123 tell = StrictRWS.tell
124 listen = StrictRWS.listen
125 pass = StrictRWS.pass
126
127 -- ---------------------------------------------------------------------------
128 -- Instances for other mtl transformers
129 --
130 -- All of these instances need UndecidableInstances,
131 -- because they do not satisfy the coverage condition.
132
133 instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
134 writer = lift . writer
135 tell = lift . tell
136 listen = Error.liftListen listen
137 pass = Error.liftPass pass
138
139 instance MonadWriter w m => MonadWriter w (ExceptT e m) where
140 writer = lift . writer
141 tell = lift . tell
142 listen = Except.liftListen listen
143 pass = Except.liftPass pass
144
145 instance MonadWriter w m => MonadWriter w (IdentityT m) where
146 writer = lift . writer
147 tell = lift . tell
148 listen = Identity.mapIdentityT listen
149 pass = Identity.mapIdentityT pass
150
151 instance MonadWriter w m => MonadWriter w (MaybeT m) where
152 writer = lift . writer
153 tell = lift . tell
154 listen = Maybe.liftListen listen
155 pass = Maybe.liftPass pass
156
157 instance MonadWriter w m => MonadWriter w (ReaderT r m) where
158 writer = lift . writer
159 tell = lift . tell
160 listen = mapReaderT listen
161 pass = mapReaderT pass
162
163 instance MonadWriter w m => MonadWriter w (Lazy.StateT s m) where
164 writer = lift . writer
165 tell = lift . tell
166 listen = Lazy.liftListen listen
167 pass = Lazy.liftPass pass
168
169 instance MonadWriter w m => MonadWriter w (Strict.StateT s m) where
170 writer = lift . writer
171 tell = lift . tell
172 listen = Strict.liftListen listen
173 pass = Strict.liftPass pass