Just manually unrolling the definitions for ReaterT and StateT, I think this is correct.

instance RandomGen g => MonadRandom (ReaderStateRandom r s g) where 
    getRandom = RSR (ReaderT (\r -> StateT (\s -> getRandom >>= (\random -> return (random,s)))))

Or, using TupleSelections,

    RSR (ReaderT (\r -> StateT (\s -> (,s) <$> getRandom)))

You could also write this out in terms of execReaderT, execStateT, etc. but I couldn't be arsed.

You also have to add Applicative and Functor instances to RSR.

Cheers,
Will

On Mon, Jun 20, 2016 at 11:12 PM, Christopher Howard <ch.howard@zoho.com> wrote:
Hi, I was expanding on my earlier learning, to try a triple monad stack:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

<...snip...>

import System.Random
import Control.Monad.Random
import Control.Monad.State.Lazy
import Control.Monad.Reader

newtype ReaderStateRandom r s g a = RSR {
  rSR :: ReaderT r (StateT s (Rand g)) a
  } deriving (Monad, MonadReader r, MonadState s)

However, it seems that I must implement MonadRandom myself, as there is
no instance for this sort of arrangement already. Probably this is
trivial, but I'm having trouble wrapping my mind around how to do it.
Would anybody perhaps assist me in implementing one function, to help
guide me in the correct direction?

instance MonadRandom (ReaderStateRandom r s g) where

  getRandom = ...?


--
http://justonemoremathproblem.com
To protect my privacy, please use PGP encryption. It's free and easy
to use! My public key ID is 0x340EA95A (pgp.mit.edu).

_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
Only members subscribed via the mailman list are allowed to post.