improving type checking

[cc1516.git] / RWST.icl

diff --git a/RWST.icl b/RWST.icl
index 4b38482..2f02d6d 100644 (file)
--- a/RWST.icl
+++ b/RWST.icl
@@ -1,15 +1,36 @@
 implementation module RWST
 
+from StdFunc import o
 import StdTuple
 
 from Data.Func import $
-import Data.Void
 import Data.Functor.Identity
 import Data.Functor
 import Data.Monoid
 import Control.Monad
+import Control.Monad.Trans
 import Control.Applicative
 
+// The RWS monad 
+:: RWS r w s a :== RWST r w s Identity a
+
+rws :: (r -> s -> (a, s, w)) -> RWS r w s a
+rws f = RWST \r s->Identity $ f r s
+
+runRWS :: (RWS r w s a) r s -> (a, s, w)
+runRWS m r s = runIdentity $ runRWST m r s
+
+evalRWS :: (RWS r w s a) r s -> (a, w)
+evalRWS m r s = let (a, _, w) = runRWS m r s in (a, w)
+
+execRWS :: (RWS r w s a) r s -> (s, w)
+execRWS m r s = let (_, s`, w) = runRWS m r s in (s`, w)
+
+mapRWS :: ((a, s, w) -> (b, s, w`)) (RWS r w s a) -> RWS r w` s b
+mapRWS f m = mapRWST (Identity o f o runIdentity) m
+
+withRWS :: (r` s -> (r, s)) (RWS r w s a) -> RWS r` w s a
+withRWS f m = withRWST f m
 
 // The RWST monad transformer
 :: RWST r w s m a = RWST (r s -> m (a, s, w))
@@ -26,6 +47,9 @@ instance Monad (RWST r w s m) | Monad m & Monoid w where
                >>= \(a, s`, w)->runRWST (k a) r s`
                >>= \(b, s``,w`)->pure (b, s``, mappend w w`)
 
+instance MonadTrans (RWST r w s) | Monoid w where
+       liftT m = RWST \_ s->m >>= \a->pure (a, s, mempty)
+
 runRWST :: (RWST r w s m a) r s -> m (a, s, w)
 runRWST (RWST f) r s = f r s
 
@@ -52,8 +76,8 @@ 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)
+tell :: w -> RWST r w s m () | Monoid w & Monad m
+tell w = RWST \_ s->pure ((), 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)
@@ -71,10 +95,10 @@ censor f m = pass $ m >>= \a->pure (a, f)
 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)
+put :: s -> RWST r w s m () | Monoid w & Monad m
+put s = RWST \_ _->pure ((), s, mempty)
 
-modify :: (s -> s) -> RWST r w s m Void | Monoid w & Monad m
+modify :: (s -> s) -> RWST r w s m () | Monoid w & Monad m
 modify f = get >>= \s->put $ f s
  
 gets :: (s -> a) -> RWST r w s m a | Monoid w & Monad m