Dice roll utility made in Haskell

roll.hs

-- roll.hs a dice rolling shell utility
-- David Castellà 'kaste' <[email protected]>

import Data.List.Split
import Data.List
import Data.Char
import System.Random
import Control.Monad
import Control.Arrow
import Options.Applicative
import Data.Semigroup ((<>))

data RollMode = Single | Multiple Int | Statistic Int deriving Show

data RollOpts = RollOpts
    { optDiceCode  :: String
    , optMultiFlag :: !RollMode
    } deriving Show

data Dice = Dice {
    rolls :: Int,
    sides :: Int } deriving Show

argsToDice :: String -> Dice
argsToDice arg = Dice r s
    where [r, s] = map read $ splitOn "D" (map toUpper arg)

rollDice :: RandomGen g => Dice -> g -> Int
rollDice (Dice r s) = sum . take r . randomRs (1, s)

multipleRolls :: Int -> Dice -> IO [Int]
multipleRolls q dice = replicateM q $ fmap (rollDice dice) newStdGen

printStatistics :: [(Int, Int)] -> String
printStatistics = unlines . fmap getStatLine
    where getStatLine (val, times) = show val ++ ": " ++ show times

statisticRolls :: Int -> Dice -> IO [(Int, Int)]
statisticRolls n d = getStatistics <$> multipleRolls n d
    where getStatistics = fmap (head &&& length) . group . sort

execRoll :: RollOpts -> IO ()
execRoll (RollOpts s Single) = do
    gen <- newStdGen
    let dice = argsToDice s
        x    = rollDice dice gen
    print x
execRoll (RollOpts s (Multiple n)) = do
    let dice = argsToDice s
    x <- multipleRolls n dice
    putStrLn $ (unlines . fmap show) x
execRoll (RollOpts s (Statistic n)) = do
    let dice = argsToDice s
    x <- statisticRolls n dice
    putStrLn $ printStatistics x

main :: IO ()
main = do
    opts <- execParser optsParser
    execRoll opts
    where
        optsParser :: ParserInfo RollOpts
        optsParser = 
            info
                (helper <*> versionOption <*> programOptions)
                (fullDesc <>
                 header
                     "roll - a dice rolling console utility" <>
                 footer "[email protected] -- David Castellà <[email protected]>")
        
        versionOption :: Parser (a -> a)
        versionOption = infoOption "0.1" (long "version" <> help "Show version")

        optSingleMode :: Parser RollMode
        optSingleMode = flag' Single
            (  long "single"
            <> short 's'
            <> help "Make a ringle roll.")

        optMultipleMode :: Parser RollMode
        optMultipleMode = Multiple <$> option auto
            (  long "multiple"
            <> short 'm'
            <> metavar "ROLL_COUNT"
            <> help "Make multiple rolls.")

        optStatisticMode :: Parser RollMode
        optStatisticMode = Statistic <$> option auto
            (  long "statistic"
            <> short 't'
            <> metavar "ROLL_COUNT"
            <> help "Make multiple rolls and get the output grouped by result.")

        programOptions :: Parser RollOpts
        programOptions = RollOpts
            <$> argument str (metavar "DICE_CODE")
            <*> (optSingleMode <|> optMultipleMode <|> optStatisticMode)

Dockerfile:

FROM samdoshi/haskell-stack:latest as haskell
ENV STACK_VERSION 1.7.1
WORKDIR /app
COPY roll.hs .
RUN stack install random optparse-applicative split
RUN stack ghc -- roll.hs

FROM bitnami/minideb:jessie
COPY --from=haskell /app/roll /app/roll
RUN install_packages libgmp10
ENTRYPOINT ["/app/roll"]

run-docker.sh:

$ docker build -t roll-haskell .
$ docker run --rm -it roll-haskell --help
$ docker run --rm -it roll-haskell -s 2d6