diff --git a/Roller/Core.hs b/Roller/Core.hs index 456a33b..b02b8d2 100644 --- a/Roller/Core.hs +++ b/Roller/Core.hs @@ -4,37 +4,11 @@ import Roller.Types import Roller.Parse import Roller.CLI -import System.Environment (getArgs) -import System.Random (randomRIO) import Control.Applicative import Control.Monad (join, replicateM, replicateM_) +import System.Environment (getArgs) import Data.Word -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)] - rollEm :: CLI (IO ()) rollEm verbose n args = maybe parseFail rollMany (parse input) where diff --git a/Roller/Parse.hs b/Roller/Parse.hs index 672e7d2..2d99e8e 100644 --- a/Roller/Parse.hs +++ b/Roller/Parse.hs @@ -15,22 +15,22 @@ naturalNumber :: RE Char Word8 naturalNumber = read <$> some (psym isDigit) dieTerm :: RE Char DiceExpression -dieTerm = DieTerm <$> naturalNumber <* sym dieSymbol <*> naturalNumber +dieTerm = constructDieTerm <$> naturalNumber <* sym dieSymbol <*> naturalNumber addedDieTerm :: RE Char DiceExpression -addedDieTerm = AddedDieTerm <$> (sym additionSymbol *> naturalNumber) <* sym dieSymbol <*> naturalNumber +addedDieTerm = constructAddedDieTerm <$> (sym additionSymbol *> naturalNumber) <* sym dieSymbol <*> naturalNumber subtractedDieTerm :: RE Char DiceExpression -subtractedDieTerm = SubtractedDieTerm <$> (sym subtractionSymbol *> naturalNumber) <* sym dieSymbol <*> naturalNumber +subtractedDieTerm = constructSubtractedDieTerm <$> (sym subtractionSymbol *> naturalNumber) <* sym dieSymbol <*> naturalNumber constantTerm :: RE Char DiceExpression -constantTerm = ConstantTerm <$> naturalNumber +constantTerm = constructConstantTerm <$> naturalNumber addedConstantTerm :: RE Char DiceExpression -addedConstantTerm = AddedConstantTerm <$> (sym additionSymbol *> naturalNumber) +addedConstantTerm = constructAddedConstantTerm <$> (sym additionSymbol *> naturalNumber) subtractedConstantTerm :: RE Char DiceExpression -subtractedConstantTerm = SubtractedConstantTerm <$> (sym subtractionSymbol *> naturalNumber) +subtractedConstantTerm = constructSubtractedConstantTerm <$> (sym subtractionSymbol *> naturalNumber) diceExpression :: RE Char [DiceExpression] diceExpression = (:) <$> term <*> many signedTerm where diff --git a/Roller/Types.hs b/Roller/Types.hs index f70464c..198da87 100644 --- a/Roller/Types.hs +++ b/Roller/Types.hs @@ -1,9 +1,27 @@ --- Dice notation taken from: +-- Dice notation: -- https://en.wikipedia.org/wiki/Dice_notation -module Roller.Types where +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 @@ -11,6 +29,9 @@ type NumberOfFacesOfEachDie = Word8 dieSymbol = 'd' additionSymbol = '+' subtractionSymbol = '-' +diceLimit = 99 +facesOfEachDieLimit = 99 +constantLimit = 99 data DiceExpression = DieTerm NumberOfDice NumberOfFacesOfEachDie @@ -20,6 +41,20 @@ data DiceExpression = | 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 @@ -27,3 +62,77 @@ instance Show DiceExpression where 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)] diff --git a/Tests/ParseTests.hs b/Tests/ParseTests.hs index f9e9319..e6101a4 100644 --- a/Tests/ParseTests.hs +++ b/Tests/ParseTests.hs @@ -1,3 +1,5 @@ +module Main where + import Roller.Types import Roller.Parse @@ -7,19 +9,21 @@ import Text.Regex.Applicative newtype NumericalTextGenerator = NumericalTextGenerator String deriving Show newtype CorrectDieTermGenerator = CorrectDieTermGenerator String deriving Show +newtype IncorrectNumberOfDiceDieTermGenerator = IncorrectNumberOfDiceDieTermGenerator String deriving Show instance Arbitrary NumericalTextGenerator where arbitrary = NumericalTextGenerator <$> generateNumberText instance Arbitrary CorrectDieTermGenerator where arbitrary = CorrectDieTermGenerator <$> generateCorrectDieTerm +instance Arbitrary IncorrectNumberOfDiceDieTermGenerator where arbitrary = IncorrectNumberOfDiceDieTermGenerator <$> generateIncorrectNumberOfDiceDieTerm main :: IO () main = do - print $ "Verify parse natural number given numerical text." + print "Verify parse natural number given numerical text." quickCheck prop_ParseNaturalNumberGivenNumericalText - print $ "Verify parse natural number given nonnumerical text." + print "Verify parse natural number given nonnumerical text." quickCheck prop_ParseNaturalNumberGivenNonnumericalText - print $ "Verify parse Die Term given correct die term text." + print "Verify parse Die Term given correct die term text." quickCheck prop_ParseDieTermGivenCorrectDieTermText generateDigit :: Gen Char @@ -31,12 +35,18 @@ generateNumberText = listOf1 generateDigit generateCorrectNumberOfDiceText :: Gen String generateCorrectNumberOfDiceText = resize 2 $ listOf1 generateDigit +generateIncorrectNumberOfDiceText :: Gen String +generateIncorrectNumberOfDiceText = suchThat (listOf1 generateDigit) (\x -> length x > 2) + generateCorrectNumberOfFacesOfEachDieText :: Gen String generateCorrectNumberOfFacesOfEachDieText = resize 2 $ listOf1 generateDigit generateCorrectDieTerm :: Gen String generateCorrectDieTerm = (++) <$> generateCorrectNumberOfDiceText <*> ((:) <$> pure 'd' <*> generateCorrectNumberOfFacesOfEachDieText) +generateIncorrectNumberOfDiceDieTerm :: Gen String +generateIncorrectNumberOfDiceDieTerm = (++) <$> generateIncorrectNumberOfDiceText <*> ((:) <$> pure 'd' <*> generateCorrectNumberOfFacesOfEachDieText) + prop_ParseNaturalNumberGivenNumericalText :: NumericalTextGenerator -> Bool prop_ParseNaturalNumberGivenNumericalText (NumericalTextGenerator text) = case (text =~ naturalNumber) of @@ -47,16 +57,22 @@ prop_ParseNaturalNumberGivenNonnumericalText :: String -> Property prop_ParseNaturalNumberGivenNonnumericalText text = containsNoDigits text ==> case (text =~ naturalNumber) of - Just x -> False + Just _ -> False Nothing -> True where containsNoDigits x = (foldl (\y z -> if y == 0 && z `elem` x then y + 1 else y) 0 ['0' .. '9']) == 0 -prop_ParseDieTermGivenCorrectDieTermText :: CorrectDieTermGenerator -> Property +prop_ParseDieTermGivenCorrectDieTermText :: CorrectDieTermGenerator -> Bool prop_ParseDieTermGivenCorrectDieTermText (CorrectDieTermGenerator text) = - collect text $ - collect (show (text =~ dieTerm)) $ - True ==> - case (text =~ dieTerm) of - Just (DieTerm x y) -> True - Nothing -> False + maybeDiceExpressionDestructor + (\numberOfDice numberOfFacesOfEachDie -> numberOfDice >= 0 && numberOfDice <= 99 && numberOfFacesOfEachDie >= 0 && numberOfFacesOfEachDie <= 99) + ignoredDieTerm + ignoredDieTerm + ignoredConstantTerm + ignoredConstantTerm + ignoredConstantTerm + False + (text =~ dieTerm) + where + ignoredDieTerm = \_ _ -> False + ignoredConstantTerm = \_ -> False diff --git a/Tests/TypesTests.hs b/Tests/TypesTests.hs index 86e8c8f..a5f2aad 100644 --- a/Tests/TypesTests.hs +++ b/Tests/TypesTests.hs @@ -1,5 +1,6 @@ import Roller.Types +import Control.Applicative import Data.Word import Test.QuickCheck @@ -23,20 +24,41 @@ main = do print $ "Verify show SubtractedConstantTerm." quickCheck prop_ShowSubtractedConstantTerm -prop_ShowDieTerm :: Word8 -> Word8 -> Bool -prop_ShowDieTerm x y = show (DieTerm x y) == show x ++ show dieSymbol ++ show y +prop_ShowDieTerm :: CorrectNumberOfDiceGenerator -> CorrectNumberOfFacesOfEachDieGenerator -> Bool +prop_ShowDieTerm (CorrectNumberOfDiceGenerator x) (CorrectNumberOfFacesOfEachDieGenerator y) = + show (constructDieTerm x y) == show x ++ show dieSymbol ++ show y -prop_ShowAddedDieTerm :: Word8 -> Word8 -> Bool -prop_ShowAddedDieTerm x y = show (AddedDieTerm x y) == show additionSymbol ++ show x ++ show dieSymbol ++ show y +prop_ShowAddedDieTerm :: CorrectNumberOfDiceGenerator -> CorrectNumberOfFacesOfEachDieGenerator -> Bool +prop_ShowAddedDieTerm (CorrectNumberOfDiceGenerator x) (CorrectNumberOfFacesOfEachDieGenerator y) = + show (constructAddedDieTerm x y) == show additionSymbol ++ show x ++ show dieSymbol ++ show y -prop_ShowSubtractedDieTerm :: Word8 -> Word8 -> Bool -prop_ShowSubtractedDieTerm x y = show (SubtractedDieTerm x y) == show subtractionSymbol ++ show x ++ show dieSymbol ++ show y +prop_ShowSubtractedDieTerm :: CorrectNumberOfDiceGenerator -> CorrectNumberOfFacesOfEachDieGenerator -> Bool +prop_ShowSubtractedDieTerm (CorrectNumberOfDiceGenerator x) (CorrectNumberOfFacesOfEachDieGenerator y) = + show (constructSubtractedDieTerm x y) == show subtractionSymbol ++ show x ++ show dieSymbol ++ show y -prop_ShowConstantTerm :: Word8 -> Bool -prop_ShowConstantTerm x = show (ConstantTerm x) == show x +prop_ShowConstantTerm :: CorrectConstatntGenerator -> Bool +prop_ShowConstantTerm (CorrectConstatntGenerator x) = show (constructConstantTerm x) == show x -prop_ShowAddedConstantTerm :: Word8 -> Bool -prop_ShowAddedConstantTerm x = show (AddedConstantTerm x) == show additionSymbol ++ show x +prop_ShowAddedConstantTerm :: CorrectConstatntGenerator -> Bool +prop_ShowAddedConstantTerm (CorrectConstatntGenerator x) = show (constructAddedConstantTerm x) == show additionSymbol ++ show x -prop_ShowSubtractedConstantTerm :: Word8 -> Bool -prop_ShowSubtractedConstantTerm x = show (SubtractedConstantTerm x) == show subtractionSymbol ++ show x +prop_ShowSubtractedConstantTerm :: CorrectConstatntGenerator -> Bool +prop_ShowSubtractedConstantTerm (CorrectConstatntGenerator x) = show (constructSubtractedConstantTerm x) == show subtractionSymbol ++ show x + +newtype CorrectNumberOfDiceGenerator = CorrectNumberOfDiceGenerator NumberOfDice deriving Show +instance Arbitrary CorrectNumberOfDiceGenerator where arbitrary = CorrectNumberOfDiceGenerator <$> generateCorrectNumberOfDice + +generateCorrectNumberOfDice :: Gen Word8 +generateCorrectNumberOfDice = elements [0 .. 99] + +newtype CorrectNumberOfFacesOfEachDieGenerator = CorrectNumberOfFacesOfEachDieGenerator NumberOfFacesOfEachDie deriving Show +instance Arbitrary CorrectNumberOfFacesOfEachDieGenerator where arbitrary = CorrectNumberOfFacesOfEachDieGenerator <$> generateCorrectNumberOfFacesOfEachDie + +generateCorrectNumberOfFacesOfEachDie :: Gen Word8 +generateCorrectNumberOfFacesOfEachDie = elements [0 .. 99] + +newtype CorrectConstatntGenerator = CorrectConstatntGenerator Word8 deriving Show +instance Arbitrary CorrectConstatntGenerator where arbitrary = CorrectConstatntGenerator <$> generateCorrectConstant + +generateCorrectConstant :: Gen Word8 +generateCorrectConstant = elements [0 .. 99] diff --git a/roller.cabal b/roller.cabal index f81db7d..945f632 100644 --- a/roller.cabal +++ b/roller.cabal @@ -8,7 +8,7 @@ license: GPL-2 license-file: LICENSE author: Piotr Justyna maintainer: piotr.justyna@gmail.com -copyright: (c) 2015 Piotr Justyna +copyright: (c) 2016 Piotr Justyna category: ACME build-type: Simple cabal-version: >= 1.10 @@ -22,7 +22,7 @@ library Roller.Types, Roller.Parse, Roller.CLI - build-depends: base >= 4.6.0.1 && < 4.9, + build-depends: base >= 4.6.0.1, random >= 1.0.1, regex-applicative >= 0.3, optparse-applicative >= 0.11.0