Merge pull request #57 from ethul/topic/rwst-monad-rec

Topic/rwst monad rec

Author: garyb

docs/Control/Monad/RWS.md

@@ -14,7 +14,7 @@ to the `Identity` monad.
 #### `rws`
 
 ``` purescript
-rws :: forall r w s a. (r -> s -> See s a w) -> RWS r w s a
+rws :: forall r w s a. (r -> s -> RWSResult s a w) -> RWS r w s a
 ```
 
 Create an action in the `RWS` monad from a function which uses the
@@ -23,7 +23,7 @@ global context and state explicitly.
 #### `runRWS`
 
 ``` purescript
-runRWS :: forall r w s a. RWS r w s a -> r -> s -> See s a w
+runRWS :: forall r w s a. RWS r w s a -> r -> s -> RWSResult s a w
 ```
 
 Run a computation in the `RWS` monad.
@@ -47,7 +47,7 @@ Run a computation in the `RWS` monad, discarding the result
 #### `mapRWS`
 
 ``` purescript
-mapRWS :: forall r w1 w2 s a1 a2. (See s a1 w1 -> See s a2 w2) -> RWS r w1 s a1 -> RWS r w2 s a2
+mapRWS :: forall r w1 w2 s a1 a2. (RWSResult s a1 w1 -> RWSResult s a2 w2) -> RWS r w1 s a1 -> RWS r w2 s a2
 ```
 
 Change the types of the result and accumulator in a `RWS` action

docs/Control/Monad/RWS/Trans.md

@@ -2,31 +2,26 @@
 
 This module defines the reader-writer-state monad transformer, `RWST`.
 
-#### `See`
+#### `RWSResult`
 
 ``` purescript
-type See s a w = { state :: s, result :: a, log :: w }
-```
-
-#### `mkSee`
-
-``` purescript
-mkSee :: forall s a w. (Monoid w) => s -> a -> w -> See s a w
+data RWSResult state result writer
+  = RWSResult state result writer
 ```
 
 #### `RWST`
 
 ``` purescript
 newtype RWST r w s m a
-  = RWST (r -> s -> m (See s a w))
+  = RWST (r -> s -> m (RWSResult s a w))
 ```
 
 The reader-writer-state monad transformer, which combines the operations
 of `ReaderT`, `WriterT` and `StateT` into a single monad transformer.
 
 ##### Instances
 ``` purescript
-instance functorRWST :: (Functor m) => Functor (RWST r w s m)
+instance functorRWST :: (Functor m, Monoid w) => Functor (RWST r w s m)
 instance applyRWST :: (Bind m, Monoid w) => Apply (RWST r w s m)
 instance bindRWST :: (Bind m, Monoid w) => Bind (RWST r w s m)
 instance applicativeRWST :: (Monad m, Monoid w) => Applicative (RWST r w s m)
@@ -38,12 +33,13 @@ instance monadStateRWST :: (Monad m, Monoid w) => MonadState s (RWST r w s m)
 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 monadErrorRWST :: (MonadError e m, Monoid w) => MonadError e (RWST r w s m)
+instance monadRecRWST :: (Monoid w, MonadRec m) => MonadRec (RWST r w s m)
 ```
 
 #### `runRWST`
 
 ``` purescript
-runRWST :: forall r w s m a. RWST r w s m a -> r -> s -> m (See s a w)
+runRWST :: forall r w s m a. RWST r w s m a -> r -> s -> m (RWSResult s a w)
 ```
 
 Run a computation in the `RWST` monad.
@@ -67,7 +63,7 @@ Run a computation in the `RWST` monad, discarding the result.
 #### `mapRWST`
 
 ``` purescript
-mapRWST :: forall r w1 w2 s m1 m2 a1 a2. (m1 (See s a1 w1) -> m2 (See s a2 w2)) -> RWST r w1 s m1 a1 -> RWST r w2 s m2 a2
+mapRWST :: forall r w1 w2 s m1 m2 a1 a2. (m1 (RWSResult s a1 w1) -> m2 (RWSResult s a2 w2)) -> RWST r w1 s m1 a1 -> RWST r w2 s m2 a2
 ```
 
 Change the result and accumulator types in a `RWST` monad action.

src/Control/Monad/RWS.purs

@@ -26,11 +26,11 @@ type RWS r w s = RWST r w s Identity
 
 -- | Create an action in the `RWS` monad from a function which uses the
 -- | global context and state explicitly.
-rws :: forall r w s a. (r -> s -> See s a w) -> RWS r w s a
+rws :: forall r w s a. (r -> s -> RWSResult s a w) -> RWS r w s a
 rws f = RWST \r s -> return $ f r s
 
 -- | Run a computation in the `RWS` monad.
-runRWS :: forall r w s a. RWS r w s a -> r -> s -> See s a w
+runRWS :: forall r w s a. RWS r w s a -> r -> s -> RWSResult s a w
 runRWS m r s = runIdentity $ runRWST m r s
 
 -- | Run a computation in the `RWS` monad, discarding the final state
@@ -42,7 +42,7 @@ execRWS :: forall r w s a. RWS r w s a -> r -> s -> Tuple s w
 execRWS m r s = runIdentity $ execRWST m r s
 
 -- | Change the types of the result and accumulator in a `RWS` action
-mapRWS :: forall r w1 w2 s a1 a2. (See s a1 w1 -> See s a2 w2) -> RWS r w1 s a1 -> RWS r w2 s a2
+mapRWS :: forall r w1 w2 s a1 a2. (RWSResult s a1 w1 -> RWSResult s a2 w2) -> RWS r w1 s a1 -> RWS r w2 s a2
 mapRWS f = mapRWST (runIdentity >>> f >>> Identity)
 
 -- | Change the type of the context in a `RWS` action

src/Control/Monad/RWS/Trans.purs

@@ -1,98 +1,102 @@
 -- | This module defines the reader-writer-state monad transformer, `RWST`.
 
-module Control.Monad.RWS.Trans 
-  ( See(), mkSee
+module Control.Monad.RWS.Trans
+  ( RWSResult(..)
   , RWST(..), runRWST, evalRWST, execRWST, mapRWST, withRWST
   , module Control.Monad.Trans
   , module Control.Monad.RWS.Class
   ) where
 
 import Prelude
 
+import Data.Either
 import Data.Monoid
 import Data.Tuple
 
-import Control.Monad.Trans
 import Control.Monad.Eff.Class
 import Control.Monad.Error.Class
+import Control.Monad.RWS.Class
+import Control.Monad.Rec.Class
 import Control.Monad.Reader.Class
-import Control.Monad.Writer.Class
 import Control.Monad.State.Class
-import Control.Monad.RWS.Class
-
-type See s a w =
-  { state  :: s
-  , result :: a
-  , log    :: w
-  }
+import Control.Monad.Trans
+import Control.Monad.Writer.Class
 
-mkSee :: forall s a w. (Monoid w) => s -> a -> w -> See s a w
-mkSee s a w = { state: s, result: a, log: w }
+data RWSResult state result writer = RWSResult state result writer
 
 -- | The reader-writer-state monad transformer, which combines the operations
 -- | of `ReaderT`, `WriterT` and `StateT` into a single monad transformer.
-newtype RWST r w s m a = RWST (r -> s -> m (See s a w))
+newtype RWST r w s m a = RWST (r -> s -> m (RWSResult s a w))
 
 -- | Run a computation in the `RWST` monad.
-runRWST :: forall r w s m a. RWST r w s m a -> r -> s -> m (See s a w)
+runRWST :: forall r w s m a. RWST r w s m a -> r -> s -> m (RWSResult s a w)
 runRWST (RWST x) = x
 
 -- | Run a computation in the `RWST` monad, discarding the final state.
 evalRWST :: forall r w s m a. (Monad m) => RWST r w s m a -> r -> s -> m (Tuple a w)
-evalRWST m r s = runRWST m r s >>= \see -> return (Tuple see.result see.log)
+evalRWST m r s = runRWST m r s >>= \(RWSResult _ result writer) -> return (Tuple result writer)
 
 -- | Run a computation in the `RWST` monad, discarding the result.
 execRWST :: forall r w s m a. (Monad m) => RWST r w s m a -> r -> s -> m (Tuple s w)
-execRWST m r s = runRWST m r s >>= \see -> return (Tuple see.state see.log)
+execRWST m r s = runRWST m r s >>= \(RWSResult state _ writer) -> return (Tuple state writer)
 
 -- | Change the result and accumulator types in a `RWST` monad action.
-mapRWST :: forall r w1 w2 s m1 m2 a1 a2. (m1 (See s a1 w1) -> m2 (See s a2 w2)) -> RWST r w1 s m1 a1 -> RWST r w2 s m2 a2
+mapRWST :: forall r w1 w2 s m1 m2 a1 a2. (m1 (RWSResult s a1 w1) -> m2 (RWSResult s a2 w2)) -> RWST r w1 s m1 a1 -> RWST r w2 s m2 a2
 mapRWST f m = RWST \r s -> f $ runRWST m r s
 
 -- | Change the context type in a `RWST` monad action.
 withRWST :: forall r1 r2 w s m a. (r2 -> s -> Tuple r1 s) -> RWST r1 w s m a -> RWST r2 w s m a
 withRWST f m = RWST \r s -> uncurry (runRWST m) (f r s)
 
-instance functorRWST :: (Functor m) => Functor (RWST r w s m) where
-  map f m = RWST \r s -> (\see -> see{result = f see.result}) <$> runRWST m r s
+instance functorRWST :: (Functor m, Monoid w) => Functor (RWST r w s m) where
+  map f m = RWST \r s -> (\(RWSResult state result writer) -> RWSResult state (f result) writer) <$> runRWST m r s
 
 instance applyRWST :: (Bind m, Monoid w) => Apply (RWST r w s m) where
   apply f m = RWST \r s ->
-    runRWST f r s  >>= \{state = s',  result = f',  log = w'}  ->
-    runRWST m r s' <#> \{state = s'', result = a'', log = w''} ->
-    mkSee s'' (f' a'') (w' ++ w'')
+    runRWST f r s  >>= \(RWSResult s' f' w') ->
+    runRWST m r s' <#> \(RWSResult s'' a'' w'') ->
+    RWSResult s'' (f' a'') (w' ++ w'')
 
 instance bindRWST :: (Bind m, Monoid w) => Bind (RWST r w s m) where
   bind m f = RWST \r s ->
-    runRWST m     r s  >>= \{result = a, state = s', log = l} ->
-    runRWST (f a) r s' <#> \see' ->
-    see' { log = l ++ see'.log }
+    runRWST m     r s  >>= \(RWSResult s' a w) ->
+    runRWST (f a) r s' <#> \(RWSResult state result writer) ->
+    RWSResult state result (w ++ writer)
 
 instance applicativeRWST :: (Monad m, Monoid w) => Applicative (RWST r w s m) where
-  pure a = RWST \_ s -> pure $ mkSee s a mempty
+  pure a = RWST \_ s -> pure $ RWSResult s a mempty
 
 instance monadRWST :: (Monad m, Monoid w) => Monad (RWST r w s m)
 
 instance monadTransRWST :: (Monoid w) => MonadTrans (RWST r w s) where
-  lift m = RWST \_ s -> m >>= \a -> return $ mkSee s a mempty
+  lift m = RWST \_ s -> m >>= \a -> return $ RWSResult s a mempty
 
 instance monadEffRWS :: (Monad m, Monoid w, MonadEff eff m) => MonadEff eff (RWST r w s m) where
   liftEff = lift <<< liftEff
 
 instance monadReaderRWST :: (Monad m, Monoid w) => MonadReader r (RWST r w s m) where
-  ask = RWST \r s -> pure $ mkSee s r mempty
+  ask = RWST \r s -> pure $ RWSResult s r mempty
   local f m = RWST \r s -> runRWST m (f r) s
 
 instance monadStateRWST :: (Monad m, Monoid w) => MonadState s (RWST r w s m) where
-  state f = RWST \_ s -> case f s of Tuple a s' -> pure $ mkSee s' a mempty
+  state f = RWST \_ s -> case f s of Tuple a s' -> pure $ RWSResult s' a mempty
 
 instance monadWriterRWST :: (Monad m, Monoid w) => MonadWriter w (RWST r w s m) where
-  writer (Tuple a w) = RWST \_ s -> pure $ { state: s, result: a, log: w }
-  listen m = RWST \r s -> runRWST m r s >>= \{ state: s', result: a, log: w} -> pure { state: s', result: Tuple a w, log: w }
-  pass m = RWST \r s -> runRWST m r s >>= \{ result: Tuple a f, state: s', log: w} -> pure { state: s', result: a, log: f w }
+  writer (Tuple a w) = RWST \_ s -> pure $ RWSResult s a w
+  listen m = RWST \r s -> runRWST m r s >>= \(RWSResult s' a w) -> pure $ RWSResult s' (Tuple a w) w
+  pass m = RWST \r s -> runRWST m r s >>= \(RWSResult s' (Tuple a f) w) -> pure $ RWSResult s' a (f w)
 
 instance monadRWSRWST :: (Monad m, Monoid w) => MonadRWS r w s (RWST r w s m)
 
 instance monadErrorRWST :: (MonadError e m, Monoid w) => MonadError e (RWST r w s m) where
   throwError e = lift (throwError e)
   catchError m h = RWST $ \r s -> catchError (runRWST m r s) (\e -> runRWST (h e) r s)
+
+instance monadRecRWST :: (Monoid w, MonadRec m) => MonadRec (RWST r w s m) where
+  tailRecM k a = RWST \r s -> tailRecM (k' r) (RWSResult s a mempty)
+    where
+    k' r (RWSResult state result writer) = do
+      RWSResult state' result' writer' <- runRWST (k result) r state
+      return case result' of
+                  Left a -> Left (RWSResult state' a (writer <> writer'))
+                  Right b -> Right (RWSResult state' b (writer <> writer'))

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,48 @@
+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.State.Trans
+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))
+
+loopState :: Int -> StateT Int Identity Unit
+loopState n = tailRecM go n
+  where
+  go 0 = do
+    return (Right unit)
+  go n = do
+    x <- get
+    put (x + 1)
+    return (Left (n - 1))
+
+main = do
+  t1 <- t
+  res1 <- pure $ runIdentity (runRWST (loop 1000000) "" 0)
+  t2 <- t
+  print $ "RWST: " ++ show (t2 - t1)
+  t3 <- t
+  res2 <- pure $ execState (loopState 1000000) 0
+  t4 <- t
+  print $ "StateT: " ++ show (t4 - t3)
+
+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