Haskell Quiz/Dice Roller/Solution Abhinav
< Haskell Quiz | Dice Roller
Jump to navigation
Jump to search
{-
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 <abhinav@abhinavsarkar.net>
-}
{-# 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 <expr> [<times>]")
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 ()
Description: The program uses Parsec for parsing the expression into an AST and then evaluates it recursively to get the value.
Source: https://github.com/abhin4v/rubyquiz/blob/master/DiceRoller.hs