{-# LANGUAGE
RankNTypes,
MultiParamTypeClasses,
FlexibleInstances,
GADTs,
ScopedTypeVariables,
CPP
#-}
module Data.RVar
( RandomSource
, MonadRandom
( getRandomWord8
, getRandomWord16
, getRandomWord32
, getRandomWord64
, getRandomDouble
, getRandomNByteInteger
)
, RVar
, runRVar, sampleRVar
, RVarT
, runRVarT, sampleRVarT
, runRVarTWith, sampleRVarTWith
) where
import Data.Random.Internal.Source (Prim(..), MonadRandom(..), RandomSource(..))
import Data.Random.Source ()
import qualified Control.Monad.Trans.Class as T
import Control.Monad (liftM, ap)
import Control.Monad.Prompt (MonadPrompt(..), PromptT, runPromptT)
import qualified Control.Monad.IO.Class as T
import qualified Control.Monad.Trans as MTL
import qualified Data.Functor.Identity as T
type RVar = RVarT T.Identity
runRVar :: RandomSource m s => RVar a -> s -> m a
runRVar :: RVar a -> s -> m a
runRVar = (forall t. Identity t -> m t) -> RVar a -> s -> m a
forall (m :: * -> *) (n :: * -> *) s a.
RandomSource m s =>
(forall t. n t -> m t) -> RVarT n a -> s -> m a
runRVarTWith (t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> m t) -> (Identity t -> t) -> Identity t -> m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity t -> t
forall a. Identity a -> a
T.runIdentity)
sampleRVar :: MonadRandom m => RVar a -> m a
sampleRVar :: RVar a -> m a
sampleRVar = (forall t. Identity t -> m t) -> RVar a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadRandom m =>
(forall t. n t -> m t) -> RVarT n a -> m a
sampleRVarTWith (t -> m t
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> m t) -> (Identity t -> t) -> Identity t -> m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity t -> t
forall a. Identity a -> a
T.runIdentity)
newtype RVarT m a = RVarT { RVarT m a -> PromptT Prim m a
unRVarT :: PromptT Prim m a }
runRVarT :: RandomSource m s => RVarT m a -> s -> m a
runRVarT :: RVarT m a -> s -> m a
runRVarT = (forall t. m t -> m t) -> RVarT m a -> s -> m a
forall (m :: * -> *) (n :: * -> *) s a.
RandomSource m s =>
(forall t. n t -> m t) -> RVarT n a -> s -> m a
runRVarTWith forall a. a -> a
forall t. m t -> m t
id
sampleRVarT :: MonadRandom m => RVarT m a -> m a
sampleRVarT :: RVarT m a -> m a
sampleRVarT = (forall t. m t -> m t) -> RVarT m a -> m a
forall (m :: * -> *) (n :: * -> *) a.
MonadRandom m =>
(forall t. n t -> m t) -> RVarT n a -> m a
sampleRVarTWith forall a. a -> a
forall t. m t -> m t
id
{-# INLINE runRVarTWith #-}
runRVarTWith :: forall m n s a. RandomSource m s => (forall t. n t -> m t) -> RVarT n a -> s -> m a
runRVarTWith :: (forall t. n t -> m t) -> RVarT n a -> s -> m a
runRVarTWith liftN :: forall t. n t -> m t
liftN (RVarT m :: PromptT Prim n a
m) src :: s
src = (a -> m a)
-> (forall a. Prim a -> (a -> m a) -> m a)
-> (forall a. n a -> (a -> m a) -> m a)
-> PromptT Prim n a
-> m a
forall (p :: * -> *) (m :: * -> *) r b.
(r -> b)
-> (forall a. p a -> (a -> b) -> b)
-> (forall a. m a -> (a -> b) -> b)
-> PromptT p m r
-> b
runPromptT a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Prim a -> (a -> m a) -> m a
bindP forall a. n a -> (a -> m a) -> m a
bindN PromptT Prim n a
m
where
bindP :: forall t. (Prim t -> (t -> m a) -> m a)
bindP :: Prim t -> (t -> m a) -> m a
bindP prim :: Prim t
prim cont :: t -> m a
cont = s -> Prim t -> m t
forall (m :: * -> *) s t. RandomSource m s => s -> Prim t -> m t
getRandomPrimFrom s
src Prim t
prim m t -> (t -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> m a
cont
bindN :: forall t. n t -> (t -> m a) -> m a
bindN :: n t -> (t -> m a) -> m a
bindN nExp :: n t
nExp cont :: t -> m a
cont = n t -> m t
forall t. n t -> m t
liftN n t
nExp m t -> (t -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> m a
cont
sampleRVarTWith :: forall m n a. MonadRandom m => (forall t. n t -> m t) -> RVarT n a -> m a
sampleRVarTWith :: (forall t. n t -> m t) -> RVarT n a -> m a
sampleRVarTWith liftN :: forall t. n t -> m t
liftN (RVarT m :: PromptT Prim n a
m) = (a -> m a)
-> (forall a. Prim a -> (a -> m a) -> m a)
-> (forall a. n a -> (a -> m a) -> m a)
-> PromptT Prim n a
-> m a
forall (p :: * -> *) (m :: * -> *) r b.
(r -> b)
-> (forall a. p a -> (a -> b) -> b)
-> (forall a. m a -> (a -> b) -> b)
-> PromptT p m r
-> b
runPromptT a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Prim a -> (a -> m a) -> m a
bindP forall a. n a -> (a -> m a) -> m a
bindN PromptT Prim n a
m
where
bindP :: forall t. (Prim t -> (t -> m a) -> m a)
bindP :: Prim t -> (t -> m a) -> m a
bindP prim :: Prim t
prim cont :: t -> m a
cont = Prim t -> m t
forall (m :: * -> *) t. MonadRandom m => Prim t -> m t
getRandomPrim Prim t
prim m t -> (t -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> m a
cont
bindN :: forall t. n t -> (t -> m a) -> m a
bindN :: n t -> (t -> m a) -> m a
bindN nExp :: n t
nExp cont :: t -> m a
cont = n t -> m t
forall t. n t -> m t
liftN n t
nExp m t -> (t -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> m a
cont
instance Functor (RVarT n) where
fmap :: (a -> b) -> RVarT n a -> RVarT n b
fmap = (a -> b) -> RVarT n a -> RVarT n b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Monad (RVarT n) where
return :: a -> RVarT n a
return x :: a
x = PromptT Prim n a -> RVarT n a
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (a -> PromptT Prim n a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> PromptT Prim n a) -> a -> PromptT Prim n a
forall a b. (a -> b) -> a -> b
$! a
x)
(RVarT m :: PromptT Prim n a
m) >>= :: RVarT n a -> (a -> RVarT n b) -> RVarT n b
>>= k :: a -> RVarT n b
k = PromptT Prim n b -> RVarT n b
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim n a
m PromptT Prim n a -> (a -> PromptT Prim n b) -> PromptT Prim n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x :: a
x -> a
x a -> PromptT Prim n b -> PromptT Prim n b
forall a b. a -> b -> b
`seq` RVarT n b -> PromptT Prim n b
forall (m :: * -> *) a. RVarT m a -> PromptT Prim m a
unRVarT (a -> RVarT n b
k a
x))
instance MonadRandom (RVarT n) where
getRandomPrim :: Prim t -> RVarT n t
getRandomPrim = PromptT Prim n t -> RVarT n t
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim n t -> RVarT n t)
-> (Prim t -> PromptT Prim n t) -> Prim t -> RVarT n t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim t -> PromptT Prim n t
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt
instance Applicative (RVarT n) where
pure :: a -> RVarT n a
pure = a -> RVarT n a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: RVarT n (a -> b) -> RVarT n a -> RVarT n b
(<*>) = RVarT n (a -> b) -> RVarT n a -> RVarT n b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance MonadPrompt Prim (RVarT n) where
prompt :: Prim a -> RVarT n a
prompt = PromptT Prim n a -> RVarT n a
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim n a -> RVarT n a)
-> (Prim a -> PromptT Prim n a) -> Prim a -> RVarT n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prim a -> PromptT Prim n a
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt
instance T.MonadTrans RVarT where
lift :: m a -> RVarT m a
lift m :: m a
m = PromptT Prim m a -> RVarT m a
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (m a -> PromptT Prim m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MTL.lift m a
m)
instance T.MonadIO m => T.MonadIO (RVarT m) where
liftIO :: IO a -> RVarT m a
liftIO = m a -> RVarT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
T.lift (m a -> RVarT m a) -> (IO a -> m a) -> IO a -> RVarT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO
#ifndef MTL2
instance MTL.MonadTrans RVarT where
lift m = RVarT (MTL.lift m)
instance MTL.MonadIO m => MTL.MonadIO (RVarT m) where
liftIO = MTL.lift . MTL.liftIO
#endif