module Data.Random.RVar
( RVar
, runRVar
, RVarT
, runRVarT
, nByteInteger
, nBitInteger
) where
import Data.Random.Source
import Data.Random.Lift as L
import Data.Bits
import qualified Control.Monad.Trans as T
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Identity
type RVar = RVarT Identity
data RVarDict n m where
RVarDict :: (Lift n m, Monad m, RandomSource m s) => s -> RVarDict n m
runRVar :: RandomSource m s => RVar a -> s -> m a
runRVar = runRVarT
newtype RVarT n a = RVarT { unRVarT :: forall m r. (a -> m r) -> RVarDict n m -> m r }
runRVarT :: (Lift n m, RandomSource m s) => RVarT n a -> s -> m a
runRVarT (RVarT m) (src) = m return (RVarDict src)
instance Functor (RVarT n) where
fmap = liftM
instance Monad (RVarT n) where
return x = RVarT $ \k _ -> k x
fail s = RVarT $ \_ (RVarDict _) -> fail s
(RVarT m) >>= k = RVarT $ \c s -> m (\a -> unRVarT (k a) c s) s
instance Applicative (RVarT n) where
pure = return
(<*>) = ap
instance T.MonadTrans RVarT where
lift m = RVarT $ \k r@(RVarDict _) -> L.lift m >>= \a -> k a
instance Lift (RVarT Identity) (RVarT m) where
lift (RVarT m) = RVarT $ \k (RVarDict src) -> m k (RVarDict src)
instance MonadIO m => MonadIO (RVarT m) where
liftIO = T.lift . liftIO
instance MonadRandom (RVarT n) where
getRandomByte = RVarT $ \k (RVarDict s) -> getRandomByteFrom s >>= \a -> k a
getRandomWord = RVarT $ \k (RVarDict s) -> getRandomWordFrom s >>= \a -> k a
getRandomDouble = RVarT $ \k (RVarDict s) -> getRandomDoubleFrom s >>= \a -> k a
nByteInteger :: Int -> RVarT m Integer
nByteInteger 1 = do
x <- getRandomByte
return $! toInteger x
nByteInteger 8 = do
x <- getRandomWord
return $! toInteger x
nByteInteger n = nBitInteger (n `shiftL` 3)
nBitInteger :: Int -> RVarT m Integer
nBitInteger 8 = do
x <- getRandomByte
return $! toInteger x
nBitInteger (n+64) = do
x <- getRandomWord
y <- nBitInteger n
return $! (toInteger x `shiftL` n) .|. y
nBitInteger n = do
x <- getRandomWord
return $! toInteger (x `shiftR` (64n))