```-- | Representation of probabilities and random computations.
module Game.LambdaHack.Common.Random
( -- * The @Rng@ monad
Rnd
-- * Random operations
, randomR, random, oneOf, frequency
-- * Fractional chance
, Chance, chance
-- * Casting dice scaled with level
, castDice, chanceDice, castDiceXY
, foldrM, foldlM'
#ifdef EXPOSE_INTERNAL
-- * Internal operations
, rollFreq
#endif
) where

import Prelude ()

import Game.LambdaHack.Common.Prelude

import           Data.Ratio
import qualified System.Random as R

import qualified Game.LambdaHack.Common.Dice as Dice
import           Game.LambdaHack.Common.Frequency

-- | The monad of computations with random generator state.
type Rnd a = St.State R.StdGen a

-- | Get a random object within a range with a uniform distribution.
randomR :: (R.Random a) => (a, a) -> Rnd a
{-# INLINE randomR #-}
randomR = St.state . R.randomR

-- | Get a random object of a given type with a uniform distribution.
random :: (R.Random a) => Rnd a
{-# INLINE random #-}
random = St.state R.random

-- | Get any element of a list with equal probability.
oneOf :: [a] -> Rnd a
oneOf [] = error \$ "oneOf []" `showFailure` ()
oneOf [x] = return x
oneOf xs = do
r <- randomR (0, length xs - 1)
return \$! xs !! r

-- | Gen an element according to a frequency distribution.
frequency :: Show a => Frequency a -> Rnd a
{-# INLINE frequency #-}
frequency = St.state . rollFreq

-- | Randomly choose an item according to the distribution.
rollFreq :: Show a => Frequency a -> R.StdGen -> (a, R.StdGen)
rollFreq fr g = case runFrequency fr of
[] -> error \$ "choice from an empty frequency"
`showFailure` nameFrequency fr
[(n, x)] | n <= 0 -> error \$ "singleton void frequency"
`showFailure` (nameFrequency fr, n, x)
[(_, x)] -> (x, g)  -- speedup
fs -> let sumf = foldl' (\ !acc (!n, _) -> acc + n) 0 fs
(r, ng) = R.randomR (1, sumf) g
frec :: Int -> [(Int, a)] -> a
frec !m [] = error \$ "impossible roll"
`showFailure` (nameFrequency fr, fs, m)
frec m ((n, x) : _) | m <= n = x
frec m ((n, _) : xs) = frec (m - n) xs
in assert (sumf > 0 `blame` "frequency with nothing to pick"
`swith` (nameFrequency fr, fs))
(frec r fs, ng)

-- | Fractional chance.
type Chance = Rational

-- | Give @True@, with probability determined by the fraction.
chance :: Chance -> Rnd Bool
chance r = do
let n = numerator r
d = denominator r
k <- randomR (1, d)
return (k <= n)

-- | Cast dice scaled with current level depth.
-- Note that at the first level, the scaled dice are always ignored.
castDice :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.Dice -> Rnd Int
castDice = Dice.castDice randomR

-- | Cast dice scaled with current level depth and return @True@
-- if the results is greater than 50.
chanceDice :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.Dice -> Rnd Bool
chanceDice ldepth totalDepth dice = do
c <- castDice ldepth totalDepth dice
return \$! c > 50

-- | Cast dice, scaled with current level depth, for coordinates.
castDiceXY :: Dice.AbsDepth -> Dice.AbsDepth -> Dice.DiceXY -> Rnd (Int, Int)
castDiceXY ldepth totalDepth (Dice.DiceXY dx dy) = do
x <- castDice ldepth totalDepth dx
y <- castDice ldepth totalDepth dy
return (x, y)

foldrM :: Foldable t => (a -> b -> Rnd b) -> b -> t a -> Rnd b
foldrM f z0 xs = let f' x (z, g) = St.runState (f x z) g
in St.state \$ \g -> foldr f' (z0, g) xs

foldlM' :: Foldable t => (b -> a -> Rnd b) -> b -> t a -> Rnd b
foldlM' f z0 xs = let f' (z, g) x = St.runState (f z x) g
in St.state \$ \g -> foldl' f' (z0, g) xs
```