Dice roller script

ddd-roller.fsx

open System
open System.Text.RegularExpressions

type Operation =
    | Add
    | Subtract

type Dice = { Amount: int; Sides: int }

type Modification =
    | Dice of dice: Dice
    | Value of value: int

type RollDescription =
    { Dice: Dice
      Modifiers: Operation * Modification list }

type RolledDice = { Sides: int; Rolls: int list }

type CalculatedModifications =
    | Dice of dice: RolledDice
    | Value of value: int


let rnd = Random(int DateTime.Now.Ticks)
let roll dice =
    [ 1 .. dice.Amount ] |> List.map (fun _ -> rnd.Next(1, dice.Sides + 1))

let calculateModification =
    function
    | Modification.Value value -> CalculatedModifications.Value value
    | Modification.Dice dice ->
        let rolls = roll dice
        CalculatedModifications.Dice { Sides = dice.Sides; Rolls = rolls }

let calculateTotal initialRoll =
    Seq.fold
        (fun acc (op, modifier) ->
            let result =
                match modifier with
                | Dice dice -> dice.Rolls |> List.sum
                | Value value -> value

            match op with
            | Add -> acc + result
            | Subtract -> acc - result)
        (initialRoll |> List.sum)

let printModifiers =
    Seq.map (fun (op, modifier) ->
        let operation =
            match op with
            | Add -> " + "
            | Subtract -> " - "

        match modifier with
        | Dice dice -> operation + String.Join(operation, dice.Rolls)
        | Value value -> $"{operation}{value}")
    >> fun result -> String.Join("", result)

let regexOptions = RegexOptions.IgnoreCase ||| RegexOptions.Compiled
let dieRegex = Regex(@"(?<amount>\d*)[d](?<sides>\d+)", regexOptions)
let createDice description =
    let matches = dieRegex.Match(description)
    let amount = matches.Groups["amount"].Value
    let amount = if String.IsNullOrEmpty amount then 1 else int amount
    let sides = int matches.Groups["sides"].Value
    { Amount = amount; Sides = sides }

let modifierRegex = Regex(@"[ ]*(?<sign>[+-])[ ]*((?<dice>\d*[d]\d+)|(?<val>\d+))", regexOptions)
let createModifiers description =
    let modifierMatch = modifierRegex.Match(description)

    let operation =
        match modifierMatch.Groups["sign"].Value with
        | "+" -> Add
        | "-" -> Subtract
        | _ -> failwith $"""invalid modifier: {modifierMatch.Groups["sign"].Value}"""

    let modifier =
        match modifierMatch.Groups["dice"].Value with
        | "" -> Modification.Value(int modifierMatch.Groups["val"].Value)
        | _ -> Modification.Dice(createDice modifierMatch.Groups["dice"].Value)

    operation, modifier

let rollRegex = Regex(@"(?<dice>\d*[d]\d+){1}(?<mod>[ ]*[+-][ ]*(\d*[d]\d+|\d+))*", regexOptions)
let rec rollDice () =
    printf "describe roll: "
    let input = Console.ReadLine()

    if not <| (input = "quit" || input = "q") then
        let ``match`` = rollRegex.Match(input)

        if ``match``.Success then
            let dice = createDice ``match``.Groups["dice"].Value
            let initialRoll = roll dice

            let modifiers =
                ``match``.Groups["mod"].Captures
                |> Seq.toList
                |> List.map (fun m -> createModifiers m.Value)
                |> List.map (fun (op, modifier) -> op, calculateModification modifier)

            let total = calculateTotal initialRoll modifiers

            printf $"rolled: {total}"
            Console.ForegroundColor <- ConsoleColor.DarkGray
            printfn $""" >> {String.Join(" + ", initialRoll)}{modifiers |> printModifiers}"""
            Console.ResetColor()
        else
            Console.ForegroundColor <- ConsoleColor.Red
            printfn "invalid roll"
            printfn "roll declaration must be in the form of: 2d20 + 5d6 - 2"
            Console.ResetColor()

        rollDice ()

printfn "welcome to the dice roller!"
printfn "type 'quit' or 'q' to exit"

rollDice ()

printfn "goodbye!"

roller-fparsec.fsx

#r "nuget: FParsec-Big-Data-Edition"

open System
open FParsec

type Dice =
    | Dice of count: int * sides: int
    | Value of int

type RolledDice =
    | RolledDice of sides: int * rolls: int list
    | Value of int

type Expression<'a> =
    | First of 'a
    | Plus of 'a
    | Minus of 'a

let map f =
    function
    | First x -> First(f x)
    | Plus x -> Plus(f x)
    | Minus x -> Minus(f x)

let random = Random(int DateTime.Now.Ticks)

let value = pint32 |>> Dice.Value

let dice = attempt ((pint32 <|>% 1 .>> pchar 'd' .>>. pint32) |>> Dice.Dice)

let term = choice [ dice; value ]

let modifier =
    choice
        [ attempt (spaces >>. pchar '+' .>> spaces >>. term |>> Plus)
          attempt (spaces >>. pchar '-' .>> spaces >>. term |>> Minus) ]

let parser = pipe2 (term |>> First) (many modifier) (fun head tail -> head :: tail)


let evaluate =
    let roll =
        function
        | Dice.Dice(count, sides) ->
            let rolls = List.init count (fun _ -> random.Next(1, sides + 1))
            RolledDice(sides, rolls)
        | Dice.Value value -> Value value

    List.map (map roll)

let rec parseAndEvaluate () =
    printf "describe roll: "
    let input = Console.ReadLine()

    if not <| (input = "quit" || input = "q") then
        run parser input
        |> function
            | Success(result, _, _) -> Result.Ok(evaluate result)
            | Failure(message, _, _) -> Result.Error message
        |> function
            | Result.Ok result ->
                let total =
                    let sumDice =
                        function
                        | RolledDice(_, rolls) -> rolls |> List.sum
                        | Value value -> value

                    result
                    |> List.sumBy (function
                        | First value -> sumDice value
                        | Plus value -> sumDice value
                        | Minus value -> sumDice value * -1)

                printf $"total: {total}"
                Console.ForegroundColor <- ConsoleColor.DarkGray
                printf " >> "

                let plus = " + "
                let minus = " - "

                let format rolledDice =
                    match rolledDice with
                    | RolledDice(sides, rolls) -> $"""d{sides}({String.Join(plus, rolls |> List.map string)})"""
                    | Value value -> value |> string

                result
                |> List.iter (function
                    | First roll -> printf $"{format roll}"
                    | Plus roll -> printf $"{plus}{format roll}"
                    | Minus roll -> printf $"{minus}{format roll}")

                printfn ""
                Console.ResetColor()
            | Result.Error message ->
                Console.ForegroundColor <- ConsoleColor.Red
                printfn $"error: {message}"
                printfn "type 'quit' or 'q' to exit"
                printfn "provide rolls in the format: 1d6 + 2 - 3d10 + 2d8 - 6"
                Console.ResetColor()

        parseAndEvaluate ()

printfn "welcome to the dice roller!"
printfn "type 'quit' or 'q' to exit"

parseAndEvaluate ()

printfn "goodbye!"

roller.fsx

open System
open System.Text.RegularExpressions

let regexOptions = RegexOptions.IgnoreCase ||| RegexOptions.Compiled

let rollDice (sides: int) =
    let rnd = Random(int DateTime.Now.Ticks)
    rnd.Next(1, sides + 1)

let parseDice (diceDescription: string) =
    let regex = Regex(@"(?<count>\d*)[d](?<sides>\d+)", regexOptions)
    let matches = regex.Match(diceDescription)

    if matches.Success then
        let count = matches.Groups["count"].Value
        let count = if count = String.Empty then 1 else int count
        let sides = int matches.Groups["sides"].Value
        [ for i in 1..count -> rollDice sides ]
    else
        failwith $"invalid dice description: {matches.Value}"

let rec parseMod (modDescriptions: Capture list) =
    let regex =
        Regex(@"[ ]*(?<sign>[+-])[ ]*(?<dice>\d*[d]\d+|(?<val>\d+))", regexOptions)

    match modDescriptions with
    | modifier :: rest ->
        regex.Match(modifier.Value)
        |> fun matches ->
            if matches.Success then
                let isAdd = matches.Groups["sign"].Value = "+"
                let dice = matches.Groups["dice"].Value
                let value = matches.Groups["val"].Value

                let values =
                    if value = String.Empty then
                        parseDice dice
                    else
                        [ int value ]

                let values = values |> List.map (fun x -> if isAdd then x else -x)

                values @ parseMod rest
            else
                failwith $"invalid modifier description: {modifier.Value}"
    | [] -> []

let parseRoll (rollDescription: string) =
    let regex =
        Regex(@"(?<dice>\d*[d]\d+){1}(?<mod>[ ]*[+-][ ]*(\d*[d]\d+|\d+))*", regexOptions)

    let matches = regex.Match(rollDescription)

    if matches.Success then
        let dice = parseDice matches.Groups["dice"].Value
        let modifiers = parseMod (matches.Groups["mod"].Captures |> List.ofSeq)
        Ok(dice @ modifiers)
    else
        Error "invalid roll description\nroll descriptions should be in the form of: 2d6 + 1d4 - 1"

let concat<'a> format (values: 'a list) =
    values.Tail |> List.fold (fun acc x -> acc + (format x)) (values.Head.ToString())

let rec askForRoll () =
    printf "describe the roll: "
    let roll = Console.ReadLine()

    if not <| (roll = "quit" || roll = "q") then
        match parseRoll roll with
        | Ok roll ->
            let description = roll |> concat (fun x -> if x > 0 then $" + {x}" else $" - {abs x}")
            printfn $"result = {roll |> List.sum} >> {description}"
            printfn $"dbg {roll}"
        | Error err -> printfn $"{err}"

        askForRoll ()

printfn "welcome to the dice roller!"
printfn "type 'quit' or 'q' to exit"

askForRoll ()

printfn "goodbye!"