rwst

diff --git a/rwst.dcl b/rwst.dcl
new file mode 100644 (file)
index 0000000..9afc81c
--- /dev/null
+++ b/rwst.dcl
@@ -0,0 +1,12 @@
+definition module rwst
+
+from Data.Functor import class Functor
+from Data.Monoid import class Monoid, class Semigroup
+from Control.Applicative import class Applicative
+from Control.Monad import class Monad
+
+:: RWST r w s m a
+
+instance Functor (RWST r w s m) | Monad m & Monoid w
+instance Applicative (RWST r w s m) | Monad m & Monoid w
+instance Monad (RWST r w s m) | Monad m & Monoid w

diff --git a/rwst.icl b/rwst.icl
new file mode 100644 (file)
index 0000000..e5c1d7c
--- /dev/null
+++ b/rwst.icl
@@ -0,0 +1,27 @@
+implementation module rwst
+
+from Data.Func import $
+import Data.Functor
+import Data.Monoid
+import Control.Monad
+import Control.Applicative
+
+
+Start = "Test"
+
+:: RWST r w s m a = RWST (r s -> m (a, s, w))
+
+runRWST :: (RWST r w s m a) r s -> m (a, s, w)
+runRWST (RWST f) r s = f r s
+
+instance Functor (RWST r w s m) | Monad m & Monoid w where
+       fmap f m = liftM f m
+
+instance Applicative (RWST r w s m) | Monad m & Monoid w where
+    pure a = RWST \_ s->pure (a, s, mempty)
+       (<*>) mf mx = ap mf mx
+
+instance Monad (RWST r w s m) | Monad m & Monoid w where
+       bind m k = RWST \r s->runRWST m r s 
+               >>= \(a, s`, w)->runRWST (k a) r s`
+               >>= \(b, s``,w`)->pure (b, s``, mappend w w`)