(red) wip on offers

MaxWilson · Jan 6, 2024 · 0cde4e8 · 0cde4e8
1 parent 3878da5
commit 0cde4e8
Showing 1 changed file with 37 additions and 8 deletions.
diff --git a/test/Chargen.Accept.fs b/test/Chargen.Accept.fs
@@ -24,15 +24,17 @@ type OfferInput = {
     selected: Set<Key>
     }
     with static member fresh = { selected = Set.empty }
-type 't Offer = Offer of (OfferInput -> 't)
-type 't ListOffer = ('t list) Offer
-type 't OptionOffer = ('t option) Offer
-
 type OfferConfig = {
     key: Key option
     label: string option
     }
     with static member blank = { key = None; label = None }
+type 't Offer = { config: OfferConfig; func: (OfferConfig -> OfferInput -> 't * MenuOutput) }
+    with
+    member this.recur input = this.func this.config input
+type 't ListOffer = ('t list) Offer
+type 't OptionOffer = ('t option) Offer
+
 open type OfferConfig
 
 type 'reactElement RenderApi = {
@@ -71,10 +73,33 @@ let render (render: 'reactElement RenderApi) (menus: MenuOutput list) =
     menus |> List.map (recur true render.unconditional) |> render.combine
 
 type Op =
-    static member skill v: 't OptionOffer = notImpl()
-    static member trait' v: 't OptionOffer = notImpl()
+    static member offer(config, func) = { config = config; func = func }
+    static member offer func = Op.offer(OfferConfig.blank, func)
+
+    static member skill (name: string, level: int): _ OptionOffer =
+        Op.skill({ OfferConfig.blank with label = Some $"{name} %+d{level}" }, (name, [level]))
+    static member skill (name: string, levels: int list): _ OptionOffer =
+        Op.skill(OfferConfig.blank, (name, levels))
+    static member skill (config, (name: string, levels: int list)): _ OptionOffer =
+        Op.offer(config, fun config input -> None, (Leaf (defaultArg config.label (toString name))))
+
+    static member trait' (v: 't): 't OptionOffer =
+        Op.trait'(OfferConfig.blank, v)
+    static member trait' (config, v): 't OptionOffer =
+        Op.offer(config, fun config input -> Some v, (Leaf (defaultArg config.label (toString v))))
+
     static member budgeted v: 't ListOffer = notImpl()
-    static member either v : 't OptionOffer = notImpl()
+
+    static member either options : 't OptionOffer =
+        Op.either(OfferConfig.blank, options)
+    static member either (config, options: 't OptionOffer list) : 't OptionOffer =
+        Op.offer(
+            config,
+            fun config input ->
+                let children = options |> List.map (fun o -> o.recur input |> Tuple2.mapfst Option.isSome)
+                None, Either(config.label, children)
+            )
+
     static member and' v : 't OptionOffer = notImpl()
     static member eitherN v : 't ListOffer = notImpl()
     static member andN' v : 't ListOffer = notImpl()
@@ -107,7 +132,7 @@ let swash(): Trait' ListOffer list = [
         skill("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) -> skill({ blank with key = Some key }, name, bonus))
+    let weaponsAt (bonus: int) = mainWeapons |> List.map (fun (name, key) -> skill({ blank with key = Some key }, (name, [bonus])))
     eitherN [
         either(label "Sword!", weaponsAt +5) |> promote
         andN'(label "Sword and Dagger", [either(weaponsAt +4); skill("Main-gauche", +1)])
@@ -155,6 +180,10 @@ let pseudoReactApi = {
     combine = Fragment
     }
 
+[<Tests>]
+let unit1 = testCase "Unit.Chargen.smoke1" <| fun () ->
+    test <@ [either[trait' "Fight"; trait' "Hide"]] |> evaluate OfferInput.fresh = Either(None, [false, Leaf "Fight"; false, Leaf "Hide"]) @>
+
 let proto1 = testCase "proto1" <| fun () ->
     let actual = swash() |> evaluate OfferInput.fresh // 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