Skip to content

Commit 5fdbdc9

Browse files
author
Tyson Williams
committed
simplified SubModelSeq implementation by making it more composable
1 parent c20e323 commit 5fdbdc9

File tree

1 file changed

+158
-118
lines changed

1 file changed

+158
-118
lines changed

‎src/Samples/SubModelSeq/Program.fs

+158-118
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,24 @@ open System
44
open Elmish
55
open Elmish.WPF
66

7+
8+
let mapIf p f a =
9+
if p a then f a else a
10+
11+
12+
module Func =
13+
14+
let flip<'a, 'b, 'c> (f: 'a -> 'b -> 'c) =
15+
fun b a -> f a b
16+
17+
let dedup (f: 'a -> 'a -> 'b) =
18+
fun a -> f a a
19+
20+
21+
let map get set f a =
22+
a |> get |> f |> Func.flip set a
23+
24+
725
module List =
826

927
let swap i j =
@@ -13,177 +31,199 @@ module List =
1331
| a when a = j -> i
1432
| a -> a)
1533

34+
let swapWithNext i = swap i (i + 1)
35+
let swapWithPrev i = swap i (i - 1)
36+
37+
let cons a ma = a :: ma
1638

39+
1740
[<AutoOpen>]
18-
module Domain =
41+
module IdentifiableTypes =
42+
43+
type Identifiable<'a> =
44+
{ Id: Guid
45+
Value: 'a }
46+
47+
module Identifiable =
48+
module Id =
49+
let get m = m.Id
50+
let set v m = { m with Id = v }
51+
let map x = x |> map get set
52+
module Value =
53+
let get m = m.Value
54+
let set v m = { m with Value = v }
55+
let map f = f |> map get set
56+
let mapIf p f = f |> map |> mapIf p
57+
let mapIfId id f = f |> mapIf (fun m -> m.Id = id)
58+
59+
let create v id =
60+
{ Id = id
61+
Value = v }
1962

20-
type CounterId = CounterId of Guid
63+
64+
[<AutoOpen>]
65+
module CounterTypes =
2166

2267
type Counter =
23-
{ Id: CounterId
24-
CounterValue: int
68+
{ Count: int
2569
StepSize: int }
2670

71+
type CounterMsg =
72+
| Increment
73+
| Decrement
74+
| SetStepSize of int
75+
| Reset
76+
2777
module Counter =
2878

29-
let create () =
30-
{ Id = Guid.NewGuid () |> CounterId
31-
CounterValue = 0
79+
let init =
80+
{ Count = 0
3281
StepSize = 1 }
82+
83+
let canReset = (<>) init
84+
85+
let update msg m =
86+
match msg with
87+
| Increment -> { m with Count = m.Count + m.StepSize }
88+
| Decrement -> { m with Count = m.Count - m.StepSize }
89+
| SetStepSize x -> { m with StepSize = x }
90+
| Reset -> init
3391

34-
let increment c =
35-
{ c with CounterValue = c.CounterValue + c.StepSize }
36-
37-
let decrement c =
38-
{ c with CounterValue = c.CounterValue - c.StepSize}
39-
40-
let setStepSize step c =
41-
{ c with StepSize = step }
4292

43-
let canReset c =
44-
c.CounterValue <> 0 || c.StepSize <> 1
4593

46-
let reset c =
47-
{ create () with Id = c.Id }
94+
[<AutoOpen>]
95+
module TreeTypes =
4896

97+
type RoseTree<'a> =
98+
{ Data: 'a
99+
Children: RoseTree<'a> list }
49100

50-
module Tree =
51101

52-
type Node<'a> =
53-
{ Data: 'a
54-
Children: Node<'a> list }
102+
module RoseTree =
55103

56-
let asLeaf a =
57-
{ Data = a
58-
Children = [] }
104+
module Data =
105+
let get m = m.Data
106+
let set v m = { Data = v; Children = m.Children }
107+
let rec map f n =
108+
{ Data = n.Data |> f
109+
Children = n.Children |> (f |> map |> List.map) }
110+
module Children =
111+
let get m = m.Children
112+
let set v m = { m with Children = v }
113+
let map f = map get set f
59114

60-
let dataOfChildren n =
61-
n.Children |> List.map (fun nn -> nn.Data)
115+
let rec map f t =
116+
t |> f |> Children.map (f |> map |> List.map)
62117

63-
let rec map f n =
64-
let nn = n |> f
65-
{ nn with Children = nn.Children |> List.map (map f) }
118+
let asLeaf a =
119+
{ Data = a
120+
Children = [] }
66121

67-
let rec mapData f n =
68-
{ Data = n.Data |> f
69-
Children = n.Children |> List.map (mapData f) }
122+
let addChild a = a |> asLeaf |> List.cons |> Children.map
123+
124+
let dataOfChildren n =
125+
n.Children |> List.map Data.get
126+
127+
let rec preorderFlatten n =
128+
n :: List.collect preorderFlatten n.Children
70129

71-
let rec preorderFlatten n =
72-
n :: List.collect preorderFlatten n.Children
73130

74131
module App =
75132

76133
type Model =
77134
{ SomeGlobalState: bool
78-
DummyRoot: Tree.Node<Counter> }
135+
DummyRoot: RoseTree<Identifiable<Counter>> }
136+
137+
type Msg =
138+
| ToggleGlobalState
139+
| AddCounter of parent: Guid
140+
| CounterMsg of Guid * CounterMsg
141+
| Remove of Guid
142+
| MoveUp of Guid
143+
| MoveDown of Guid
144+
145+
146+
module SomeGlobalState =
147+
let get m = m.SomeGlobalState
148+
let set v m = { m with SomeGlobalState = v }
149+
let map f = f |> map get set
150+
module DummyRoot =
151+
let get m = m.DummyRoot
152+
let set v m = { m with DummyRoot = v }
153+
let map f = f |> map get set
79154

80-
let asDummyRoot ns : Tree.Node<Counter> =
81-
{ Data = Counter.create() // Placeholder data to satisfy type system. User never sees this.
82-
Children = ns }
155+
let createIdentifiableCounter () =
156+
() |> Guid.NewGuid |> Identifiable.create Counter.init
83157

84158
let init () =
85159
{ SomeGlobalState = false
86-
DummyRoot = [ Counter.create() |> Tree.asLeaf ] |> asDummyRoot }
160+
DummyRoot =
161+
createIdentifiableCounter () // Placeholder data to satisfy type system. User never sees this.
162+
|> RoseTree.asLeaf
163+
|> RoseTree.addChild (createIdentifiableCounter ()) }
164+
165+
let hasId id n = n.Data.Id = id
166+
167+
let addChildCounter nId =
168+
nId
169+
|> Identifiable.create Counter.init
170+
|> RoseTree.addChild
171+
172+
let swapCounters swap nId =
173+
nId
174+
|> hasId
175+
|> List.tryFindIndex
176+
>> Option.map swap
177+
>> Option.defaultValue id
178+
|> Func.dedup
179+
|> RoseTree.Children.map
180+
181+
let update = function
182+
| ToggleGlobalState -> not |> SomeGlobalState.map
183+
| CounterMsg (nId, msg) -> msg |> Counter.update |> Identifiable.Value.mapIfId nId |> RoseTree.Data.map |> DummyRoot.map
184+
| AddCounter pId -> () |> Guid.NewGuid |> addChildCounter |> mapIf (hasId pId) |> RoseTree.map |> DummyRoot.map
185+
| Remove nId -> nId |> hasId >> not |> List.filter |> RoseTree.Children.map |> RoseTree.map |> DummyRoot.map
186+
| MoveUp nId -> nId |> swapCounters List.swapWithPrev |> RoseTree.map |> DummyRoot.map
187+
| MoveDown nId -> nId |> swapCounters List.swapWithNext |> RoseTree.map |> DummyRoot.map
87188

88189
/// Returns all top-level counters.
89190
let topLevelCounters m =
90-
m.DummyRoot |> Tree.dataOfChildren
191+
m.DummyRoot |> RoseTree.dataOfChildren
91192

92193
/// Returns all immediate child counters of the specified parent counter ID.
93194
let childrenCountersOf pid m =
94195
m.DummyRoot
95-
|> Tree.preorderFlatten
196+
|> RoseTree.preorderFlatten
96197
|> List.find (fun n -> n.Data.Id = pid)
97-
|> Tree.dataOfChildren
198+
|> RoseTree.dataOfChildren
98199

99200
/// Returns the parent of the specified child counter ID.
100201
let parentOf cid m =
101202
m.DummyRoot
102-
|> Tree.preorderFlatten
103-
|> List.find (fun n -> n |> Tree.dataOfChildren |> List.map (fun d -> d.Id) |> List.contains cid)
203+
|> RoseTree.preorderFlatten
204+
|> List.find (RoseTree.dataOfChildren >> List.map Identifiable.Id.get >> List.contains cid)
104205

105206
/// Returns the sibling counters of the specified counter ID.
106207
let childrenCountersOfParentOf cid =
107-
parentOf cid >> Tree.dataOfChildren
108-
109-
type Msg =
110-
| ToggleGlobalState
111-
| AddCounter of parent: CounterId
112-
| Increment of CounterId
113-
| Decrement of CounterId
114-
| SetStepSize of CounterId * int
115-
| Reset of CounterId
116-
| Remove of CounterId
117-
| MoveUp of CounterId
118-
| MoveDown of CounterId
119-
120-
/// Updates the counter using the specified function if the ID matches,
121-
/// otherwise passes the counter through unmodified.
122-
let updateCounter f id c =
123-
if c.Id = id then f c else c
124-
125-
let incrementCounter = updateCounter Counter.increment
126-
let decrementCounter = updateCounter Counter.decrement
127-
let setStepSizeOfCounter ss = updateCounter <| Counter.setStepSize ss
128-
let resetCounter = updateCounter Counter.reset
129-
130-
let update msg m =
131-
match msg with
132-
| ToggleGlobalState -> { m with SomeGlobalState = not m.SomeGlobalState }
133-
134-
| AddCounter pid ->
135-
let f (n: Tree.Node<Counter>) =
136-
if n.Data.Id = pid
137-
then { n with Children = (Counter.create () |> Tree.asLeaf) :: n.Children}
138-
else n
139-
{ m with DummyRoot = m.DummyRoot |> Tree.map f }
140-
141-
| Increment id -> { m with DummyRoot = m.DummyRoot |> Tree.mapData (incrementCounter id) }
142-
143-
| Decrement id -> { m with DummyRoot = m.DummyRoot |> Tree.mapData (decrementCounter id) }
144-
145-
| SetStepSize (id, ss) -> { m with DummyRoot = m.DummyRoot |> Tree.mapData (setStepSizeOfCounter ss id) }
146-
147-
| Reset id -> { m with DummyRoot = m.DummyRoot |> Tree.mapData (resetCounter id ) }
148-
149-
| Remove id ->
150-
let f (n: Tree.Node<Counter>) =
151-
{ n with Children = n.Children |> List.filter (fun n -> n.Data.Id <> id) }
152-
{ m with DummyRoot = m.DummyRoot |> Tree.map f }
153-
154-
| MoveUp id ->
155-
let f (n: Tree.Node<Counter>) =
156-
match n.Children |> List.tryFindIndex (fun nn -> nn.Data.Id = id) with
157-
| Some i -> { n with Children = n.Children |> List.swap i (i - 1) }
158-
| None -> n
159-
{ m with DummyRoot = m.DummyRoot |> Tree.map f }
160-
161-
| MoveDown id ->
162-
let f (n: Tree.Node<Counter>) =
163-
match n.Children |> List.tryFindIndex (fun nn -> nn.Data.Id = id) with
164-
| Some i -> { n with Children = n.Children |> List.swap i (i + 1) }
165-
| None -> n
166-
{ m with DummyRoot = m.DummyRoot |> Tree.map f }
208+
cid |> parentOf >> RoseTree.dataOfChildren
167209

168210

169211
module Bindings =
170212

171213
open App
172214

173-
let rec counterTreeBindings () : Binding<Model * Counter, Msg> list = [
174-
"CounterIdText" |> Binding.oneWay(fun (_, { Id = CounterId id }) -> id)
175-
176-
"CounterValue" |> Binding.oneWay(fun (_, c) -> c.CounterValue)
177-
178-
"Increment" |> Binding.cmd(fun (_, c) -> Increment c.Id)
179-
180-
"Decrement" |> Binding.cmd(fun (_, c) -> Decrement c.Id)
215+
let rec counterTreeBindings () : Binding<Model * Identifiable<Counter>, Msg> list = [
216+
"CounterIdText" |> Binding.oneWay(fun (_, c) -> c.Id)
181217

218+
"CounterValue" |> Binding.oneWay(fun (_, c) -> c.Value.Count)
219+
"Increment" |> Binding.cmd(fun (_, c) -> CounterMsg (c.Id, Increment))
220+
"Decrement" |> Binding.cmd(fun (_, c) -> CounterMsg (c.Id, Decrement))
182221
"StepSize" |> Binding.twoWay(
183-
(fun (_, c) -> float c.StepSize),
184-
(fun v (_, c) -> SetStepSize (c.Id, int v)))
185-
186-
"Reset" |> Binding.cmdIf((fun (_, c) -> Reset c.Id), (fun (_, c) -> Counter.canReset c))
222+
(fun (_, c) -> float c.Value.StepSize),
223+
(fun v (_, c) -> CounterMsg (c.Id, SetStepSize (int v))))
224+
"Reset" |> Binding.cmdIf(
225+
(fun (_, c) -> CounterMsg (c.Id, Reset)),
226+
(fun (_, c) -> Counter.canReset c.Value))
187227

188228
"Remove" |> Binding.cmd(fun (_, c) -> Remove c.Id)
189229

0 commit comments

Comments
 (0)