{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.RVar
( RVar
, runRVar, sampleReaderRVar, sampleStateRVar
, pureRVar
, RVarT
, runRVarT, sampleReaderRVarT, sampleStateRVarT
, runRVarTWith, sampleReaderRVarTWith, sampleStateRVarTWith
, RGen(..)
, uniformRVarT
, uniformRangeRVarT
, Prim(..)
) where
import qualified Control.Monad.IO.Class as T
import Control.Monad.Prompt (MonadPrompt(..), PromptT, runPromptT)
import Control.Monad.Reader as MTL
import Control.Monad.State as MTL
import qualified Control.Monad.Trans.Class as T
import qualified Data.Functor.Identity as T
import Data.RVar.Prim
import System.Random.Stateful
import Control.Monad (ap, liftM)
type RVar = RVarT T.Identity
pureRVar :: RandomGen g => RVar a -> g -> (a, g)
pureRVar :: RVar a -> g -> (a, g)
pureRVar RVar a
rvar g
g = g -> (StateGenM g -> State g a) -> (a, g)
forall g a.
RandomGen g =>
g -> (StateGenM g -> State g a) -> (a, g)
runStateGen g
g (RVar a -> StateGenM g -> State g a
forall g (m :: * -> *) a. StatefulGen g m => RVar a -> g -> m a
runRVar RVar a
rvar)
runRVar :: StatefulGen g m => RVar a -> g -> m a
runRVar :: RVar a -> g -> m a
runRVar = (forall t. Identity t -> m t) -> RVar a -> g -> m a
forall (m :: * -> *) (n :: * -> *) g a.
StatefulGen g m =>
(forall t. n t -> m t) -> RVarT n a -> g -> 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)
sampleReaderRVar :: (StatefulGen g m, MonadReader g m) => RVar a -> m a
sampleReaderRVar :: RVar a -> m a
sampleReaderRVar = (forall t. Identity t -> m t) -> RVar a -> m a
forall (m :: * -> *) (n :: * -> *) a g.
(StatefulGen g m, MonadReader g m) =>
(forall t. n t -> m t) -> RVarT n a -> m a
sampleReaderRVarTWith (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)
sampleStateRVar :: (RandomGen g, MonadState g m) => RVar a -> m a
sampleStateRVar :: RVar a -> m a
sampleStateRVar = (forall t. Identity t -> m t) -> RVar a -> m a
forall (m :: * -> *) (n :: * -> *) a g.
(RandomGen g, MonadState g m) =>
(forall t. n t -> m t) -> RVarT n a -> m a
sampleStateRVarTWith (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 :: StatefulGen g m => RVarT m a -> g -> m a
runRVarT :: RVarT m a -> g -> m a
runRVarT = (forall t. m t -> m t) -> RVarT m a -> g -> m a
forall (m :: * -> *) (n :: * -> *) g a.
StatefulGen g m =>
(forall t. n t -> m t) -> RVarT n a -> g -> m a
runRVarTWith forall a. a -> a
forall t. m t -> m t
id
sampleStateRVarT :: (RandomGen g, MonadState g m) => RVarT m a -> m a
sampleStateRVarT :: RVarT m a -> m a
sampleStateRVarT RVarT m a
rvar = RVarT m a -> StateGenM g -> m a
forall g (m :: * -> *) a. StatefulGen g m => RVarT m a -> g -> m a
runRVarT RVarT m a
rvar StateGenM g
forall g. StateGenM g
StateGenM
sampleReaderRVarT :: (StatefulGen g m, MonadReader g m) => RVarT m a -> m a
sampleReaderRVarT :: RVarT m a -> m a
sampleReaderRVarT RVarT m a
rvar = m g
forall r (m :: * -> *). MonadReader r m => m r
ask m g -> (g -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RVarT m a -> g -> m a
forall g (m :: * -> *) a. StatefulGen g m => RVarT m a -> g -> m a
runRVarT RVarT m a
rvar
{-# INLINE runRVarTWith #-}
runRVarTWith :: forall m n g a. StatefulGen g m => (forall t. n t -> m t) -> RVarT n a -> g -> m a
runRVarTWith :: (forall t. n t -> m t) -> RVarT n a -> g -> m a
runRVarTWith forall t. n t -> m t
liftN (RVarT PromptT Prim n a
m) g
gen = (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 t
prim t -> m a
cont = Prim t -> g -> m t
forall g (m :: * -> *) t. StatefulGen g m => Prim t -> g -> m t
uniformPrimM Prim t
prim g
gen 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 n t
nExp 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
{-# INLINE uniformPrimM #-}
uniformPrimM :: StatefulGen g m => Prim t -> g -> m t
uniformPrimM :: Prim t -> g -> m t
uniformPrimM Prim t
prim g
g =
case Prim t
prim of
Prim t
PrimWord8 -> g -> m Word8
forall g (m :: * -> *). StatefulGen g m => g -> m Word8
uniformWord8 g
g
Prim t
PrimWord16 -> g -> m Word16
forall g (m :: * -> *). StatefulGen g m => g -> m Word16
uniformWord16 g
g
Prim t
PrimWord32 -> g -> m Word32
forall g (m :: * -> *). StatefulGen g m => g -> m Word32
uniformWord32 g
g
Prim t
PrimWord64 -> g -> m Word64
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
uniformWord64 g
g
PrimShortByteString Int
n -> Int -> g -> m ShortByteString
forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
uniformShortByteString Int
n g
g
{-# INLINE sampleReaderRVarTWith #-}
sampleReaderRVarTWith ::
forall m n a g. (StatefulGen g m, MonadReader g m)
=> (forall t. n t -> m t)
-> RVarT n a
-> m a
sampleReaderRVarTWith :: (forall t. n t -> m t) -> RVarT n a -> m a
sampleReaderRVarTWith forall t. n t -> m t
liftN (RVarT 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 t
prim t -> m a
cont = m g
forall r (m :: * -> *). MonadReader r m => m r
ask m g -> (g -> m t) -> m t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Prim t -> g -> m t
forall g (m :: * -> *) t. StatefulGen g m => Prim t -> g -> m t
uniformPrimM 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 n t
nExp 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
{-# INLINE sampleStateRVarTWith #-}
sampleStateRVarTWith ::
forall m n a g. (RandomGen g, MonadState g m)
=> (forall t. n t -> m t)
-> RVarT n a
-> m a
sampleStateRVarTWith :: (forall t. n t -> m t) -> RVarT n a -> m a
sampleStateRVarTWith forall t. n t -> m t
liftN (RVarT 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 t
prim t -> m a
cont = Prim t -> StateGenM g -> m t
forall g (m :: * -> *) t. StatefulGen g m => Prim t -> g -> m t
uniformPrimM Prim t
prim StateGenM g
forall g. StateGenM g
StateGenM 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 n t
nExp 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
(RVarT PromptT Prim n a
m) >>= :: RVarT n a -> (a -> RVarT n b) -> RVarT n b
>>= 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
>>= \a
x -> a
x a -> PromptT Prim n b -> PromptT Prim n 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 Applicative (RVarT n) where
pure :: a -> RVarT n a
pure 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 (f :: * -> *) a. Applicative f => a -> f a
pure (a -> PromptT Prim n a) -> a -> PromptT Prim n a
forall a b. (a -> b) -> a -> b
$! a
x)
<*> :: 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 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
data RGen = RGen
instance StatefulGen RGen (RVarT m) where
uniformWord8 :: RGen -> RVarT m Word8
uniformWord8 RGen
RGen = PromptT Prim m Word8 -> RVarT m Word8
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim m Word8 -> RVarT m Word8)
-> PromptT Prim m Word8 -> RVarT m Word8
forall a b. (a -> b) -> a -> b
$ Prim Word8 -> PromptT Prim m Word8
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt Prim Word8
PrimWord8
{-# INLINE uniformWord8 #-}
uniformWord16 :: RGen -> RVarT m Word16
uniformWord16 RGen
RGen = PromptT Prim m Word16 -> RVarT m Word16
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim m Word16 -> RVarT m Word16)
-> PromptT Prim m Word16 -> RVarT m Word16
forall a b. (a -> b) -> a -> b
$ Prim Word16 -> PromptT Prim m Word16
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt Prim Word16
PrimWord16
{-# INLINE uniformWord16 #-}
uniformWord32 :: RGen -> RVarT m Word32
uniformWord32 RGen
RGen = PromptT Prim m Word32 -> RVarT m Word32
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim m Word32 -> RVarT m Word32)
-> PromptT Prim m Word32 -> RVarT m Word32
forall a b. (a -> b) -> a -> b
$ Prim Word32 -> PromptT Prim m Word32
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt Prim Word32
PrimWord32
{-# INLINE uniformWord32 #-}
uniformWord64 :: RGen -> RVarT m Word64
uniformWord64 RGen
RGen = PromptT Prim m Word64 -> RVarT m Word64
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim m Word64 -> RVarT m Word64)
-> PromptT Prim m Word64 -> RVarT m Word64
forall a b. (a -> b) -> a -> b
$ Prim Word64 -> PromptT Prim m Word64
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt Prim Word64
PrimWord64
{-# INLINE uniformWord64 #-}
uniformShortByteString :: Int -> RGen -> RVarT m ShortByteString
uniformShortByteString Int
n RGen
RGen = PromptT Prim m ShortByteString -> RVarT m ShortByteString
forall (m :: * -> *) a. PromptT Prim m a -> RVarT m a
RVarT (PromptT Prim m ShortByteString -> RVarT m ShortByteString)
-> PromptT Prim m ShortByteString -> RVarT m ShortByteString
forall a b. (a -> b) -> a -> b
$ Prim ShortByteString -> PromptT Prim m ShortByteString
forall (p :: * -> *) (m :: * -> *) a. MonadPrompt p m => p a -> m a
prompt (Int -> Prim ShortByteString
PrimShortByteString Int
n)
{-# INLINE uniformShortByteString #-}
uniformRVarT :: Uniform a => RVarT m a
uniformRVarT :: RVarT m a
uniformRVarT = RGen -> RVarT m a
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM RGen
RGen
{-# INLINE uniformRVarT #-}
uniformRangeRVarT :: UniformRange a => (a, a) -> RVarT m a
uniformRangeRVarT :: (a, a) -> RVarT m a
uniformRangeRVarT (a, a)
r = (a, a) -> RGen -> RVarT m a
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (a, a)
r RGen
RGen
{-# INLINE uniformRangeRVarT #-}