{- | An 'Automaton's in a monad supporting random number generation (i.e.
having the 'RandT' layer in its stack) can be run.

Running means supplying an initial random number generator,
where the update of the generator at every random number generation is already taken care of.

Under the hood, 'RandT' is basically just 'StateT', with the current random
number generator as mutable state.
-}
module Data.Automaton.Trans.Random (
  runRandS,
  evalRandS,
  getRandomS,
  getRandomsS,
  getRandomRS,
  getRandomRS_,
  getRandomsRS,
  getRandomsRS_,
)
where

-- base
import Control.Arrow (arr, (>>>))

-- MonadRandom
import Control.Monad.Random (
  MonadRandom,
  RandT,
  Random,
  RandomGen,
  getRandom,
  getRandomR,
  getRandomRs,
  getRandoms,
  runRandT,
 )

-- automaton
import Data.Automaton (Automaton, arrM, constM, hoistS)
import Data.Automaton.Trans.State (StateT (..), runStateS_)

-- * Creating random values

-- | Create a stream of random values.
getRandomS :: (MonadRandom m, Random b) => Automaton m a b
getRandomS :: forall (m :: Type -> Type) b a.
(MonadRandom m, Random b) =>
Automaton m a b
getRandomS = m b -> Automaton m a b
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM m b
forall a. Random a => m a
forall (m :: Type -> Type) a. (MonadRandom m, Random a) => m a
getRandom

-- | Create a stream of lists of random values.
getRandomsS :: (MonadRandom m, Random b) => Automaton m a [b]
getRandomsS :: forall (m :: Type -> Type) b a.
(MonadRandom m, Random b) =>
Automaton m a [b]
getRandomsS = m [b] -> Automaton m a [b]
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM m [b]
forall a. Random a => m [a]
forall (m :: Type -> Type) a. (MonadRandom m, Random a) => m [a]
getRandoms

-- | Create a stream of random values in a given fixed range.
getRandomRS :: (MonadRandom m, Random b) => (b, b) -> Automaton m a b
getRandomRS :: forall (m :: Type -> Type) b a.
(MonadRandom m, Random b) =>
(b, b) -> Automaton m a b
getRandomRS (b, b)
range = m b -> Automaton m a b
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (m b -> Automaton m a b) -> m b -> Automaton m a b
forall a b. (a -> b) -> a -> b
$ (b, b) -> m b
forall a. Random a => (a, a) -> m a
forall (m :: Type -> Type) a.
(MonadRandom m, Random a) =>
(a, a) -> m a
getRandomR (b, b)
range

{- | Create a stream of random values in a given range, where the range is
specified on every tick.
-}
getRandomRS_ :: (MonadRandom m, Random b) => Automaton m (b, b) b
getRandomRS_ :: forall (m :: Type -> Type) b.
(MonadRandom m, Random b) =>
Automaton m (b, b) b
getRandomRS_ = ((b, b) -> m b) -> Automaton m (b, b) b
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM (b, b) -> m b
forall a. Random a => (a, a) -> m a
forall (m :: Type -> Type) a.
(MonadRandom m, Random a) =>
(a, a) -> m a
getRandomR

-- | Create a stream of lists of random values in a given fixed range.
getRandomsRS :: (MonadRandom m, Random b) => (b, b) -> Automaton m a [b]
getRandomsRS :: forall (m :: Type -> Type) b a.
(MonadRandom m, Random b) =>
(b, b) -> Automaton m a [b]
getRandomsRS (b, b)
range = m [b] -> Automaton m a [b]
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (m [b] -> Automaton m a [b]) -> m [b] -> Automaton m a [b]
forall a b. (a -> b) -> a -> b
$ (b, b) -> m [b]
forall a. Random a => (a, a) -> m [a]
forall (m :: Type -> Type) a.
(MonadRandom m, Random a) =>
(a, a) -> m [a]
getRandomRs (b, b)
range

{- | Create a stream of lists of random values in a given range, where the
range is specified on every tick.
-}
getRandomsRS_ :: (MonadRandom m, Random b) => Automaton m (b, b) [b]
getRandomsRS_ :: forall (m :: Type -> Type) b.
(MonadRandom m, Random b) =>
Automaton m (b, b) [b]
getRandomsRS_ = ((b, b) -> m [b]) -> Automaton m (b, b) [b]
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM (b, b) -> m [b]
forall a. Random a => (a, a) -> m [a]
forall (m :: Type -> Type) a.
(MonadRandom m, Random a) =>
(a, a) -> m [a]
getRandomRs

-- * Running automata with random effects

{- | Run an 'Automaton' in the 'RandT' random number monad transformer by supplying
an initial random generator. Updates and outputs the generator every step.
-}
runRandS ::
  (RandomGen g, Functor m, Monad m) =>
  Automaton (RandT g m) a b ->
  -- | The initial random number generator.
  g ->
  Automaton m a (g, b)
runRandS :: forall g (m :: Type -> Type) a b.
(RandomGen g, Functor m, Monad m) =>
Automaton (RandT g m) a b -> g -> Automaton m a (g, b)
runRandS = Automaton (StateT g m) a b -> g -> Automaton m a (g, b)
forall (m :: Type -> Type) s a b.
(Functor m, Monad m) =>
Automaton (StateT s m) a b -> s -> Automaton m a (s, b)
runStateS_ (Automaton (StateT g m) a b -> g -> Automaton m a (g, b))
-> (Automaton (RandT g m) a b -> Automaton (StateT g m) a b)
-> Automaton (RandT g m) a b
-> g
-> Automaton m a (g, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. RandT g m x -> StateT g m x)
-> Automaton (RandT g m) a b -> Automaton (StateT g m) a b
forall (m :: Type -> Type) (n :: Type -> Type) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS ((g -> m (x, g)) -> StateT g m x
forall s (m :: Type -> Type) a. (s -> m (a, s)) -> StateT s m a
StateT ((g -> m (x, g)) -> StateT g m x)
-> (RandT g m x -> g -> m (x, g)) -> RandT g m x -> StateT g m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RandT g m x -> g -> m (x, g)
forall g (m :: Type -> Type) a. RandT g m a -> g -> m (a, g)
runRandT)

{- | Evaluate an 'Automaton' in the 'RandT' transformer, i.e. extract possibly random
values by supplying an initial random generator. Updates the generator every
step but discards the generator.
-}
evalRandS ::
  (RandomGen g, Functor m, Monad m) =>
  Automaton (RandT g m) a b ->
  g ->
  Automaton m a b
evalRandS :: forall g (m :: Type -> Type) a b.
(RandomGen g, Functor m, Monad m) =>
Automaton (RandT g m) a b -> g -> Automaton m a b
evalRandS Automaton (RandT g m) a b
automaton g
g = Automaton (RandT g m) a b -> g -> Automaton m a (g, b)
forall g (m :: Type -> Type) a b.
(RandomGen g, Functor m, Monad m) =>
Automaton (RandT g m) a b -> g -> Automaton m a (g, b)
runRandS Automaton (RandT g m) a b
automaton g
g Automaton m a (g, b) -> Automaton m (g, b) b -> Automaton m a b
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((g, b) -> b) -> Automaton m (g, b) b
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (g, b) -> b
forall a b. (a, b) -> b
snd