From e402533a984929c6cd9a27efbc144313b7c33c8e Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 15 Apr 2016 10:15:15 +0200
Subject: [PATCH] rwst done, rws to go

---
 RWST.dcl | 46 +++++++++++++++++++++++++++
 RWST.icl | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 rwst.dcl | 12 --------
 rwst.icl | 27 ----------------
 4 files changed, 140 insertions(+), 39 deletions(-)
 create mode 100644 RWST.dcl
 create mode 100644 RWST.icl
 delete mode 100644 rwst.dcl
 delete mode 100644 rwst.icl

diff --git a/RWST.dcl b/RWST.dcl
new file mode 100644
index 0000000..1a5b3b2
--- /dev/null
+++ b/RWST.dcl
@@ -0,0 +1,46 @@
+definition module RWST
+
+from Control.Applicative import class Applicative
+from Control.Monad import class Monad
+from Data.Void import :: Void
+from Data.Functor import class Functor
+from Data.Functor.Identity import :: Identity
+from Data.Monoid import class Monoid, class Semigroup
+
+:: RWS r w s a :== RWST r w s Identity a
+
+// The RWST monad transformer
+:: RWST r w s m a = RWST (r s -> m (a, s, w))
+
+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
+
+runRWST :: (RWST r w s m a) r s -> m (a, s, w)
+evalRWST :: (RWST r w s m a) r s -> m (a, w) | Monad m
+execRWST :: (RWST r w s m a) r s -> m (s, w) | Monad m
+mapRWST :: ((m (a, s, w)) -> n (b, s, w`)) (RWST r w s m a) -> RWST r w` s n b
+withRWST :: (r` -> s -> (r, s)) (RWST r w s m a) -> RWST r` w s m a
+
+// Reader operations
+ask :: RWST r w s m r | Monoid w & Monad m 
+local :: (r -> r) (RWST r w s m a) -> RWST r w s m a | Monoid w & Monad m
+asks :: (r -> a) -> RWST r w s m a | Monoid w & Monad m
+
+// Writer operations
+tell :: w -> RWST r w s m Void | Monoid w & Monad m
+listen :: (RWST r w s m a) -> RWST r w s m (a, w) | Monoid w & Monad m
+pass :: (RWST r w s m (a, w -> w)) -> RWST r w s m a | Monoid w & Monad m
+listens :: (w -> b) (RWST r w s m a) -> RWST r w s m (a, b)| Monoid w & Monad m
+censor :: (w -> w) (RWST r w s m a) -> RWST r w s m a | Monoid w & Monad m
+
+// State operations
+get :: RWST r w s m s | Monoid w & Monad m
+put :: s -> RWST r w s m Void | Monoid w & Monad m
+modify :: (s -> s) -> RWST r w s m Void | Monoid w & Monad m
+gets :: (s -> a) -> RWST r w s m a | Monoid w & Monad m
+
+// Lifting other operations
+liftCallCC :: ((((a,s,w) -> m (b,s,w)) -> m (a,s,w)) -> m (a,s,w)) ((a -> RWST r w s m b) -> RWST r w s m a) -> RWST r w s m a | Monoid w
+liftCallCC` :: ((((a,s,w) -> m (b,s,w)) -> m (a,s,w)) -> m (a,s,w)) ((a -> RWST r w s m b) -> RWST r w s m a) -> RWST r w s m a | Monoid w
+liftCatch :: ((m (a,s,w)) (e -> m (a,s,w)) -> m (a,s,w)) (RWST l w s m a) (e -> RWST l w s m a) -> RWST l w s m a
diff --git a/RWST.icl b/RWST.icl
new file mode 100644
index 0000000..4b38482
--- /dev/null
+++ b/RWST.icl
@@ -0,0 +1,94 @@
+implementation module RWST
+
+import StdTuple
+
+from Data.Func import $
+import Data.Void
+import Data.Functor.Identity
+import Data.Functor
+import Data.Monoid
+import Control.Monad
+import Control.Applicative
+
+
+// The RWST monad transformer
+:: RWST r w s m a = RWST (r s -> m (a, s, w))
+
+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`)
+
+runRWST :: (RWST r w s m a) r s -> m (a, s, w)
+runRWST (RWST f) r s = f r s
+
+evalRWST :: (RWST r w s m a) r s -> m (a, w) | Monad m
+evalRWST m r s = runRWST m r s >>= \(a, _, w)->pure (a, w)
+
+execRWST :: (RWST r w s m a) r s -> m (s, w) | Monad m
+execRWST m r s = runRWST m r s >>= \(_, s`, w)->pure (s, w)
+
+mapRWST :: ((m (a, s, w)) -> n (b, s, w`)) (RWST r w s m a) -> RWST r w` s n b
+mapRWST f m = RWST \r s->f $ runRWST m r s
+
+withRWST :: (r` -> s -> (r, s)) (RWST r w s m a) -> RWST r` w s m a
+withRWST f m = RWST \r s->uncurry (runRWST m) $ f r s
+
+// Reader operations
+ask :: RWST r w s m r | Monoid w & Monad m 
+ask = RWST \r s->pure (r, s, mempty)
+
+local :: (r -> r) (RWST r w s m a) -> RWST r w s m a | Monoid w & Monad m
+local f m = RWST \r s->runRWST m (f r) s
+
+asks :: (r -> a) -> RWST r w s m a | Monoid w & Monad m
+asks f = ask >>= \r->pure $ f r
+
+// Writer operations
+tell :: w -> RWST r w s m Void | Monoid w & Monad m
+tell w = RWST \_ s->pure (Void, s,w)
+
+listen :: (RWST r w s m a) -> RWST r w s m (a, w) | Monoid w & Monad m
+listen m = RWST \r s->runRWST m r s >>= \(a, s`, w)->pure ((a, w), s`, w)
+
+pass :: (RWST r w s m (a, w -> w)) -> RWST r w s m a | Monoid w & Monad m
+pass m = RWST \r s->runRWST m r s >>= \((a, f), s`, w)->pure (a, s`, f w)
+
+listens :: (w -> b) (RWST r w s m a) -> RWST r w s m (a, b)| Monoid w & Monad m
+listens f m = listen m >>= \(a, w)->pure (a, f w)
+ 
+censor :: (w -> w) (RWST r w s m a) -> RWST r w s m a | Monoid w & Monad m
+censor f m = pass $ m >>= \a->pure (a, f)
+
+// State operation
+get :: RWST r w s m s | Monoid w & Monad m
+get = RWST \_ s->pure (s, s, mempty)
+
+put :: s -> RWST r w s m Void | Monoid w & Monad m
+put s = RWST \_ _->pure (Void, s, mempty)
+
+modify :: (s -> s) -> RWST r w s m Void | Monoid w & Monad m
+modify f = get >>= \s->put $ f s
+ 
+gets :: (s -> a) -> RWST r w s m a | Monoid w & Monad m
+gets f = get >>= \s->pure $ f s
+
+// Lifting other operations
+liftCallCC :: ((((a,s,w) -> m (b,s,w)) -> m (a,s,w)) -> m (a,s,w)) ((a -> RWST r w s m b) -> RWST r w s m a) -> RWST r w s m a | Monoid w
+liftCallCC callCC f = RWST \r s->callCC
+	\c->runRWST (f $ \a->RWST \_ _->c (a, s, mempty)) r s
+
+liftCallCC` :: ((((a,s,w) -> m (b,s,w)) -> m (a,s,w)) -> m (a,s,w)) ((a -> RWST r w s m b) -> RWST r w s m a) -> RWST r w s m a | Monoid w
+liftCallCC` callCC f = RWST \r s->callCC
+	\c->runRWST (f $ \a->RWST \_ s`->c (a, s`, mempty)) r s
+
+liftCatch :: ((m (a,s,w)) (e -> m (a,s,w)) -> m (a,s,w)) (RWST l w s m a) (e -> RWST l w s m a) -> RWST l w s m a
+liftCatch catchError m h = RWST \r s->catchError 
+	(runRWST m r s) (\e->runRWST (h e) r s)
diff --git a/rwst.dcl b/rwst.dcl
deleted file mode 100644
index 9afc81c..0000000
--- a/rwst.dcl
+++ /dev/null
@@ -1,12 +0,0 @@
-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
deleted file mode 100644
index e5c1d7c..0000000
--- a/rwst.icl
+++ /dev/null
@@ -1,27 +0,0 @@
-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`)
-- 
2.20.1