<div dir="ltr">Just manually unrolling the definitions for ReaterT and StateT, I think this is correct.<div><br></div><div>instance RandomGen g => MonadRandom (ReaderStateRandom r s g) where </div><div>    getRandom = RSR (ReaderT (\r -> StateT (\s -> getRandom >>= (\random -> return (random,s)))))<br></div><div><br></div><div>Or, using TupleSelections,</div><div><br></div><div>    RSR (ReaderT (\r -> StateT (\s -> (,s) <$> getRandom)))</div><div><br></div><div>You could also write this out in terms of execReaderT, execStateT, etc. but I couldn't be arsed.</div><div><br></div><div>You also have to add Applicative and Functor instances to RSR.</div><div><br></div><div>Cheers,</div><div>Will</div></div><div class="gmail_extra"><br><div class="gmail_quote">On Mon, Jun 20, 2016 at 11:12 PM, Christopher Howard <span dir="ltr"><<a href="mailto:ch.howard@zoho.com" target="_blank">ch.howard@zoho.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hi, I was expanding on my earlier learning, to try a triple monad stack:<br>
<br>
{-# LANGUAGE GeneralizedNewtypeDeriving #-}<br>
<br>
<...snip...><br>
<br>
import System.Random<br>
import Control.Monad.Random<br>
import Control.Monad.State.Lazy<br>
import Control.Monad.Reader<br>
<br>
newtype ReaderStateRandom r s g a = RSR {<br>
  rSR :: ReaderT r (StateT s (Rand g)) a<br>
  } deriving (Monad, MonadReader r, MonadState s)<br>
<br>
However, it seems that I must implement MonadRandom myself, as there is<br>
no instance for this sort of arrangement already. Probably this is<br>
trivial, but I'm having trouble wrapping my mind around how to do it.<br>
Would anybody perhaps assist me in implementing one function, to help<br>
guide me in the correct direction?<br>
<br>
instance MonadRandom (ReaderStateRandom r s g) where<br>
<br>
  getRandom = ...?<br>
<span class="HOEnZb"><font color="#888888"><br>
<br>
--<br>
<a href="http://justonemoremathproblem.com" rel="noreferrer" target="_blank">http://justonemoremathproblem.com</a><br>
To protect my privacy, please use PGP encryption. It's free and easy<br>
to use! My public key ID is 0x340EA95A (<a href="http://pgp.mit.edu" rel="noreferrer" target="_blank">pgp.mit.edu</a>).<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</font></span></blockquote></div><br></div>