Adding RWS tests

Author: ethul

src/Control/Monad/RWS/Trans.purs

@@ -95,10 +95,10 @@ instance monadWriterRWST :: (Monad m, Monoid w) => MonadWriter w (RWST r w s m)
 instance monadRWSRWST :: (Monad m, Monoid w) => MonadRWS r w s (RWST r w s m)
 
 instance monadRecRWST :: (Monoid w, MonadRec m) => MonadRec (RWST r w s m) where
-  tailRecM k a = RWST \r s -> tailRecM k' { reader: r, writer: mempty, state: s, result: a }
+  tailRecM k a = RWST \r s -> tailRecM (k' r) { writer: mempty, state: s, result: a }
     where
-    k' o = do
-      see <- runRWST (k o.result) o.reader o.state
+    k' r o = do
+      see <- runRWST (k o.result) r o.state
       return case see.result of
-                  Left a -> Left { reader: o.reader, state: see.state, result: a, writer: o.writer <> see.log }
+                  Left a -> Left { state: see.state, result: a, writer: o.writer <> see.log }
                   Right b -> Right (mkSee see.state b (o.writer <> see.log))

test/Example/RWS.js

@@ -0,0 +1,5 @@
+// module Example.RWS
+
+exports.t = function(){
+  return new Date().valueOf();
+};

test/Example/RWS.purs

@@ -0,0 +1,35 @@
+module Example.RWS where
+
+import Prelude
+
+import Control.Monad.Eff
+import Control.Monad.Eff.Console
+import Control.Monad.RWS
+import Control.Monad.RWS.Trans
+import Control.Monad.Rec.Class
+import Control.Monad.State
+import Control.Monad.Writer
+
+import Data.Either
+import Data.Identity
+
+loop :: Int -> RWST String (Array String) Int Identity Unit
+loop n = tailRecM go n
+  where
+  go 0 = do
+    tell [ "Done!" ]
+    return (Right unit)
+  go n = do
+    x <- get
+    put (x + 1)
+    return (Left (n - 1))
+
+main = do
+  t1 <- t
+  res <- pure $ runIdentity (runRWST (loop 10000) "" 0)
+  t2 <- t
+  print $ "RWST.state: " ++ show res.state
+  print $ "RWST.log: " ++ show res.log
+  print $ "t2 - t1 = " ++ show (t2 - t1)
+
+foreign import t :: forall eff. Eff eff Number

test/Test/Main.purs

@@ -9,3 +9,4 @@ main = do
   Example.State.main
   Example.StateEff.main
   Example.Writer.main
+  Example.RWS.main