diff --git a/DiceRoller.hs b/DiceRoller.hs new file mode 100644 index 0000000..b153589 --- /dev/null +++ b/DiceRoller.hs @@ -0,0 +1,113 @@ +{- + A solution to rubyquiz 61 (http://rubyquiz.com/quiz61.html). + + The task for this Quiz is to write a dice roller. The program should take + two arguments: a dice expression followed by the number of times to roll it + (being optional, with a default of 1). + + The solution is done using Parsec for parsing the expression into an AST and + then evaluating it recursively. + + Usage: bin/DiceRoller "(5d5-4)d(16/d4)+3" 10 + bin/DiceRoller 3d3 + + Copyright 2012 Abhinav Sarkar +-} + +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Main (main) where + +import Control.Applicative ((<$>), (<*), (*>), (<|>)) +import Control.Monad (foldM, liftM2, liftM, when) +import Control.Monad.State (State, get, put, runState) +import System.Random (Random, StdGen, randomR, newStdGen) +import Text.Parsec (many1, digit, spaces, char, parse) +import Text.Parsec.Expr (Assoc(..), Operator(..), buildExpressionParser) +import System.Environment (getArgs) + +-- Randomness setup for dice roll -- + +type RandomState = State StdGen + +getRandomR :: Random a => (a, a) -> RandomState a +getRandomR limits = do + gen <- get + let (val, gen') = randomR limits gen + put gen' + return val + +-- AST -- + +-- Expression AST types +data Expr = Lit Int | -- An integer literal + Add Expr Expr | -- Binary addition + Sub Expr Expr | -- Binary subtraction + Mul Expr Expr | -- Binary multiplication + Div Expr Expr | -- Binary integer division + Rol Expr | -- Unary single dice roll + MRol Expr Expr -- Binary multiple dice rolls + deriving (Show) + +-- Recursively evaluates the AST to get its value +eval :: Expr -> RandomState Int +eval (Lit i) = return i +eval (Add e1 e2) = liftM2 (+) (eval e1) (eval e2) +eval (Sub e1 e2) = liftM2 (-) (eval e1) (eval e2) +eval (Mul e1 e2) = liftM2 (*) (eval e1) (eval e2) +eval (Div e1 e2) = liftM2 div (eval e1) (eval e2) + +-- Evaluates sides and choose a random number between 1 and sides +eval (Rol sides) = eval sides >>= \s -> getRandomR (1, s) + +-- Evaluates dices and sides and accumulates over choosing random numbers between +-- 1 and sides, dice times +eval (MRol dices sides) = do + d <- eval dices + s <- eval sides + foldM (\sum _ -> liftM (sum +) $ getRandomR (1, s)) 0 [1..d] + +-- Parsers -- + +-- A parser that modifies the argument parser to accept whitespace after it +spaced = (<* spaces) + +-- A parser to parse the integer literals +literal = (Lit . read) <$> spaced (many1 digit) + +-- A parse to parse a factor, where a factor is either a literal or an expression +-- enclosed in brackets +factor = spaced (char '(') *> spaced expr <* spaced (char ')') + <|> literal + +-- Operators table in descending order of precedence +table = [[uop 'd' Rol], -- single roll + [bop 'd' MRol AssocLeft], -- multiple rolls + [bop '*' Mul AssocLeft, bop '/' Div AssocLeft], -- multiplication and division + [bop '+' Add AssocLeft, bop '-' Sub AssocLeft]] -- addition and subtraction + where bop c f = Infix (spaced (char c) *> return f) -- binary operators + uop c f = Prefix (spaced (char c) *> return f) -- unary operators + +-- A parser to parse the full expression +expr = buildExpressionParser table factor + +-- Main -- + +-- Reads the expression from program arguments, parses it and if successful, +-- evaluates the AST and displays the resultant values +main = do + args <- getArgs + when (null args) (error "Usage: DiceRoller []") + + let (str, times) = if length args == 1 then (head args, 1) else (args !! 0, read $ args !! 1) + + case parse expr "DiceRollParser" str of + Left err -> putStrLn $ "Error while parsing: " ++ show err + Right ast -> do + g <- newStdGen + foldM (\g' _ -> do + let (val, g'') = runState (eval ast) g' + putStr $ show val ++ " " + return g'') + g [1 .. times] + return () diff --git a/rubyquiz.cabal b/rubyquiz.cabal index e1982ce..c8b07c0 100644 --- a/rubyquiz.cabal +++ b/rubyquiz.cabal @@ -93,7 +93,14 @@ executable SudokuSolver executable NumericMaze build-depends : base == 4.*, containers == 0.4.*, - mtl == 2.1.*, pqueue == 1.2.* main-is : NumericMaze.hs + default-language : Haskell2010 + +executable DiceRoller + build-depends : base == 4.*, + mtl == 2.1.*, + random == 1.0.*, + parsec == 3.1.* + main-is : DiceRoller.hs default-language : Haskell2010 \ No newline at end of file