```-- | A list of items with relative frequencies of appearance.
module Game.LambdaHack.Utils.Frequency
( -- * The @Frequency@ type
Frequency
-- * Construction
, uniformFreq, toFreq
-- * Transformation
, scaleFreq, filterFreq
-- * Consumption
, rollFreq, nullFreq, runFrequency
) where

import qualified System.Random as R

import Game.LambdaHack.Utils.Assert

-- TODO: do not expose runFrequency
-- | The frequency distribution type.
data Frequency a = Frequency
{ _name        :: String      -- ^ short description for debug, etc.
, runFrequency :: [(Int, a)]  -- ^ give acces to raw frequency values
}
deriving Show

return x = Frequency "return" [(1, x)]
Frequency name xs >>= f =
Frequency ("bind (" ++ name ++ ")")
[(p * q, y) | (p, x) <- xs,
(q, y) <- runFrequency (f x) ]

mplus (Frequency xname xs) (Frequency yname ys) =
Frequency ("mplus (" ++ xname ++ ") (" ++ yname ++ ")")
(xs ++ ys)
mzero = Frequency "mzero" []

instance Functor Frequency where
fmap f (Frequency name xs) = Frequency name (map (\ (p, x) -> (p, f x)) xs)

-- | Uniform discrete frequency distribution.
uniformFreq :: String -> [a] -> Frequency a
uniformFreq name = Frequency name . map (\ x -> (1, x))

-- | Takes a name and a list of frequencies and items
-- into the frequency distribution.
toFreq :: String -> [(Int, a)] -> Frequency a
toFreq = Frequency

-- | Scale frequecy distribution, multiplying it
-- by a positive integer constant.
scaleFreq :: Show a => Int -> Frequency a -> Frequency a
scaleFreq n (Frequency name xs) =
assert (n > 0 `blame` ("negative scale for " ++ name, n, xs)) \$
Frequency name (map (\ (p, x) -> (n * p, x)) xs)

-- | Leave only items that satisfy a predicate.
filterFreq :: (a -> Bool) -> Frequency a -> Frequency a
filterFreq p (Frequency name l) =
Frequency ("filterFreq (" ++ name ++ ")")
(filter (p . snd) l)

-- | Randomly choose an item according to the distribution.
rollFreq :: Show a => Frequency a -> R.StdGen -> (a, R.StdGen)
rollFreq (Frequency name []) _ =
assert `failure` ("choice from an empty frequency: " ++ name)
rollFreq (Frequency name [(n, x)]) _ | n <= 0 =
assert `failure` ("singleton frequency with nothing to pick: " ++ name, n, x)
rollFreq (Frequency _ [(_, x)]) g = (x, g)  -- speedup
rollFreq (Frequency name fs) g =
assert (sumf > 0 `blame` ("frequency with nothing to pick: " ++ name, fs)) \$
(frec r fs, ng)
where
sumf = sum (map fst fs)
(r, ng) = R.randomR (1, sumf) g
frec :: Int -> [(Int, a)] -> a
frec m []                     = assert `failure` ("impossible", name, fs, m)
frec m ((n, x) : _)  | m <= n = x
frec m ((n, _) : xs)          = frec (m - n) xs

-- | Test if the frequency distribution is empty.
nullFreq :: Frequency a -> Bool
nullFreq fr = null \$ runFrequency fr
```