module Roller.Types (
NumberOfDice,
NumberOfFacesOfEachDie,
DiceExpression,
maybeDiceExpressionDestructor,
constructDieTerm,
constructAddedDieTerm,
constructSubtractedDieTerm,
constructConstantTerm,
constructAddedConstantTerm,
constructSubtractedConstantTerm,
dieSymbol,
additionSymbol,
subtractionSymbol,
rolls
) where
import Control.Applicative
import Control.Monad (join, replicateM)
import Data.Word
import System.Random (randomRIO)
type NumberOfDice = Word8
type NumberOfFacesOfEachDie = Word8
dieSymbol = 'd'
additionSymbol = '+'
subtractionSymbol = '-'
diceLimit = 99
facesOfEachDieLimit = 99
constantLimit = 99
data DiceExpression =
DieTerm NumberOfDice NumberOfFacesOfEachDie
| AddedDieTerm NumberOfDice NumberOfFacesOfEachDie
| SubtractedDieTerm NumberOfDice NumberOfFacesOfEachDie
| ConstantTerm Word8
| AddedConstantTerm Word8
| SubtractedConstantTerm Word8
diceExpressionDestructor :: (NumberOfDice -> NumberOfFacesOfEachDie -> Bool) -> (NumberOfDice -> NumberOfFacesOfEachDie -> Bool) -> (NumberOfDice -> NumberOfFacesOfEachDie -> Bool) -> (Word8 -> Bool) -> (Word8 -> Bool) -> (Word8 -> Bool) -> DiceExpression -> Bool
diceExpressionDestructor dieTerm addedDieTerm subtractedDieTerm constantTerm addedConstantTerm subtractedConstantTerm x = case x of
DieTerm numberOfDice numberOfFacesOfEachDie -> dieTerm numberOfDice numberOfFacesOfEachDie
AddedDieTerm numberOfDice numberOfFacesOfEachDie -> addedDieTerm numberOfDice numberOfFacesOfEachDie
SubtractedDieTerm numberOfDice numberOfFacesOfEachDie -> subtractedDieTerm numberOfDice numberOfFacesOfEachDie
ConstantTerm n -> constantTerm n
AddedConstantTerm n -> addedConstantTerm n
SubtractedConstantTerm n -> subtractedConstantTerm n
maybeDiceExpressionDestructor :: (NumberOfDice -> NumberOfFacesOfEachDie -> Bool) -> (NumberOfDice -> NumberOfFacesOfEachDie -> Bool) -> (NumberOfDice -> NumberOfFacesOfEachDie -> Bool) -> (Word8 -> Bool) -> (Word8 -> Bool) -> (Word8 -> Bool) -> Bool-> Maybe DiceExpression -> Bool
maybeDiceExpressionDestructor dieTerm addedDieTerm subtractedDieTerm constantTerm addedConstantTerm subtractedConstantTerm nothingResult x = case x of
Just diceExpression -> diceExpressionDestructor dieTerm addedDieTerm subtractedDieTerm constantTerm addedConstantTerm subtractedConstantTerm diceExpression
Nothing -> nothingResult
instance Show DiceExpression where
show (DieTerm x y) = show x ++ show dieSymbol ++ show y
show (AddedDieTerm x y) = show additionSymbol ++ show x ++ show dieSymbol ++ show y
show (SubtractedDieTerm x y) = show subtractionSymbol ++ show x ++ show dieSymbol ++ show y
show (ConstantTerm x) = show x
show (AddedConstantTerm x) = show additionSymbol ++ show x
show (SubtractedConstantTerm x ) = show subtractionSymbol ++ show x
constructDieTerm :: NumberOfDice -> NumberOfFacesOfEachDie -> DiceExpression
constructDieTerm x y
| validateDieTermParameters x y = DieTerm x y
| otherwise = error $ dieTermLimitsErrorMessage x y
constructAddedDieTerm :: NumberOfDice -> NumberOfFacesOfEachDie -> DiceExpression
constructAddedDieTerm x y
| validateDieTermParameters x y = AddedDieTerm x y
| otherwise = error $ dieTermLimitsErrorMessage x y
constructSubtractedDieTerm :: NumberOfDice -> NumberOfFacesOfEachDie -> DiceExpression
constructSubtractedDieTerm x y
| validateDieTermParameters x y = SubtractedDieTerm x y
| otherwise = error $ dieTermLimitsErrorMessage x y
constructConstantTerm :: Word8 -> DiceExpression
constructConstantTerm x
| validateConstantTermParameter x = ConstantTerm x
| otherwise = error $ constantTermLimitErrorMessage x
constructAddedConstantTerm :: Word8 -> DiceExpression
constructAddedConstantTerm x
| validateConstantTermParameter x = AddedConstantTerm x
| otherwise = error $ constantTermLimitErrorMessage x
constructSubtractedConstantTerm :: Word8 -> DiceExpression
constructSubtractedConstantTerm x
| validateConstantTermParameter x = SubtractedConstantTerm x
| otherwise = error $ constantTermLimitErrorMessage x
validateDieTermParameters :: NumberOfDice -> NumberOfFacesOfEachDie -> Bool
validateDieTermParameters x y = x <= diceLimit && y <= facesOfEachDieLimit
validateConstantTermParameter :: Word8 -> Bool
validateConstantTermParameter x = x <= constantLimit
dieTermLimitsErrorMessage :: NumberOfDice -> NumberOfFacesOfEachDie -> String
dieTermLimitsErrorMessage x y =
"Number of dice or number of faces of each die incorrect.\n"
++ "Details:\n"
++ "Given number of dice: " ++ show x ++ " (limit: " ++ show diceLimit ++ ").\n"
++ "Given number of faces of each die: " ++ show y ++ " (limit: " ++ show facesOfEachDieLimit ++ ")."
constantTermLimitErrorMessage :: Word8 -> String
constantTermLimitErrorMessage x =
"Constat incorrect.\n"
++ "Details:\n"
++ "Given constant: " ++ show x ++ " (limit: " ++ show constantLimit ++ ")."
positiveRoll :: Word8 -> IO Integer
positiveRoll x = randomRIO $ (1, fromIntegral x)
negativeRoll :: Word8 -> IO Integer
negativeRoll x = (*(1)) <$> positiveRoll x
positiveRolls :: Word8 -> Word8 -> IO [Integer]
positiveRolls x y = replicateM (fromIntegral x) . positiveRoll $ y
negativeRolls :: Word8 -> Word8 -> IO [Integer]
negativeRolls x y = replicateM (fromIntegral x) . negativeRoll $ y
rolls :: [DiceExpression] -> IO [Integer]
rolls expressions = foldl (\x y -> (++) <$> x <*> (extractDiceExpressionValue y)) (pure []) expressions
extractDiceExpressionValue :: DiceExpression -> IO [Integer]
extractDiceExpressionValue expression =
case expression of
DieTerm x y -> positiveRolls x y
AddedDieTerm x y -> positiveRolls x y
SubtractedDieTerm x y -> negativeRolls x y
ConstantTerm x -> return [fromIntegral x]
AddedConstantTerm x -> return [fromIntegral x]
SubtractedConstantTerm x -> return [(1) * (fromIntegral x)]