@@ -0,0 +1,53 @@
1+module Control.Monad.RWS
2+
3+import Builtins
4+import Control.Monad.Identity
5+import Control.Monad.State
6+import Control.Monad.Writer
7+import Control.Monad.Reader
8+import Prelude.Monad
9+import Prelude.Functor
10+
11+%access public
12+
13+class (Monoid w, MonadReader r m, MonadWriter w m, MonadState s m) => MonadRWS r w s (m : Type -> Type) where {}
14+
15+record RWST : Type -> Type -> Type -> (Type -> Type) -> Type -> Type where
16+ MkRWST : {m : Type -> Type} ->
17+ (runRWST : r -> s -> m (a, s, w)) -> RWST r w s m a
18+
19+instance Monad m => Functor (RWST r w s m) where
20+ map f (MkRWST m) = MkRWST $ \r => \s => do (a, s', w) <- m r s
21+ return (f a, s', w)
22+
23+instance (Monoid w, Monad m) => Applicative (RWST r w s m) where
24+ pure a = MkRWST $ \_ => \s => return (a, s, neutral)
25+ (MkRWST f) <$> (MkRWST v) = MkRWST $ \r => \s => do (a, s', w) <- v r s
26+ (fn, ss, w') <- f r s
27+ return (fn a, ss, w <+> w)
28+
29+instance (Monoid w, Monad m) => Monad (RWST r w s m) where
30+ (MkRWST m) >>= k = MkRWST $ \r => \s => do (a, s', w) <- m r s
31+ let MkRWST ka = k a
32+ (b, ss, w') <- ka r s'
33+ return (b, ss, w <+> w')
34+
35+instance (Monoid w, Monad m) => MonadReader r (RWST r w s m) where
36+ ask = MkRWST $ \r => \s => return (r, s, neutral)
37+ local f (MkRWST m) = MkRWST $ \r => \s => m (f r) s
38+
39+instance (Monoid w, Monad m) => MonadWriter w (RWST r w s m) where
40+ tell w = MkRWST $ \_ => \s => return ((), s, w)
41+ listen (MkRWST m) = MkRWST $ \r => \s => do (a, s', w) <- m r s
42+ return ((a, w), s', w)
43+ pass (MkRWST m) = MkRWST $ \r => \s => do ((a, f), s', w) <- m r s
44+ return (a, s', f w)
45+
46+instance (Monoid w, Monad m) => MonadState s (RWST r w s m) where
47+ get = MkRWST $ \_ => \s => return (s, s, neutral)
48+ put s = MkRWST $ \_ => \_ => return ((), s, neutral)
49+
50+instance (Monoid w, Monad m) => MonadRWS r w s (RWST r w s m) where {}
51+
52+RWS : Type -> Type -> Type -> Type -> Type
53+RWS r w s a = RWST r w s Identity a