Skip to content

Commit

Permalink
(still 1 red) Implemented budgeted, but there's a test failure still.
Browse files Browse the repository at this point in the history
Might be a bug or a test issue.
  • Loading branch information
MaxWilson committed Jan 10, 2024
1 parent d85736d commit 407ae74
Showing 1 changed file with 49 additions and 10 deletions.
59 changes: 49 additions & 10 deletions test/Chargen.Accept.fs
Original file line number Diff line number Diff line change
Expand Up @@ -12,11 +12,23 @@ open Swensen.Unquote
type KeySegment = string
type 't ReversedList = 't list
type Key = KeySegment ReversedList
/// we want to avoid letting sequences get cut off so we use StructuredFormatDisplay with custom logic
[<StructuredFormatDisplay("{DisplayText}")>]
type MenuOutput =
| Either of label: string option * options: MenuSelection list
| And of label: string option * grants: MenuOutput list
| Leveled of label: string * level: int
| Leaf of label: string
with
member this.DisplayText =
let show lst = lst |> List.map toString |> String.concat ", "
match this with
| Either(None, children) -> $"Either({show children})"
| Either(Some label, children) -> $"Either({label}, {show children})"
| And(None, grants) -> $"And({show grants})"
| And(Some label, grants) -> $"And({label}, {show grants})"
| Leveled(label, level) -> $"Leveled({label}, {level})"
| Leaf(label) -> $"Leaf({label})"
and MenuSelection = bool * Key * MenuOutput

type 't Output = 't * MenuOutput
Expand Down Expand Up @@ -143,7 +155,22 @@ type Op =
static member trait' (config, v): 't OptionOffer =
offer(configDefaultKey config (toString v), fun config input -> Some v, (Leaf (defaultArg config.label (toString v))))

static member budgeted v: 't ListOffer = notImpl()
static member budgeted (budgetF, offers: 't ListOffer list) =
Op.budgeted(OfferConfig.blank, budgetF, offers)
static member budgeted (budgetF, offers: 't OptionOffer list) =
Op.budgeted(OfferConfig.blank, budgetF, offers |> List.map Op.promote)
static member budgeted (config, budgetF: 't list -> int, offers: 't ListOffer List) : 't ListOffer =
let (|Fulfilled|Partial|Fallback|) (children: ('t list * MenuSelection) list) : 't list EitherPattern =
match children |> List.filter (function _, (true, _, _) -> true | _ -> false) with
| lst when lst.Length > 0 ->
let values = lst |> List.collect fst
let remainingBudget = budgetF values
if remainingBudget <= 0 then
Fulfilled(values, lst |> List.map snd) // return only the selected menus, in case they want to unselect something
else
Partial(values, children |> List.map snd) // return all child menus so user can keep selecting
| _ -> Fallback([], children |> List.map snd) // return all child menus so user can keep selecting
eitherF (|Fulfilled|Partial|Fallback|) [] offers config

static member either options : 't OptionOffer =
Op.either(OfferConfig.blank, options)
Expand Down Expand Up @@ -205,6 +232,11 @@ let label txt = { blank with label = Some txt }
open type Op

type Trait' = CombatReflexes | Skill of string * int
with
override this.ToString() =
match this with
| CombatReflexes -> "Combat Reflexes"
| Skill(name, level) -> $"{name} %+d{level}"

(* Requirements:
Terseness: flatten some and's, e.g. "Fast draw (swords & daggers) +1" all on one line, instead of two separate lines.
Expand All @@ -226,15 +258,14 @@ let skillN(name:string, levels: int list) =
// swash is not a MenuOutput but it can create MenuOutputs which can then be either unit tested or turned into ReactElements
// think of swash as an offer menu
let swash(): Trait' ListOffer list = [

let budgetStub n = fun _ -> n // currently budgetF is hardwired to always think there's another n in the budget. TODO: make it aware of the current selections somehow
skill("Climbing", 1) |> promote
skillN("Stealth", [1..3]) |> promote
budgeted(20, [
budgeted(budgetStub 20, [
trait' CombatReflexes
skillN("Acrobatics", [1..3])
])
let mainWeapons = ["Rapier"; "Broadsword"; "Polearm"; "Two-handed sword"] |> List.map (fun name -> name, newKey name)
let weaponsAt (bonus: int) = mainWeapons |> List.map (fun (name, key) -> Op.skill({ blank with key = Some key }, (name, makeSkill name, [bonus])))
let weaponsAt (bonus: int) = [for name in ["Rapier"; "Broadsword"; "Polearm"; "Two-handed sword"] -> Op.skill(name, makeSkill name, [bonus])]
eitherN [
either(label "Sword!", weaponsAt +5) |> promote
and'(label "Sword and Dagger", [either(weaponsAt +4); skill("Main-gauche", +1)])
Expand Down Expand Up @@ -294,7 +325,14 @@ let testFor (selections: string list) expected offers =
let actualS, expectedS = actual |> toString, expected |> toString
let firstDiff = [0..actualS.Length-1]
let same, actual, expected = String.diff actualS expectedS
failtest $"Actual diverged from expected! After: \n{same}\n\nExpected: \n{expected}\nbut got:\n{actual}"
failtest $"Actual diverged from expected! After: \n{same}\n\nExpected: \n{expected}\n\nbut got:\n{actual}"

let testFors (selections: string list) expected offers =
let actual = offers |> List.map (evalFor selections)
if actual <> expected then
let actualS, expectedS = actual |> sprintf "%A", expected |> sprintf "%A" // use sprintf %A instead of toString so that StructuredFormatDisplay gets used so that seq doesn't get shortcircuited
let same, actual, expected = String.diff actualS expectedS
failtest $"Actual diverged from expected! After: \n{same}\n\nExpected: \n{expected}\n\nbut got:\n{actual}"

[<Tests>]
let units = testList "Unit.Chargen" [
Expand Down Expand Up @@ -350,11 +388,12 @@ let units = testList "Unit.Chargen" [
])
)
]

let proto1 = testCase "proto1" <| fun () ->
let key = parseKey
let actual = swash() |> List.map (evaluate OfferInput.fresh >> snd) // shouldn't actually use OfferInput.fresh here. Need to pick the options we want to show up in pseudoActual.s
let pseudoActual = // pseudo-actual because actual will be created from templates + OfferInput (i.e. selected keys), not hardwired as Menus, but that's still TODO
let menus = [
let offers = swash()
let expectedMenus = [
Leveled("Climbing", 1)
Leveled("Stealth", 3)
Either(None, [
Expand All @@ -366,8 +405,8 @@ let proto1 = testCase "proto1" <| fun () ->
])
Either(None, [true, key "Fast-Draw (Sword)", Leveled("Fast-draw (Sword)", +2)])
]
test <@ menus = actual @>
render pseudoReactApi menus
offers |> testFors ["Sword!"] expectedMenus // evaluate swash() with Sword! selected and compare it to expectedMenus
render pseudoReactApi expectedMenus // if that passes, render it to ReactElements and see if it looks right
let fail expect v = failwith $"Expected {expect} but got {v}\nContext: {pseudoActual}"
let (|Checked|) = function Checked(label, children) -> Checked(label, children) | v -> fail "Checked" v
let (|Unchecked|) = function Unchecked(label) -> Unchecked(label) | v -> fail "Unchecked" v
Expand Down

0 comments on commit 407ae74

Please sign in to comment.