1 -----------------------------------------------------------------------------
3 -- Module : Control.Monad.RWS
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 -- Declaration of the MonadRWS class.
15 -- Inspired by the paper
16 -- \em{Functional Programming with Overloading and
17 -- Higher-Order Polymorphism},
18 -- \A[HREF="http://www.cse.ogi.edu/~mpj"]{Mark P Jones},
19 -- Advanced School of Functional Programming, 1995.}
20 -----------------------------------------------------------------------------
22 module Control.Monad.RWS (
36 module Control.Monad.Fix,
37 module Control.Monad.Trans,
38 module Control.Monad.Reader,
39 module Control.Monad.Writer,
40 module Control.Monad.State,
46 import Control.Monad.Monoid
47 import Control.Monad.Fix
48 import Control.Monad.Trans
49 import Control.Monad.Reader
50 import Control.Monad.Writer
51 import Control.Monad.State
54 newtype RWS r w s a = RWS { runRWS :: r -> s -> (a, s, w) }
56 instance Functor (RWS r w s) where
57 fmap f m = RWS $ \r s -> let
58 (a, s', w) = runRWS m r s
61 instance (Monoid w) => Monad (RWS r w s) where
62 return a = RWS $ \_ s -> (a, s, mempty)
63 m >>= k = RWS $ \r s -> let
64 (a, s', w) = runRWS m r s
65 (b, s'', w') = runRWS (k a) r s'
66 in (b, s'', w `mappend` w')
68 instance (Monoid w) => MonadFix (RWS r w s) where
69 mfix f = RWS $ \r s -> let (a, s', w) = runRWS (f a) r s in (a, s', w)
71 instance (Monoid w) => MonadReader r (RWS r w s) where
72 ask = RWS $ \r s -> (r, s, mempty)
73 local f m = RWS $ \r s -> runRWS m (f r) s
75 instance (Monoid w) => MonadWriter w (RWS r w s) where
76 tell w = RWS $ \_ s -> ((), s, w)
77 listen m = RWS $ \r s -> let
78 (a, s', w) = runRWS m r s
80 pass m = RWS $ \r s -> let
81 ((a, f), s', w) = runRWS m r s
84 instance (Monoid w) => MonadState s (RWS r w s) where
85 get = RWS $ \_ s -> (s, s, mempty)
86 put s = RWS $ \_ _ -> ((), s, mempty)
89 evalRWS :: RWS r w s a -> r -> s -> (a, w)
91 (a, _, w) = runRWS m r s
94 execRWS :: RWS r w s a -> r -> s -> (s, w)
96 (_, s', w) = runRWS m r s
99 mapRWS :: ((a, s, w) -> (b, s, w')) -> RWS r w s a -> RWS r w' s b
100 mapRWS f m = RWS $ \r s -> f (runRWS m r s)
102 withRWS :: (r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
103 withRWS f m = RWS $ \r s -> uncurry (runRWS m) (f r s)
106 newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
108 instance (Monad m) => Functor (RWST r w s m) where
109 fmap f m = RWST $ \r s -> do
110 (a, s', w) <- runRWST m r s
113 instance (Monoid w, Monad m) => Monad (RWST r w s m) where
114 return a = RWST $ \_ s -> return (a, s, mempty)
115 m >>= k = RWST $ \r s -> do
116 (a, s', w) <- runRWST m r s
117 (b, s'',w') <- runRWST (k a) r s'
118 return (b, s'', w `mappend` w')
119 fail msg = RWST $ \_ _ -> fail msg
121 instance (Monoid w, MonadPlus m) => MonadPlus (RWST r w s m) where
122 mzero = RWST $ \_ _ -> mzero
123 m `mplus` n = RWST $ \r s -> runRWST m r s `mplus` runRWST n r s
125 instance (Monoid w, MonadFix m) => MonadFix (RWST r w s m) where
126 mfix f = RWST $ \r s -> mfix $ \ ~(a, _, _) -> runRWST (f a) r s
128 instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where
129 ask = RWST $ \r s -> return (r, s, mempty)
130 local f m = RWST $ \r s -> runRWST m (f r) s
132 instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where
133 tell w = RWST $ \_ s -> return ((),s,w)
134 listen m = RWST $ \r s -> do
135 (a, s', w) <- runRWST m r s
136 return ((a, w), s', w)
137 pass m = RWST $ \r s -> do
138 ((a, f), s', w) <- runRWST m r s
141 instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where
142 get = RWST $ \_ s -> return (s, s, mempty)
143 put s = RWST $ \_ _ -> return ((), s, mempty)
145 instance (Monoid w) => MonadTrans (RWST r w s) where
146 lift m = RWST $ \_ s -> do
148 return (a, s, mempty)
150 instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
151 liftIO = lift . liftIO
154 evalRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (a, w)
156 (a, _, w) <- runRWST m r s
159 execRWST :: (Monad m) => RWST r w s m a -> r -> s -> m (s, w)
161 (_, s', w) <- runRWST m r s
164 mapRWST :: (m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
165 mapRWST f m = RWST $ \r s -> f (runRWST m r s)
167 withRWST :: (r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
168 withRWST f m = RWST $ \r s -> uncurry (runRWST m) (f r s)