-- | This module exports the CoinGen data type and functions for flipping Coins
--   to generate random boolean values via balanced tables randomized by the
--   RealDice data or custom boolean tables
module RealDice.Coin (CoinGen, flipCoin, mkCoinGen, mkCoinGenCustom) where

import RealDice.Generate.BalancedTables (rdBoolsPrime)
import RealDice.Manipulate.GetValueFromRNGTable (getBoolByIndex)

-- | Stores a balanced table of random boolean values and an index pointing to
--   the next value to return
data CoinGen where
  CoinGen :: {CoinGen -> Int
index :: Int, CoinGen -> [Bool]
boolTable :: [Bool]} -> CoinGen

-- | Creates a new CoinGen with the given index and the default bool table

-- | ==== __Examples__
--   >>> mkCoinGen 143
--   {143, rdBoolsPrime}
mkCoinGen :: Int -> CoinGen
mkCoinGen :: Int -> CoinGen
mkCoinGen Int
i = Int -> [Bool] -> CoinGen
mkCoinGenCustom Int
i [Bool]
rdBoolsPrime

-- | Creates a new CoinGen with the given index and bool table

-- | Defaults to the RealDice balanced table of random booleans if an empty
--   list is given

-- | ==== __Examples__
--   >>> mkCoinGenCustom 143 [True, False, False, True, True]
--   {143, [True, False, False, True, True]}
--   >>> mkCoinGenCustom 143 []
--   {143, rdBoolsPrime}
mkCoinGenCustom :: Int -> [Bool] -> CoinGen
mkCoinGenCustom :: Int -> [Bool] -> CoinGen
mkCoinGenCustom Int
i [] = CoinGen {index :: Int
index = Int
i, boolTable :: [Bool]
boolTable = [Bool]
rdBoolsPrime}
mkCoinGenCustom Int
i [Bool]
table = CoinGen {index :: Int
index = Int
i, boolTable :: [Bool]
boolTable = [Bool]
table}

-- | Generates a random boolean value via a simple table lookup

-- | ==== __Examples__
--   >>> flipCoin (mkDieGen 143)
--   (False, {144, rdBoolsPrime})
flipCoin :: CoinGen -> (Bool, CoinGen)
flipCoin :: CoinGen -> (Bool, CoinGen)
flipCoin CoinGen
coin =
  ( Int -> [Bool] -> Bool
getBoolByIndex (CoinGen -> Int
index CoinGen
coin) (CoinGen -> [Bool]
boolTable CoinGen
coin),
    CoinGen {index :: Int
index = CoinGen -> Int
index CoinGen
coin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, boolTable :: [Bool]
boolTable = CoinGen -> [Bool]
boolTable CoinGen
coin}
  )