roller 0.1.6 → 0.1.7
raw patch · 5 files changed
+129/−49 lines, 5 files
Files
- Roller.hs +0/−8
- Roller/Core.hs +1/−27
- Roller/Parse.hs +15/−10
- Roller/Types.hs +111/−2
- roller.cabal +2/−2
Roller.hs view
@@ -4,11 +4,3 @@ main :: IO () main = Roller.main---- Build with:------ Windows:--- ghc -package-db=.cabal-sandbox\x86_64-windows-ghc-7.10.2-packages.conf.d Roller.hs------ Linux:--- ghc -package-db=.cabal-sandbox/x86_64-linux-ghc-7.8.3-packages.conf.d Roller.hs -o roller
Roller/Core.hs view
@@ -4,36 +4,10 @@ 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)
Roller/Parse.hs view
@@ -1,4 +1,9 @@-module Roller.Parse (parse) where+module Roller.Parse+(+ parse,+ naturalNumber,+ dieTerm+) where import Roller.Types @@ -10,29 +15,29 @@ 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) -diceExpression1 :: RE Char [DiceExpression]-diceExpression1 = (:) <$> term <*> many signedTerm where+diceExpression :: RE Char [DiceExpression]+diceExpression = (:) <$> term <*> many signedTerm where term = dieTerm <|> constantTerm signedTerm = signedDieTerm <|> signedConstantTerm signedDieTerm = addedDieTerm <|> subtractedDieTerm signedConstantTerm = addedConstantTerm <|> subtractedConstantTerm parse :: String -> Maybe [DiceExpression]-parse x = filter (not . isSpace) x =~ diceExpression1+parse x = filter (not . isSpace) x =~ diceExpression
Roller/Types.hs view
@@ -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 @@ dieSymbol = 'd' additionSymbol = '+' subtractionSymbol = '-'+diceLimit = 99+facesOfEachDieLimit = 99+constantLimit = 99 data DiceExpression = DieTerm NumberOfDice NumberOfFacesOfEachDie@@ -20,6 +41,20 @@ | 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 @@ 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)]
roller.cabal view
@@ -1,5 +1,5 @@ name: roller-version: 0.1.6+version: 0.1.7 synopsis: Playing with applicatives and dice! description: A basic library and program for simulated rolling of polyhedral dice, as would be used in pen and paper RPGs.@@ -8,7 +8,7 @@ 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