Friday, May 23, 2014

[xjrnkknh] RandT ST

Here is a brief example of combining the RandT monad transformer with the ST monad. We write a random value into an STRef, then read it. The magic function is lift :: (MonadTrans t, Monad m) => m a -> t m a .

{-# LANGUAGE ScopedTypeVariables #-}
module Main where {
import Control.Monad.Random(RandT, getRandomR, evalRandT);
import Control.Monad.ST.Lazy(ST, runST);
import System.Random(RandomGen, StdGen, mkStdGen);
import Control.Monad.Trans(lift);
import Data.STRef.Lazy(STRef, writeSTRef, readSTRef, newSTRef);

-- We could use a shortcut like this, but will not for pedagogical purposes.
type RS s a = RandT StdGen (ST s) a;

doWrite :: (RandomGen g) => STRef s Int -> RandT g (ST s) ();
doWrite v = do {
  r :: Int <- getRandomR (1, 6);
  lift $ writeSTRef v r;
};

foo :: (RandomGen g) => RandT g (ST s) Int;
foo = do {
  v :: STRef s Int <- lift $ newSTRef 0;
  doWrite v;
  out :: Int <- lift $ readSTRef v;
  return out;
};

runAll :: Int;
runAll = runST $ evalRandT foo $ mkStdGen 12345;

main :: IO ();
main = print runAll;
}

Here is the output, typical of the flaw in random number generation of the first sample.
6

Previously, an example of ErrorT and ST.

No comments :