(green) Attempt to give levels interactivity, which requires making t…

…heir keys accessible, which requires reworking some plumbing and some tests. I'm not sure about this kludge here...

src/Core/Menus.fs

@@ -8,7 +8,7 @@ type Key = KeySegment ReversedList
 type MenuOutput =
     | Either of label: string option * options: MenuSelection list
     | And of label: string option * grants: MenuOutput list
-    | Leveled of label: string * level: int
+    | Leveled of label: string * Key * level: int
     | Leaf of label: string
     with
     member this.DisplayText =
@@ -18,7 +18,7 @@ type MenuOutput =
         | 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})"
+        | Leveled(label, key, level) -> $"Leveled({label}, {key}, {level})"
         | Leaf(label) -> $"Leaf({label})"
 and MenuSelection = bool * Key * MenuOutput
 
@@ -35,8 +35,9 @@ type OfferConfigCore = { // the core, public part of the offerConfig that we can
     explicitUnselectedLabel: string option
     }
     with static member blank = { key = None; label = None; explicitUnselectedLabel = None }
+
 type 't OfferConfig = { inner: OfferConfigCore; toString: ('t -> string) option } // specialized OfferConfig with extra information about creating labels
-let blankStringConfig() = { inner = OfferConfigCore.blank; toString = None }
+let blank() = { inner = OfferConfigCore.blank; toString = None }
 type OfferInput = {
     selected: Map<Key, MaybeLevel>
     prefix: KeySegment ReversedList
@@ -50,7 +51,7 @@ type OfferInput = {
     member input.extend (config: OfferConfigCore) = { input with prefix = input.fullKey config }
     member input.extend (segment: KeySegment option) = { input with prefix = input.fullKey segment }
     member this.has (key: Key) = key = [] || this.selected.ContainsKey key
-    member this.getKey (key: Key) = if key = [] then Some Flag else this.selected.TryFind key
+    member this.lookup (key: Key) = if key = [] then Some Flag else this.selected.TryFind key
 
 type 't Offer = { config: OfferConfigCore; func: (OfferConfigCore -> OfferInput -> 't * MenuOutput) }
     with
@@ -62,13 +63,11 @@ type 't Offer = { config: OfferConfigCore; func: (OfferConfigCore -> OfferInput
 type 't ListOffer = ('t list) Offer
 type 't OptionOffer = ('t option) Offer
 
-open type OfferConfigCore
-
 type 'reactElement RenderApi = {
     checked': string * Key * ('reactElement list) -> 'reactElement
     unchecked: string * Key -> 'reactElement
     unconditional: string * ('reactElement list) -> 'reactElement
-    leveledLeaf: string * int -> 'reactElement
+    leveledLeaf: string * Key * int -> 'reactElement
     combine: 'reactElement list -> 'reactElement
     }
 
@@ -95,7 +94,7 @@ let render (render: 'reactElement RenderApi) (menus: MenuOutput list) =
         | And(label, grants) ->
             let childReacts = grants |> List.map (recur true render.unconditional)
             renderMe(defaultArg label "And:", childReacts)
-        | Leveled(name, lvl) -> render.leveledLeaf(name, lvl)
+        | Leveled(name, key, lvl) -> render.leveledLeaf(name, key, lvl)
         | Leaf(name) -> renderMe(name, [])
     menus |> List.map (recur true render.unconditional) |> render.combine
 
@@ -141,32 +140,35 @@ type Op =
         offer(configDefaultBoth config.inner (render v), fun config input -> Some v, (Leaf (defaultArg config.label (render v))))
 
     static member level (name: string, spec: LevelSpec<int, 't>, levels: int list): 't OptionOffer =
-        Op.level(OfferConfigCore.blank, (name, spec, levels))
+        Op.level({ blank() with toString = Some spec.toString }, (name, spec, levels))
     static member level (config, (name: string, spec: LevelSpec<int, 't>, levels: int list)): 't OptionOffer =
-        let config = { config with key = config.key |> Option.orElse (Some name); explicitUnselectedLabel = config.explicitUnselectedLabel |> Option.orElse (Some $"{spec.ctor levels[0] |> spec.toString }") }
-        offer(config, fun config input ->
-            let fullKey = input.prefix // no need to extend the prefix because only one key is possible--we're not in an either here
+        let config = {
+            config
+            with
+                inner.key = config.inner.key |> Option.orElse (Some name) // use the generic name as the key, not the specific level which changes over time as the user clicks
+                inner.explicitUnselectedLabel = config.inner.explicitUnselectedLabel |> Option.orElse (Some $"{spec.ctor levels[0] |> spec.toString }")
+            }
+        offer(config.inner, fun config input ->
+            let fullKey =
+                match config.key, input.prefix with
+                // code smell: there's probably a more elegant way to separate the either/level interactions with key
+                | Some key, head::_ when key = head -> input.prefix // if we're inside an either then it has already added our key to its prefix
+                | _ -> input.fullKey config.key // otherwise kludge: if we're not inside an either, we need to extend the prefix so we can have unique data for this control
             let level ix =
                 let level = levels[ix] // e.g. if this is skill("Rapier", [+5..+8]) then ix 0 means level = +5 and value = Rapier +5
                 let value = spec.ctor level
-                Some value, Leveled(defaultArg config.label $"{spec.toString value}", ix)
-            match input.getKey fullKey with
+                Some value, Leveled(defaultArg config.label $"{spec.toString value}", fullKey, ix)
+            match input.lookup fullKey with
             | Some (Level lvl) when lvl < levels.Length -> level lvl
-            | Some Flag when levels.Length >= 1 -> // we are permissive in the input we accept, partly to make testing easier. Flag means "default to the lowest value", e.g. Rapier +5-+7 defaults to Rapier +5.
+            | _ when levels.Length >= 1 -> // we are permissive in the input we accept, partly to make testing easier. Flag means "default to the lowest value", e.g. Rapier +5-+7 defaults to Rapier +5.
                 level 0
-            | _ ->
-                let label =
-                    match config.label, levels with
-                    | Some label, _ -> label
-                    | None, lvl::_ -> $"{spec.ctor lvl}" // tell the user what they'll get if they pick the lowest level
-                    | None, levels -> shouldntHappen "A levelled option with no levels is nonsense"
-                None, (Leaf label)
+            | _ -> shouldntHappen "A levelled option with no levels is nonsense"
             )
 
     static member budget (budgetF, offers: 't ListOffer list) =
-        Op.budget(blankStringConfig(), budgetF, offers)
+        Op.budget(blank(), budgetF, offers)
     static member budget (budgetF, offers: 't OptionOffer list) =
-        Op.budget(blankStringConfig(), budgetF, offers |> List.map Op.promote)
+        Op.budget(blank(), budgetF, offers |> List.map Op.promote)
     static member budget (config, budgetF: 't list -> int, offers: 't OptionOffer List) : 't ListOffer =
         Op.budget(config, budgetF, offers |> List.map Op.promote)
     static member budget (config, budgetF: 't list -> int, offers: 't ListOffer List) : 't ListOffer =
@@ -183,7 +185,7 @@ type Op =
         eitherF (|Fulfilled|Partial|Fallback|) [] offers config
 
     static member either options : 't OptionOffer =
-        Op.either(blankStringConfig(), options)
+        Op.either(blank(), options)
     static member either (config, options: 't OptionOffer list) : 't OptionOffer =
         let (|Fulfilled|Partial|Fallback|) (children: ('t option * MenuSelection) list) : 't option EitherPattern =
             match children |> List.tryFind (function _, (true, _, _) -> true | _ -> false) with
@@ -193,9 +195,9 @@ type Op =
         eitherF (|Fulfilled|Partial|Fallback|) None options config
 
     static member eitherN (options: 't OptionOffer list) : 't ListOffer =
-        Op.eitherN(blankStringConfig(), 1, options)
+        Op.eitherN(blank(), 1, options)
     static member eitherN (options: 't ListOffer list) : 't ListOffer =
-        Op.eitherN(blankStringConfig(), 1, options)
+        Op.eitherN(blank(), 1, options)
     static member eitherN (config, n: int, options: 't OptionOffer list) : 't ListOffer =
         Op.eitherN(config, n, options |> List.map (fun o -> Op.promote o))
     static member eitherN (config, n: int, options: 't ListOffer list) : 't ListOffer =
@@ -207,9 +209,9 @@ type Op =
         eitherF (|Fulfilled|Partial|Fallback|) [] options config
 
     static member and' (offers: 't OptionOffer list) : 't ListOffer =
-        Op.and'(blankStringConfig(), offers)
+        Op.and'(blank(), offers)
     static member and' (offers: 't ListOffer list) : 't ListOffer =
-        Op.and'(blankStringConfig(), offers)
+        Op.and'(blank(), offers)
     static member and' (config, offers: 't OptionOffer list) : 't ListOffer =
         Op.and'(config, offers |> List.map (fun o -> Op.promote o))
     static member and' (config: 't OfferConfig, offers: 't ListOffer list) : 't ListOffer =

src/UI/DFRPG/Chargen.fs

@@ -54,13 +54,14 @@ type DFRPGCharacter = { // stub
     }
     with static member fresh = { traits = Set.empty }
 
-type Msg = RefreshedOutput of DFRPGCharacter
+type Msg =
+    | SetKey of Key * MaybeLevel option
 type Model = {
-    currentOutput: DFRPGCharacter Option
     selections: Map<Key, MaybeLevel>
     }
 
-let init _ = { currentOutput = None; selections = Map.empty }
+let init _ = { selections = Map.empty }
 let update msg model =
     match msg with
-    | RefreshedOutput output -> { model with currentOutput = Some output }
+    | SetKey(key, None) -> { model with selections = model.selections |> Map.remove key }
+    | SetKey(key, Some v) -> { model with selections = model.selections |> Map.add key v }

src/UI/DFRPG/ChargenView.fs

@@ -5,37 +5,48 @@ open UI.DFRPG.Chargen
 
 module private Impl =
     let button (txt: string) onClick = Html.button [ prop.text txt; prop.onClick onClick ]
-    let checkbox (txt: string) checked' (onChange: bool -> unit) =
+    let combine = function [] -> React.fragment [] | [v] -> v | vs -> Html.ul [prop.style [style.listStyleType.none; style.listStylePosition.outside]; prop.children vs]
+    let toggle dispatch (key: Key) (newValue: bool) =
+        if newValue then dispatch (SetKey(key, Some Flag))
+        else dispatch (SetKey(key, None))
+    let changeLevel dispatch key (newLevel: int) =
+        ()
+    let checkbox (txt: string) checked' (onChange: bool -> unit) children =
         let id = System.Guid.NewGuid().ToString()
         Html.li [
             Html.input [ prop.type'.checkbox; prop.id id; prop.isChecked checked'; prop.onChange onChange ]
             Html.label [ prop.htmlFor id; prop.text txt ]
+            match children with
+            | [] -> ()
+            | children ->
+                combine children
             ]
-    let reactApi: ReactElement RenderApi =
-        let combine = function [] -> React.fragment [] | [v] -> v | vs -> Html.ul [prop.style [style.listStyleType.none; style.listStylePosition.outside]; prop.children vs]
+
+    let reactApi dispatch: ReactElement RenderApi =
+        let toggle = toggle dispatch
         {
-        checked' = fun (label, key, children) -> checkbox label true ignore
-        unchecked = fun (label, key) -> checkbox label false ignore
-        leveledLeaf = fun (label, level) -> class' "" Html.li [ button "-" ignore; button "+" ignore; Html.text label ]
+        checked' = fun (label, key, children) -> checkbox label true (toggle key) children
+        unchecked = fun (label, key) -> checkbox label false (toggle key) []
+        leveledLeaf = fun (label, key, level) -> class' "" Html.li [ button "-" (thunk3 changeLevel dispatch key (level-1)); button "+" (thunk3 changeLevel dispatch key (level+1)); Html.text label ]
         unconditional = fun (label, children) -> class' "" Html.li [ Html.text label; combine children ]
         combine = combine
         }
-    let eval selections (template: Trait ListOffer list) =
+    let eval dispatch selections (template: Trait ListOffer list) =
         let value, menus =
             [
             for offer in template do
                 evaluate { OfferInput.fresh with selected = selections } offer
             ]
             |> List.unzip
-        let react = render reactApi menus
+        let react = render (reactApi dispatch) menus
         value |> List.collect id, react
 open Impl
 
 [<ReactComponent>]
 let View() =
     let model, dispatch = React.useElmishSimple init update
     let profession = swash
-    let value, react = eval model.selections profession // value will be used later for things like enabling/disabling the Save button
+    let value, react = eval dispatch model.selections profession // value will be used later for things like enabling/disabling the Save button
     Html.div [
         srcLink
         react

test/Chargen.Accept.fs

@@ -37,7 +37,7 @@ Example UX flow:
 *)
 
 [<StructuredFormatDisplay("{DisplayText}")>]
-type Trait' = CombatReflexes | Skill of string * int
+type Trait = CombatReflexes | Skill of string * int
     with
     member this.DisplayText =
         match this with
@@ -46,15 +46,15 @@ type Trait' = CombatReflexes | Skill of string * int
 
 let makeSkill name = { ctor = (fun bonus -> Skill(name, bonus)); toString = fun skill -> skill.DisplayText }
 let skill(name:string, level: int) =
-    Op.trait'(Skill(name, level))
+    Op.trait'({ blank() with toString = Some (fun (t:Trait) -> t.DisplayText)}, Skill(name, level))
 let skillN(name:string, levels: int list) =
     Op.level(name, makeSkill name, levels)
 
 type Pseudoreact =
     | Checked of string * Key * Pseudoreact list
     | Unchecked of string * Key
     | Unconditional of string * Pseudoreact list
-    | NumberInput of string * int
+    | NumberInput of string * Key * int
     | Fragment of Pseudoreact list
 
 let pseudoReactApi = {
@@ -89,7 +89,7 @@ let testFors (selections: string list) expected offers =
         failtest $"Actual diverged from expected! After: \n{same}\n\nExpected: \n{expected}\n\nbut got:\n{actual}"
 
 type FightHide = Fight | Hide
-let label txt = let blank = blankStringConfig() in { blank with toString = Some (thunk ""); inner.label = Some "" }
+let label txt = let blank = blank() in { blank with toString = Some (thunk ""); inner.label = Some txt }
 
 [<Tests>]
 let units = testList "Unit.Chargen" [
@@ -119,7 +119,7 @@ let units = testList "Unit.Chargen" [
         nestedEither |> testFor ["Sword!"] (
             Either(None, [
                 true, key "Sword!", Either(Some "Sword!", [
-                    false, key "Sword!-Rapier", Leaf "Rapier +5" // note how Leveled is only Leveled if selected. When unselected it's a Leaf just like anything else.
+                    false, key "Sword!-Rapier", Leaf "Rapier +5" // note how Leveled is only Leveled if selected. When unselected it's a Leaf just like anything else. Note also that the key is the generic "Rapier" and not the specific level, which changes as the user clicks.
                     false, key "Sword!-Broadsword", Leaf "Broadsword +5"
                     false, key "Sword!-Shortsword", Leaf "Shortsword +5"
                     ])
@@ -128,7 +128,7 @@ let units = testList "Unit.Chargen" [
         nestedEither |> testFor ["Sword!"; "Sword!-Rapier"] (
             Either(None, [
                 true, key "Sword!", Either(Some "Sword!", [
-                    true, key "Sword!-Rapier", Leveled("Rapier +5", 0) // it's a Levelled, not a Leaf, because it's currently selected. Note that the level is 0, not +5, because it's the lowest level out of +5 to +5.
+                    true, key "Sword!-Rapier", Leveled("Rapier +5", key "Sword!-Rapier", 0) // it's a Levelled, not a Leaf, because it's currently selected. Note that the level is 0, not +5, because it's the lowest level out of +5 to +5.
                     ])
                 ])
             )
@@ -154,7 +154,7 @@ let tests =
             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
                 // 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 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
@@ -176,7 +176,7 @@ let tests =
                 let offers = swash()
                 let expectedMenus = [
                     Leaf "Climbing +1" // Leaf not Level because swash() template is only using trait', not level
-                    Leveled("Stealth +1", 0) // Leveled because it can go up to +3
+                    Leveled("Stealth +1", key "Stealth", 0) // Leveled because it can go up to +3
                     Either(None, [
                         false, key "Combat Reflexes", Leaf "Combat Reflexes"
                         false, key "Acrobatics", Leaf "Acrobatics +1"
@@ -196,13 +196,13 @@ let tests =
             let (|Checked|) = function Checked(label, key, children) -> Checked(label, key, children) | v -> fail "Checked" v
             let (|Unchecked|) = function Unchecked(label, key) -> Unchecked(label, key) | v -> fail "Unchecked" v
             let (|Unconditional|) = function Unconditional(label, children) -> Unconditional(label, children) | v -> fail "Unconditional" v
-            let (|NumberInput|) = function NumberInput(label, value) -> NumberInput(label, value) | v -> fail "NumberInput" v
+            let (|NumberInput|) = function NumberInput(label, key, value) -> NumberInput(label, key, value) | v -> fail "NumberInput" v
             let (|Fragment|) = function Fragment(children) -> Fragment(children) | v -> fail "Fragment" v
             let (|Expect|_|) expect actual = if expect = actual then Some () else fail expect actual
             match pseudoActual with
             | Fragment([
                 Unconditional(Expect "Climbing +1", [])
-                NumberInput(Expect "Stealth +1", Expect 0)
+                NumberInput(Expect "Stealth +1", Expect ["Stealth"], Expect 0)
                 Unconditional(Expect "Choose one:", [
                     Unchecked(Expect "Combat Reflexes", Expect ["Combat Reflexes"])
                     Unchecked(Expect "Acrobatics +1", Expect ["Acrobatics"]) // note: Acrobatics is the key here, not Acrobatics +1, because it's leveled.