diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json new file mode 100644 index 00000000..506d2844 --- /dev/null +++ b/.config/dotnet-tools.json @@ -0,0 +1,12 @@ +{ + "version": 1, + "isRoot": true, + "tools": { + "fantomas": { + "version": "6.2.3", + "commands": [ + "fantomas" + ] + } + } +} diff --git a/.editorconfig b/.editorconfig index de329fa9..9ea04241 100644 --- a/.editorconfig +++ b/.editorconfig @@ -4,4 +4,19 @@ root = true insert_final_newline = false trim_trailing_whitespace = true indent_style = space -indent_size = 2 \ No newline at end of file +indent_size = 2 + +##### F# files ##### +[*.{fs,fsi,fsx}] + +# Fantomas settings + +max_line_length = 120 # default + +# Set all max width to large value and let max_line_length split lines when necessary +# Max width of binding name plus binding definition, not including keywords +fsharp_max_value_binding_width = 120 +# Max width of function binding value, not including keywords and binding name +fsharp_max_function_binding_width = 120 +# Max width of series of dot-expression +fsharp_max_dot_get_expression_width = 120 diff --git a/.github/workflows/pull_request.yml b/.github/workflows/pull_request.yml index 13a7370c..da8e75c6 100644 --- a/.github/workflows/pull_request.yml +++ b/.github/workflows/pull_request.yml @@ -21,6 +21,12 @@ jobs: dotnet-version: | 3.1.x 6.0.x + + - name: Restore Fantomas + run: dotnet -d tool restore --tool-manifest ${{ github.workspace }}/.config/dotnet-tools.json + + - name: Format + run: dotnet fantomas src --check - name: Restore run: dotnet restore src/Elmish.WPF.sln diff --git a/src/Elmish.WPF.Benchmarks/Program.fs b/src/Elmish.WPF.Benchmarks/Program.fs index 3ef14862..97621fa0 100644 --- a/src/Elmish.WPF.Benchmarks/Program.fs +++ b/src/Elmish.WPF.Benchmarks/Program.fs @@ -9,11 +9,12 @@ type public BenchmarkDynamicViewModel() = [] member public x.GlobalSetup() = - let createBinding i = - Binding.oneWay id $"testBinding_%i{i}" + let createBinding i = Binding.oneWay id $"testBinding_%i{i}" let bindings = - System.Linq.Enumerable.Range(0, x.BindingCount) |> Seq.map createBinding |> Seq.toList + System.Linq.Enumerable.Range(0, x.BindingCount) + |> Seq.map createBinding + |> Seq.toList vm <- DynamicViewModel(ViewModelArgs.simple model, bindings) @@ -21,17 +22,18 @@ type public BenchmarkDynamicViewModel() = [] member public x.Update() = model <- 0 + while model < x.UpdateCount do model <- model + 1 IViewModel.updateModel (vm, model) vm :> obj - [] + [] member val public BindingCount = 0 with get, set - [] + [] member val public UpdateCount = 0 with get, set -let _ = BenchmarkRunner.Run() +let _ = BenchmarkRunner.Run() \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/AutoOpen.fs b/src/Elmish.WPF.Tests/AutoOpen.fs index f6216e3b..1513b905 100644 --- a/src/Elmish.WPF.Tests/AutoOpen.fs +++ b/src/Elmish.WPF.Tests/AutoOpen.fs @@ -5,14 +5,17 @@ module AutoOpen type InvokeTester<'a, 'b>(f: 'a -> 'b) = let mutable count = 0 let mutable values = [] + let wrapped a = count <- count + 1 - values <- values @ [a] + values <- values @ [ a ] f a + member __.Fn = wrapped member __.Count = count member __.Values = values - member __.Reset () = + + member __.Reset() = count <- 0 values <- [] @@ -20,14 +23,17 @@ type InvokeTester<'a, 'b>(f: 'a -> 'b) = type InvokeTester2<'a, 'b, 'c>(f: 'a -> 'b -> 'c) = let mutable count = 0 let mutable values = [] + let wrapped a b = count <- count + 1 - values <- values @ [a, b] + values <- values @ [ a, b ] f a b + member __.Fn = wrapped member __.Count = count member __.Values = values - member __.Reset () = + + member __.Reset() = count <- 0 values <- [] @@ -35,14 +41,17 @@ type InvokeTester2<'a, 'b, 'c>(f: 'a -> 'b -> 'c) = type InvokeTester3<'a, 'b, 'c, 'd>(f: 'a -> 'b -> 'c -> 'd) = let mutable count = 0 let mutable values = [] + let wrapped a b c = count <- count + 1 - values <- values @ [a, b, c] + values <- values @ [ a, b, c ] f a b c + member __.Fn = wrapped member __.Count = count member __.Values = values - member __.Reset () = + + member __.Reset() = count <- 0 values <- [] @@ -57,18 +66,11 @@ module String = module List = let swap i j = - List.permute - (function - | a when a = i -> j - | a when a = j -> i - | a -> a) - - let insert i a ma = - (ma |> List.take i) - @ [ a ] - @ (ma |> List.skip i) - - let replace i a ma = - (ma |> List.take i) - @ [ a ] - @ (ma |> List.skip (i + 1)) + List.permute (function + | a when a = i -> j + | a when a = j -> i + | a -> a) + + let insert i a ma = (ma |> List.take i) @ [ a ] @ (ma |> List.skip i) + + let replace i a ma = (ma |> List.take i) @ [ a ] @ (ma |> List.skip (i + 1)) \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/BindingTests.fs b/src/Elmish.WPF.Tests/BindingTests.fs index 5f805f73..b951591b 100644 --- a/src/Elmish.WPF.Tests/BindingTests.fs +++ b/src/Elmish.WPF.Tests/BindingTests.fs @@ -13,15 +13,16 @@ module internal Helpers = let fail _ = failwith "Placeholder function was invoked" let fail2 _ _ = failwith "Placeholder function was invoked" - let rec getBaseBindingData = function + let rec getBaseBindingData = + function | BaseBindingData d -> d | CachingData d -> getBaseBindingData d | ValidationData d -> getBaseBindingData d.BindingData | LazyData d -> - d.BindingData - |> BindingData.mapModel d.Get - |> BindingData.mapMsgWithModel d.Set - |> getBaseBindingData + d.BindingData + |> BindingData.mapModel d.Get + |> BindingData.mapMsgWithModel d.Set + |> getBaseBindingData | AlterMsgStreamData _ -> raise (System.NotSupportedException()) // hack: reasonable because this is test code and the tests don't currently use this case let getOneWayData f = @@ -71,7 +72,8 @@ module oneWay = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto let binding = bindingName |> Binding.OneWay.id test <@ binding.Name = bindingName @> @@ -80,11 +82,12 @@ module oneWay = [] let ``final get returns value from original get`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string - let d = Binding.oneWay(get) |> getOneWayData + let d = Binding.oneWay (get) |> getOneWayData test <@ d.Get x |> unbox = get x @> } @@ -98,11 +101,12 @@ module oneWayOpt = [] let ``when original get returns Some, final get returns the inner value`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string >> Some - let d = Binding.oneWayOpt(get) |> getOneWayData + let d = Binding.oneWayOpt (get) |> getOneWayData test <@ d.Get x |> unbox = (get x).Value @> } @@ -110,11 +114,12 @@ module oneWayOpt = [] let ``when original get returns None, final get returns null`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get _ = None - let d = Binding.oneWayOpt(get) |> getOneWayData + let d = Binding.oneWayOpt (get) |> getOneWayData test <@ isNull (d.Get x) @> } @@ -126,20 +131,22 @@ module oneWayOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.oneWayOpt((fail: _ -> _ voption)) + let binding = bindingName |> Binding.oneWayOpt ((fail: _ -> _ voption)) test <@ binding.Name = bindingName @> } [] let ``when original get returns ValueSome, final get returns the inner value`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string >> ValueSome - let d = Binding.oneWayOpt(get) |> getOneWayData + let d = Binding.oneWayOpt (get) |> getOneWayData test <@ d.Get x |> unbox = (get x).Value @> } @@ -147,11 +154,12 @@ module oneWayOpt = [] let ``when original get returns ValueNone, final get returns null`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get _ = ValueNone - let d = Binding.oneWayOpt(get) |> getOneWayData + let d = Binding.oneWayOpt (get) |> getOneWayData test <@ isNull (d.Get x) @> } @@ -163,16 +171,18 @@ module oneWaySeq = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.oneWaySeq(fail, fail2, fail) + let binding = bindingName |> Binding.oneWaySeq (fail, fail2, fail) test <@ binding.Name = bindingName @> } [] let ``final get returns value from original get`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get (i: int) = Seq.singleton i @@ -184,24 +194,26 @@ module oneWaySeq = [] let ``final getId returns value from original getId`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getId = string - let d = Binding.oneWaySeq(fail, fail2, getId) |> getOneWaySeqData + let d = Binding.oneWaySeq (fail, fail2, getId) |> getOneWaySeqData - test <@ d.GetId (box x) |> unbox = getId x @> + test <@ d.GetId(box x) |> unbox = getId x @> } [] let ``final itemEquals returns value from original itemEquals`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! y = GenX.auto - let itemEquals : int -> int -> bool = (=) - let d = Binding.oneWaySeq(fail, itemEquals, fail) |> getOneWaySeqData + let itemEquals: int -> int -> bool = (=) + let d = Binding.oneWaySeq (fail, itemEquals, fail) |> getOneWaySeqData test <@ d.ItemEquals (box x) (box y) = itemEquals x y @> } @@ -213,33 +225,36 @@ module oneWaySeqLazy = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.oneWaySeqLazy(fail, fail2, fail, fail2, fail) + let binding = bindingName |> Binding.oneWaySeqLazy (fail, fail2, fail, fail2, fail) test <@ binding.Name = bindingName @> } [] let ``final getId returns value from original getId`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getId = string - let d = Binding.oneWaySeqLazy(fail, fail2, fail, fail2, getId) |> getOneWaySeqData + let d = Binding.oneWaySeqLazy (fail, fail2, fail, fail2, getId) |> getOneWaySeqData - test <@ d.GetId (box x) |> unbox = getId x @> + test <@ d.GetId(box x) |> unbox = getId x @> } [] let ``final itemEquals returns value from original itemEquals`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! y = GenX.auto - let itemEquals : int -> int -> bool = (=) - let d = Binding.oneWaySeqLazy(fail, fail2, fail, itemEquals, fail) |> getOneWaySeqData + let itemEquals: int -> int -> bool = (=) + let d = Binding.oneWaySeqLazy (fail, fail2, fail, itemEquals, fail) |> getOneWaySeqData test <@ d.ItemEquals (box x) (box y) = itemEquals x y @> } @@ -254,7 +269,8 @@ module twoWay = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto let binding = bindingName |> Binding.TwoWay.id test <@ binding.Name = bindingName @> @@ -263,11 +279,12 @@ module twoWay = [] let ``final get returns value from original get`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string - let d = Binding.twoWay(get, fail2) |> getTwoWayData + let d = Binding.twoWay (get, fail2) |> getTwoWayData test <@ d.Get x |> unbox = get x @> } @@ -275,12 +292,13 @@ module twoWay = [] let ``final set returns value from original set`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let set (p: string) (m: int) = p + string m - let d = Binding.twoWay((fun _ -> ""), set) |> getTwoWayData + let d = Binding.twoWay ((fun _ -> ""), set) |> getTwoWayData test <@ d.Set (box p) m |> unbox = set p m @> } @@ -292,20 +310,22 @@ module twoWay = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.twoWay(fail, (fail: string -> int)) + let binding = bindingName |> Binding.twoWay (fail, (fail: string -> int)) test <@ binding.Name = bindingName @> } [] let ``final get returns value from original get`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string - let d = Binding.twoWay(get, (fail: string -> int)) |> getTwoWayData + let d = Binding.twoWay (get, (fail: string -> int)) |> getTwoWayData test <@ d.Get x |> unbox = get x @> } @@ -313,12 +333,13 @@ module twoWay = [] let ``final set returns value from original set`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let set (p: string) = p + p - let d = Binding.twoWay((fun _ -> ""), set) |> getTwoWayData + let d = Binding.twoWay ((fun _ -> ""), set) |> getTwoWayData test <@ d.Set (box p) m |> unbox = set p @> } @@ -333,11 +354,12 @@ module twoWayOpt = [] let ``when original get returns Some, final get returns the inner value`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string >> Some - let d = Binding.twoWayOpt(get, fail2) |> getTwoWayData + let d = Binding.twoWayOpt (get, fail2) |> getTwoWayData test <@ d.Get x |> unbox = (get x).Value @> } @@ -345,11 +367,12 @@ module twoWayOpt = [] let ``when original get returns None, final get returns null`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get _ = None - let d = Binding.twoWayOpt(get, fail2) |> getTwoWayData + let d = Binding.twoWayOpt (get, fail2) |> getTwoWayData test <@ isNull (d.Get x) @> } @@ -357,12 +380,13 @@ module twoWayOpt = [] let ``when final set receives a non-null value, original get receives Some`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let set (p: string option) (m: int) = p |> Option.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> Some ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> Some ""), set) |> getTwoWayData test <@ d.Set (box p) m |> unbox = set (Some p) m @> } @@ -370,11 +394,12 @@ module twoWayOpt = [] let ``when final set receives null, original get receives None`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let set (p: string option) (m: int) = p |> Option.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> Some ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> Some ""), set) |> getTwoWayData test <@ d.Set null m |> unbox = set None m @> } @@ -386,11 +411,12 @@ module twoWayOpt = [] let ``when original get returns ValueSome, final get returns the inner value`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string >> ValueSome - let d = Binding.twoWayOpt(get, fail2) |> getTwoWayData + let d = Binding.twoWayOpt (get, fail2) |> getTwoWayData test <@ d.Get x |> unbox = (get x).Value @> } @@ -398,11 +424,12 @@ module twoWayOpt = [] let ``when original get returns ValueNone, final get returns null`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get _ = ValueNone - let d = Binding.twoWayOpt(get, fail2) |> getTwoWayData + let d = Binding.twoWayOpt (get, fail2) |> getTwoWayData test <@ isNull (d.Get x) @> } @@ -410,12 +437,13 @@ module twoWayOpt = [] let ``when final set receives a non-null value, original get receives ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let set (p: string voption) (m: int) = p |> ValueOption.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> ValueSome ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> ValueSome ""), set) |> getTwoWayData test <@ d.Set (box p) m |> unbox = set (ValueSome p) m @> } @@ -423,11 +451,12 @@ module twoWayOpt = [] let ``when final set receives null, original get receives ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let set (p: string voption) (m: int) = p |> ValueOption.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> ValueSome ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> ValueSome ""), set) |> getTwoWayData test <@ d.Set null m |> unbox = set ValueNone m @> } @@ -439,11 +468,12 @@ module twoWayOpt = [] let ``when original get returns Some, final get returns the inner value`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string >> Some - let d = Binding.twoWayOpt(get, (fail: _ option -> int)) |> getTwoWayData + let d = Binding.twoWayOpt (get, (fail: _ option -> int)) |> getTwoWayData test <@ d.Get x |> unbox = (get x).Value @> } @@ -451,11 +481,12 @@ module twoWayOpt = [] let ``when original get returns None, final get returns null`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get _ = None - let d = Binding.twoWayOpt(get, (fail: _ option -> int)) |> getTwoWayData + let d = Binding.twoWayOpt (get, (fail: _ option -> int)) |> getTwoWayData test <@ isNull (d.Get x) @> } @@ -463,12 +494,13 @@ module twoWayOpt = [] let ``when final set receives a non-null value, original get receives Some`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let set (p: string option) = p |> Option.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> Some ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> Some ""), set) |> getTwoWayData test <@ d.Set (box p) m |> unbox = set (Some p) @> } @@ -476,11 +508,12 @@ module twoWayOpt = [] let ``when final set receives null, original get receives None`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let set (p: string option) = p |> Option.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> Some ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> Some ""), set) |> getTwoWayData test <@ d.Set null m |> unbox = set None @> } @@ -492,11 +525,12 @@ module twoWayOpt = [] let ``when original get returns ValueSome, final get returns the inner value`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get = string >> ValueSome - let d = Binding.twoWayOpt(get, (fail: _ voption -> int)) |> getTwoWayData + let d = Binding.twoWayOpt (get, (fail: _ voption -> int)) |> getTwoWayData test <@ d.Get x |> unbox = (get x).Value @> } @@ -504,11 +538,12 @@ module twoWayOpt = [] let ``when original get returns ValueNone, final get returns null`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let get _ = ValueNone - let d = Binding.twoWayOpt(get, (fail: _ voption -> int)) |> getTwoWayData + let d = Binding.twoWayOpt (get, (fail: _ voption -> int)) |> getTwoWayData test <@ isNull (d.Get x) @> } @@ -516,12 +551,13 @@ module twoWayOpt = [] let ``when final set receives a non-null value, original get receives ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let set (p: string voption) = p |> ValueOption.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> ValueSome ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> ValueSome ""), set) |> getTwoWayData test <@ d.Set (box p) m |> unbox = set (ValueSome p) @> } @@ -529,11 +565,12 @@ module twoWayOpt = [] let ``when final set receives null, original get receives ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let set (p: string voption) = p |> ValueOption.map ((+) (string m)) - let d = Binding.twoWayOpt((fun _ -> ValueSome ""), set) |> getTwoWayData + let d = Binding.twoWayOpt ((fun _ -> ValueSome ""), set) |> getTwoWayData test <@ d.Set null m |> unbox = set ValueNone @> } @@ -573,12 +610,13 @@ module twoWayValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayValidate(fail, fail2, validate) |> getValidationData + let d = Binding.twoWayValidate (fail, fail2, validate) |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -615,12 +653,13 @@ module twoWayValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayValidate(fail, fail2, validate) |> getValidationData + let d = Binding.twoWayValidate (fail, fail2, validate) |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -657,12 +696,13 @@ module twoWayValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [] else [ err ] - let d = Binding.twoWayValidate(fail, fail2, validate) |> getValidationData + let d = Binding.twoWayValidate (fail, fail2, validate) |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -699,12 +739,16 @@ module twoWayValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayValidate(fail, (fail: string -> int), validate) |> getValidationData + + let d = + Binding.twoWayValidate (fail, (fail: string -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -741,12 +785,16 @@ module twoWayValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayValidate(fail, (fail: string -> int), validate) |> getValidationData + + let d = + Binding.twoWayValidate (fail, (fail: string -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -783,12 +831,16 @@ module twoWayValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [] else [ err ] - let d = Binding.twoWayValidate(fail, (fail: string -> int), validate) |> getValidationData + + let d = + Binding.twoWayValidate (fail, (fail: string -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -852,12 +904,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ voption), fail2, validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ voption), fail2, validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -918,12 +974,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ voption), fail2, validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ voption), fail2, validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -984,12 +1044,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [] else [ err ] - let d = Binding.twoWayOptValidate((fail: _ -> _ voption), fail2, validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ voption), fail2, validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1050,12 +1114,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ option), fail2, validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ option), fail2, validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1116,12 +1184,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ option), fail2, validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ option), fail2, validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1182,12 +1254,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [] else [ err ] - let d = Binding.twoWayOptValidate((fail: _ -> _ option), fail2, validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ option), fail2, validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1248,12 +1324,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ voption), (fail: _ -> int), validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ voption), (fail: _ -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1314,12 +1394,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ voption), (fail: _ -> int), validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ voption), (fail: _ -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1380,12 +1464,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [] else [ err ] - let d = Binding.twoWayOptValidate((fail: _ -> _ voption), (fail: _ -> int), validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ voption), (fail: _ -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1446,12 +1534,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ option), (fail: _ -> int), validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ option), (fail: _ -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1512,12 +1604,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [ err ] else [] - let d = Binding.twoWayOptValidate((fail: _ -> _ option), (fail: _ -> int), validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ option), (fail: _ -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1578,12 +1674,16 @@ module twoWayOptValidate = [] let ``final validate returns value from original validate`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! err = GenX.auto let validate x = if x < 0 then [] else [ err ] - let d = Binding.twoWayOptValidate((fail: _ -> _ option), (fail: _ -> int), validate) |> getValidationData + + let d = + Binding.twoWayOptValidate ((fail: _ -> _ option), (fail: _ -> int), validate) + |> getValidationData test <@ d.Validate x |> unbox = validate x @> } @@ -1598,9 +1698,10 @@ module cmd = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmd(fail) + let binding = bindingName |> Binding.cmd (fail) test <@ binding.Name = bindingName @> } @@ -1611,9 +1712,10 @@ module cmd = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmd(obj()) + let binding = bindingName |> Binding.cmd (obj ()) test <@ binding.Name = bindingName @> } @@ -1627,9 +1729,10 @@ module cmdIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdIf(fail, fail, id) + let binding = bindingName |> Binding.cmdIf (fail, fail, id) test <@ binding.Name = bindingName @> } @@ -1639,9 +1742,10 @@ module cmdIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdIf(obj(), fail) + let binding = bindingName |> Binding.cmdIf (obj (), fail) test <@ binding.Name = bindingName @> } @@ -1652,9 +1756,10 @@ module cmdIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdIf(fail: _ -> _ voption) + let binding = bindingName |> Binding.cmdIf (fail: _ -> _ voption) test <@ binding.Name = bindingName @> } @@ -1665,9 +1770,10 @@ module cmdIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdIf(fail: _ -> _ option) + let binding = bindingName |> Binding.cmdIf (fail: _ -> _ option) test <@ binding.Name = bindingName @> } @@ -1678,9 +1784,10 @@ module cmdIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdIf(fail: _ -> Result<_,_>) + let binding = bindingName |> Binding.cmdIf (fail: _ -> Result<_, _>) test <@ binding.Name = bindingName @> } @@ -1694,21 +1801,23 @@ module cmdParam = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParam(fail2) + let binding = bindingName |> Binding.cmdParam (fail2) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec wrapped in ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) (m: int) = unbox p + string m - let d = Binding.cmdParam(exec) |> getCmdData + let d = Binding.cmdParam (exec) |> getCmdData test <@ d.Exec (box p) m = (exec p m |> ValueSome) @> } @@ -1716,18 +1825,20 @@ module cmdParam = [] let ``canExec always returns true`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto - let d = Binding.cmdParam(fail2) |> getCmdData + let d = Binding.cmdParam (fail2) |> getCmdData test <@ d.CanExec (box p) m = true @> } [] let ``autoRequery is false`` () = - Property.check <| property { - let d = Binding.cmdParam(fail2) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParam (fail2) |> getCmdData test <@ d.AutoRequery = false @> } @@ -1738,21 +1849,23 @@ module cmdParam = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParam(fail: obj -> obj) + let binding = bindingName |> Binding.cmdParam (fail: obj -> obj) test <@ binding.Name = bindingName @> } [] let ``final exec returns original value wrapped in ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = string p - let d = Binding.cmdParam(exec) |> getCmdData + let d = Binding.cmdParam (exec) |> getCmdData test <@ d.Exec (box p) m = (exec p |> ValueSome) @> } @@ -1760,18 +1873,20 @@ module cmdParam = [] let ``canExec always returns true`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto - let d = Binding.cmdParam(fail: obj -> obj) |> getCmdData + let d = Binding.cmdParam (fail: obj -> obj) |> getCmdData test <@ d.CanExec (box p) m = true @> } [] let ``autoRequery is false`` () = - Property.check <| property { - let d = Binding.cmdParam(fail: obj -> obj) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParam (fail: obj -> obj) |> getCmdData test <@ d.AutoRequery = false @> } @@ -1785,21 +1900,23 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail, fail, id) + let binding = bindingName |> Binding.cmdParamIf (fail, fail, id) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec wrapped in ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) (m: int) = unbox p + string m - let d = Binding.cmdParamIf(exec, fail) |> getCmdData + let d = Binding.cmdParamIf (exec, fail) |> getCmdData test <@ d.Exec (box p) m = (exec p m |> ValueSome) @> } @@ -1807,12 +1924,13 @@ module cmdParamIf = [] let ``final canExec returns value from original canExec`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let canExec (p: obj) m = (unbox p).Length + m > 0 - let d = Binding.cmdParamIf(fail, canExec) |> getCmdData + let d = Binding.cmdParamIf (fail, canExec) |> getCmdData test <@ d.CanExec (box p) m = canExec p m @> } @@ -1820,17 +1938,19 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf(fail, fail, false) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf (fail, fail, false) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf(fail, fail, uiBoundCmdParam) |> getCmdData + let d = Binding.cmdParamIf (fail, fail, uiBoundCmdParam) |> getCmdData test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -1840,21 +1960,23 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail2: _ -> _ -> _ voption) + let binding = bindingName |> Binding.cmdParamIf (fail2: _ -> _ -> _ voption) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) m = (p :?> string).Length + m |> ValueSome |> ValueOption.filter (fun x -> x > 0) - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.Exec (box p) m = exec p m @> } @@ -1862,12 +1984,13 @@ module cmdParamIf = [] let ``final canExec returns true if original exec returns ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) m = (p :?> string).Length + m |> ValueSome - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = true @> } @@ -1875,12 +1998,13 @@ module cmdParamIf = [] let ``final canExec returns false if original exec returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (_: obj) _ = ValueNone - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = false @> } @@ -1888,17 +2012,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail2: _ -> _ -> _ voption)) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail2: _ -> _ -> _ voption)) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail2: _ -> _ -> _ voption), uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail2: _ -> _ -> _ voption), uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -1909,21 +2039,23 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail2: _ -> _ -> _ option) + let binding = bindingName |> Binding.cmdParamIf (fail2: _ -> _ -> _ option) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec converted to ValueOption`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) m = (p :?> string).Length + m |> Some |> Option.filter (fun x -> x > 0) - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.Exec (box p) m = (exec p m |> ValueOption.ofOption) @> } @@ -1931,12 +2063,13 @@ module cmdParamIf = [] let ``final canExec returns true if original exec returns Some`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) m = (p :?> string).Length + m |> Some - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = true @> } @@ -1944,12 +2077,13 @@ module cmdParamIf = [] let ``final canExec returns false if original exec returns None`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (_: obj) _ = None - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = false @> } @@ -1957,17 +2091,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail2: _ -> _ -> _ option)) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail2: _ -> _ -> _ option)) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail2: _ -> _ -> _ option), uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail2: _ -> _ -> _ option), uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -1978,23 +2118,26 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail2: _ -> _ -> Result<_,_>) + let binding = bindingName |> Binding.cmdParamIf (fail2: _ -> _ -> Result<_, _>) test <@ binding.Name = bindingName @> } [] let ``final exec returns Ok value from original exec converted to ValueOption`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) m = let x = (p :?> string).Length + m - if x > 0 then Ok x else Error (string x) - let d = Binding.cmdParamIf(exec) |> getCmdData + if x > 0 then Ok x else Error(string x) + + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.Exec (box p) m = (exec p m |> ValueOption.ofOk) @> } @@ -2002,12 +2145,13 @@ module cmdParamIf = [] let ``final canExec returns true if original exec returns Ok`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) m = (p :?> string).Length + m |> Ok - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = true @> } @@ -2015,13 +2159,14 @@ module cmdParamIf = [] let ``final canExec returns false if original exec returns Error`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let! err = GenX.auto let exec (_: obj) _ = Error err - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = false @> } @@ -2029,17 +2174,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail2: _ -> _ -> Result<_,_>)) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail2: _ -> _ -> Result<_, _>)) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail2: _ -> _ -> Result<_,_>), uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail2: _ -> _ -> Result<_, _>), uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -2050,21 +2201,23 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf((fail: obj -> obj), fail) + let binding = bindingName |> Binding.cmdParamIf ((fail: obj -> obj), fail) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec wrapped in ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = (unbox p).Length - let d = Binding.cmdParamIf(exec, fail) |> getCmdData + let d = Binding.cmdParamIf (exec, fail) |> getCmdData test <@ d.Exec (box p) m = (exec p |> ValueSome) @> } @@ -2072,12 +2225,13 @@ module cmdParamIf = [] let ``final canExec returns value from original canExec`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let canExec (p: obj) = (unbox p).Length + m > 0 - let d = Binding.cmdParamIf(fail, canExec) |> getCmdData + let d = Binding.cmdParamIf (fail, canExec) |> getCmdData test <@ d.CanExec (box p) m = canExec p @> } @@ -2085,17 +2239,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail: obj -> obj), fail) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail: obj -> obj), fail) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail: obj -> obj), fail, uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail: obj -> obj), fail, uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -2105,21 +2265,23 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail: _ -> _ voption) + let binding = bindingName |> Binding.cmdParamIf (fail: _ -> _ voption) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = (p :?> string).Length |> ValueSome |> ValueOption.filter (fun x -> x > 0) - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.Exec (box p) m = exec p @> } @@ -2127,12 +2289,13 @@ module cmdParamIf = [] let ``final canExec returns true if original exec returns ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = (p :?> string).Length |> ValueSome - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = true @> } @@ -2140,12 +2303,13 @@ module cmdParamIf = [] let ``final canExec returns false if original exec returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (_: obj) = ValueNone - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = false @> } @@ -2153,17 +2317,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail: _ -> _ voption)) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail: _ -> _ voption)) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail: _ -> _ voption), uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail: _ -> _ voption), uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -2174,21 +2344,23 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail: _ -> _ option) + let binding = bindingName |> Binding.cmdParamIf (fail: _ -> _ option) test <@ binding.Name = bindingName @> } [] let ``final exec returns value from original exec converted to ValueOption`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = (p :?> string).Length |> Some |> Option.filter (fun x -> x > 0) - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.Exec (box p) m = (exec p |> ValueOption.ofOption) @> } @@ -2196,12 +2368,13 @@ module cmdParamIf = [] let ``final canExec returns true if original exec returns Some`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = (p :?> string).Length |> Some - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = true @> } @@ -2209,12 +2382,13 @@ module cmdParamIf = [] let ``final canExec returns false if original exec returns None`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (_: obj) = None - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = false @> } @@ -2222,17 +2396,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail: _ -> _ option)) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail: _ -> _ option)) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail: _ -> _ option), uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail: _ -> _ option), uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -2243,23 +2423,26 @@ module cmdParamIf = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.cmdParamIf(fail: _ -> Result<_,_>) + let binding = bindingName |> Binding.cmdParamIf (fail: _ -> Result<_, _>) test <@ binding.Name = bindingName @> } [] let ``final exec returns Ok value from original exec converted to ValueOption`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = let x = (p :?> string).Length - if x > 0 then Ok x else Error (string x) - let d = Binding.cmdParamIf(exec) |> getCmdData + if x > 0 then Ok x else Error(string x) + + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.Exec (box p) m = (exec p |> ValueOption.ofOk) @> } @@ -2267,12 +2450,13 @@ module cmdParamIf = [] let ``final canExec returns true if original exec returns Ok`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let exec (p: obj) = (p :?> string).Length |> Ok - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = true @> } @@ -2280,13 +2464,14 @@ module cmdParamIf = [] let ``final canExec returns false if original exec returns Error`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let! err = GenX.auto let exec (_: obj) = Error err - let d = Binding.cmdParamIf(exec) |> getCmdData + let d = Binding.cmdParamIf (exec) |> getCmdData test <@ d.CanExec (box p) m = false @> } @@ -2294,17 +2479,23 @@ module cmdParamIf = [] let ``final autoRequery defaults to false`` () = - Property.check <| property { - let d = Binding.cmdParamIf((fail: _ -> Result<_,_>)) |> getCmdData + Property.check + <| property { + let d = Binding.cmdParamIf ((fail: _ -> Result<_, _>)) |> getCmdData test <@ d.AutoRequery = false @> } [] let ``final autoRequery equals original uiBoundCmdParam`` () = - Property.check <| property { + Property.check + <| property { let! uiBoundCmdParam = GenX.auto - let d = Binding.cmdParamIf((fail: _ -> Result<_,_>), uiBoundCmdParam = uiBoundCmdParam) |> getCmdData + + let d = + Binding.cmdParamIf ((fail: _ -> Result<_, _>), uiBoundCmdParam = uiBoundCmdParam) + |> getCmdData + test <@ d.AutoRequery = uiBoundCmdParam @> } @@ -2318,29 +2509,32 @@ module subModel = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModel(fail, fail) + let binding = bindingName |> Binding.subModel (fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModel combines main model and return value of getSubModel, and wraps in ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string - let d = Binding.subModel(getSubModel, fail) |> getSubModelData + let d = Binding.subModel (getSubModel, fail) |> getSubModelData test <@ d.GetModel x = ((x, getSubModel x) |> box |> ValueSome) @> } [] let ``final toMsg simply unboxes`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto - let d = Binding.subModel((fun _ -> 0), fail) |> getSubModelData + let d = Binding.subModel ((fun _ -> 0), fail) |> getSubModelData test <@ d.ToMsg m (box x) = x @> } @@ -2351,31 +2545,34 @@ module subModel = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModel(fail, fail, fail) + let binding = bindingName |> Binding.subModel (fail, fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModel combines main model and return value of getSubModel, and wraps in ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string - let d = Binding.subModel(getSubModel, fail, fail) |> getSubModelData + let d = Binding.subModel (getSubModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ((x, getSubModel x) |> box |> ValueSome) @> } [] let ``final toMsg returns value from original toMsg`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto let toMsg = string - let d = Binding.subModel((fun _ -> 0), toMsg, fail) |> getSubModelData + let d = Binding.subModel ((fun _ -> 0), toMsg, fail) |> getSubModelData test <@ d.ToMsg m (box x) = toMsg x @> } @@ -2386,32 +2583,37 @@ module subModel = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModel(fail, fail, fail, fail) + let binding = bindingName |> Binding.subModel (fail, fail, fail, fail) test <@ binding.Name = bindingName @> } [] - let ``final getModel calls toBindingModel on main model and return value of getSubModel, and wraps in ValueSome`` () = - Property.check <| property { + let ``final getModel calls toBindingModel on main model and return value of getSubModel, and wraps in ValueSome`` + () + = + Property.check + <| property { let! x = GenX.auto let getSubModel = string let toBindingModel (m: int, s: string) = m + s.Length - let d = Binding.subModel(getSubModel, toBindingModel, fail, fail) |> getSubModelData + let d = Binding.subModel (getSubModel, toBindingModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ((x, getSubModel x) |> toBindingModel |> box |> ValueSome) @> } [] let ``final toMsg returns value from original toMsg`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto let toMsg = string - let d = Binding.subModel((fun _ -> 0), (fun _ -> 0), toMsg, fail) |> getSubModelData + let d = Binding.subModel ((fun _ -> 0), (fun _ -> 0), toMsg, fail) |> getSubModelData test <@ d.ToMsg m (box x) = toMsg x @> } @@ -2426,39 +2628,43 @@ module subModelOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelOpt((fail: _ -> _ voption), fail) + let binding = bindingName |> Binding.subModelOpt ((fail: _ -> _ voption), fail) test <@ binding.Name = bindingName @> } [] let ``final getModel combines main model and inner return value of getSubModel if ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string >> ValueSome - let d = Binding.subModelOpt(getSubModel, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail) |> getSubModelData test <@ d.GetModel x = ((x, (getSubModel x).Value) |> box |> ValueSome) @> } [] let ``final getModel returns ValueNone if getSubModel returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel (_: int) : string voption = ValueNone - let d = Binding.subModelOpt(getSubModel, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail) |> getSubModelData test <@ d.GetModel x = ValueNone @> } [] let ``final toMsg simply unboxes`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto - let d = Binding.subModelOpt((fun _ -> ValueSome 0), fail) |> getSubModelData + let d = Binding.subModelOpt ((fun _ -> ValueSome 0), fail) |> getSubModelData test <@ d.ToMsg m (box x) = x @> } @@ -2469,39 +2675,43 @@ module subModelOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelOpt((fail: _ -> _ option), fail) + let binding = bindingName |> Binding.subModelOpt ((fail: _ -> _ option), fail) test <@ binding.Name = bindingName @> } [] let ``final getModel combines main model and inner return value of getSubModel if ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string >> Some - let d = Binding.subModelOpt(getSubModel, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail) |> getSubModelData test <@ d.GetModel x = ((x, (getSubModel x).Value) |> box |> ValueSome) @> } [] let ``final getModel returns ValueNone if getSubModel returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel (_: int) : string option = None - let d = Binding.subModelOpt(getSubModel, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail) |> getSubModelData test <@ d.GetModel x = ValueNone @> } [] let ``final toMsg simply unboxes`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto - let d = Binding.subModelOpt((fun _ -> Some 0), fail) |> getSubModelData + let d = Binding.subModelOpt ((fun _ -> Some 0), fail) |> getSubModelData test <@ d.ToMsg m (box x) = x @> } @@ -2511,41 +2721,45 @@ module subModelOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelOpt((fail: _ -> _ voption), fail, fail) + let binding = bindingName |> Binding.subModelOpt ((fail: _ -> _ voption), fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModel combines main model and inner return value of getSubModel if ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string >> ValueSome - let d = Binding.subModelOpt(getSubModel, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ((x, (getSubModel x).Value) |> box |> ValueSome) @> } [] let ``final getModel returns ValueNone if getSubModel returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel (_: int) : string voption = ValueNone - let d = Binding.subModelOpt(getSubModel, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ValueNone @> } [] let ``final toMsg returns value from original toMsg`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto let toMsg = string - let d = Binding.subModelOpt((fun _ -> ValueSome 0), toMsg, fail) |> getSubModelData + let d = Binding.subModelOpt ((fun _ -> ValueSome 0), toMsg, fail) |> getSubModelData test <@ d.ToMsg m (box x) = toMsg x @> } @@ -2557,41 +2771,45 @@ module subModelOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelOpt((fail: _ -> _ option), fail, fail) + let binding = bindingName |> Binding.subModelOpt ((fail: _ -> _ option), fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModel combines main model and inner return value of getSubModel if ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string >> Some - let d = Binding.subModelOpt(getSubModel, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ((x, (getSubModel x).Value) |> box |> ValueSome) @> } [] let ``final getModel returns ValueNone if getSubModel returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel (_: int) : string option = None - let d = Binding.subModelOpt(getSubModel, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ValueNone @> } [] let ``final toMsg returns value from original toMsg`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto let toMsg = string - let d = Binding.subModelOpt((fun _ -> Some 0), toMsg, fail) |> getSubModelData + let d = Binding.subModelOpt ((fun _ -> Some 0), toMsg, fail) |> getSubModelData test <@ d.ToMsg m (box x) = toMsg x @> } @@ -2602,42 +2820,49 @@ module subModelOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelOpt((fail: _ -> _ voption), fail, fail, fail) + let binding = bindingName |> Binding.subModelOpt ((fail: _ -> _ voption), fail, fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModel calls toBindingModel on main model and inner return value of getSubModel if ValueSome`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string >> ValueSome let toBindingModel (m: int, s: string) = m + s.Length - let d = Binding.subModelOpt(getSubModel, toBindingModel, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, toBindingModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ((x, (getSubModel x).Value) |> toBindingModel |> box |> ValueSome) @> } [] let ``final getModel returns ValueNone if getSubModel returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel (_: int) : string voption = ValueNone - let d = Binding.subModelOpt(getSubModel, fail, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail, fail, fail) |> getSubModelData test <@ d.GetModel x = ValueNone @> } [] let ``final toMsg returns value from original toMsg`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto let toMsg = string - let d = Binding.subModelOpt((fun _ -> ValueSome 0), (fun _ -> ValueSome 0), toMsg, fail) |> getSubModelData + + let d = + Binding.subModelOpt ((fun _ -> ValueSome 0), (fun _ -> ValueSome 0), toMsg, fail) + |> getSubModelData test <@ d.ToMsg m (box x) = toMsg x @> } @@ -2649,42 +2874,49 @@ module subModelOpt = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelOpt((fail: _ -> _ option), fail, fail, fail) + let binding = bindingName |> Binding.subModelOpt ((fail: _ -> _ option), fail, fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModel calls toBindingModel on main model and inner return value of getSubModel if Some`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel = string >> Some let toBindingModel (m: int, s: string) = m + s.Length - let d = Binding.subModelOpt(getSubModel, toBindingModel, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, toBindingModel, fail, fail) |> getSubModelData test <@ d.GetModel x = ((x, (getSubModel x).Value) |> toBindingModel |> box |> ValueSome) @> } [] let ``final getModel returns ValueNone if getSubModel returns ValueNone`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let getSubModel (_: int) : string option = None - let d = Binding.subModelOpt(getSubModel, fail, fail, fail) |> getSubModelData + let d = Binding.subModelOpt (getSubModel, fail, fail, fail) |> getSubModelData test <@ d.GetModel x = ValueNone @> } [] let ``final toMsg returns value from original toMsg`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! x = GenX.auto let toMsg = string - let d = Binding.subModelOpt((fun _ -> Some 0), (fun _ -> Some 0), toMsg, fail) |> getSubModelData + + let d = + Binding.subModelOpt ((fun _ -> Some 0), (fun _ -> Some 0), toMsg, fail) + |> getSubModelData test <@ d.ToMsg m (box x) = toMsg x @> } @@ -2698,31 +2930,36 @@ module subModelSeqKeyed = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSeq(fail, fail, fail) + let binding = bindingName |> Binding.subModelSeq (fail, fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModels returns tuples of the items returned by getSubModels and the main model`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto - let getSubModels : string -> char list = Seq.toList - let d = Binding.subModelSeq(getSubModels, fail, fail) |> getSubModelSeqKeyedData + let getSubModels: string -> char list = Seq.toList + let d = Binding.subModelSeq (getSubModels, fail, fail) |> getSubModelSeqKeyedData test <@ d.GetSubModels m |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map (fun s -> m, s)) @> } [] let ``final getId returns the ID of each element in final getModels`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto - let getSubModels : string -> char list = Seq.toList - let getId : char -> string = string - let d = Binding.subModelSeq(getSubModels, getId, fail) |> getSubModelSeqKeyedData - test <@ d.GetSubModels m |> Seq.map d.BmToId |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map getId) @> + let getSubModels: string -> char list = Seq.toList + let getId: char -> string = string + let d = Binding.subModelSeq (getSubModels, getId, fail) |> getSubModelSeqKeyedData + + test + <@ d.GetSubModels m |> Seq.map d.BmToId |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map getId) @> } @@ -2731,67 +2968,97 @@ module subModelSeqKeyed = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSeq(fail, fail, fail, fail) + let binding = bindingName |> Binding.subModelSeq (fail, fail, fail, fail) test <@ binding.Name = bindingName @> } [] let ``final getModels returns tuples of the items returned by getSubModels and the main model`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto - let getSubModels : string -> char list = Seq.toList - let d = Binding.subModelSeq(getSubModels, fail, fail, fail) |> getSubModelSeqKeyedData + let getSubModels: string -> char list = Seq.toList + let d = Binding.subModelSeq (getSubModels, fail, fail, fail) |> getSubModelSeqKeyedData test <@ d.GetSubModels m |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map (fun s -> m, s)) @> } [] let ``final getId returns the ID of each element in final getModels`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto - let getSubModels : string -> char list = Seq.toList - let getId : char -> string = string - let d = Binding.subModelSeq(getSubModels, getId, fail, fail) |> getSubModelSeqKeyedData - test <@ d.GetSubModels m |> Seq.map d.BmToId |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map getId) @> + let getSubModels: string -> char list = Seq.toList + let getId: char -> string = string + let d = Binding.subModelSeq (getSubModels, getId, fail, fail) |> getSubModelSeqKeyedData + + test + <@ d.GetSubModels m |> Seq.map d.BmToId |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map getId) @> } module toMsg_toBindingModel = - [] - let ``sets the correct binding name`` () = - Property.check <| property { - let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSeq(fail, fail, fail, fail, fail) - test <@ binding.Name = bindingName @> - } + [] + let ``sets the correct binding name`` () = + Property.check + <| property { + let! bindingName = GenX.auto + let binding = bindingName |> Binding.subModelSeq (fail, fail, fail, fail, fail) + test <@ binding.Name = bindingName @> + } + + + [] + let ``final getModels returns output of toBindingModel called with tuples of the items returned by getSubModels and the main model`` + () + = + Property.check + <| property { + let! m = GenX.auto + let getSubModels: string -> char list = Seq.toList + let toBindingModel (m: string, c: char) = (m + string c).Length + + let d = + Binding.subModelSeq (getSubModels, toBindingModel, fail, fail, fail) + |> getSubModelSeqKeyedData + + test + <@ + d.GetSubModels m |> Seq.map unbox |> Seq.toList = (m + |> getSubModels + |> List.map (fun s -> toBindingModel (m, s))) + @> + } - [] - let ``final getModels returns output of toBindingModel called with tuples of the items returned by getSubModels and the main model`` () = - Property.check <| property { - let! m = GenX.auto - let getSubModels : string -> char list = Seq.toList - let toBindingModel (m: string, c: char) = (m + string c).Length - let d = Binding.subModelSeq(getSubModels, toBindingModel, fail, fail, fail) |> getSubModelSeqKeyedData - test <@ d.GetSubModels m |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map (fun s -> toBindingModel (m, s))) @> - } + [] + let ``final getId returns the ID of each element in final getModels`` () = + Property.check + <| property { + let! m = GenX.auto + let getSubModels: string -> char list = Seq.toList + let toBindingModel (m: string, c: char) = (m + string c).Length + let getId i = i * 2 + let d = + Binding.subModelSeq (getSubModels, toBindingModel, getId, fail, fail) + |> getSubModelSeqKeyedData - [] - let ``final getId returns the ID of each element in final getModels`` () = - Property.check <| property { - let! m = GenX.auto - let getSubModels : string -> char list = Seq.toList - let toBindingModel (m: string, c: char) = (m + string c).Length - let getId i = i * 2 - let d = Binding.subModelSeq(getSubModels, toBindingModel, getId, fail, fail) |> getSubModelSeqKeyedData - test <@ d.GetSubModels m |> Seq.map d.BmToId |> Seq.map unbox |> Seq.toList = (m |> getSubModels |> List.map (fun s -> toBindingModel (m, s)) |> List.map getId) @> - } + test + <@ + d.GetSubModels m |> Seq.map d.BmToId |> Seq.map unbox |> Seq.toList = (m + |> getSubModels + |> List.map (fun s -> + toBindingModel (m, s)) + |> List.map getId) + @> + } @@ -2803,41 +3070,49 @@ module subModelSelectedItem = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSelectedItem("", (fail: _ -> _ voption), fail2) + let binding = bindingName |> Binding.subModelSelectedItem ("", (fail: _ -> _ voption), fail2) test <@ binding.Name = bindingName @> } [] let ``sets the correct subModelSeqBindingName`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto - let d = Binding.subModelSelectedItem(name, (fail: _ -> _ voption), fail2) |> getSubModelSelectedItemData + + let d = + Binding.subModelSelectedItem (name, (fail: _ -> _ voption), fail2) + |> getSubModelSelectedItemData + test <@ d.SubModelSeqBindingName = name @> } [] let ``final get returns value from original get`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! useNone = Gen.bool let get (x: int) = if useNone then ValueNone else x |> string |> ValueSome - let d = Binding.subModelSelectedItem("", get, fail2) |> getSubModelSelectedItemData + let d = Binding.subModelSelectedItem ("", get, fail2) |> getSubModelSelectedItemData test <@ d.Get x |> ValueOption.map unbox = get x @> } [] let ``final set returns value from original set`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let get _ = ValueNone let set (p: string voption) m = p |> ValueOption.map (fun p -> p.Length + m |> string) - let d = Binding.subModelSelectedItem("", get, set) |> getSubModelSelectedItemData + let d = Binding.subModelSelectedItem ("", get, set) |> getSubModelSelectedItemData test <@ d.Set (p |> ValueOption.map box) m = set p m @> } @@ -2847,41 +3122,49 @@ module subModelSelectedItem = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSelectedItem("", (fail: _ -> _ option), fail2) + let binding = bindingName |> Binding.subModelSelectedItem ("", (fail: _ -> _ option), fail2) test <@ binding.Name = bindingName @> } [] let ``sets the correct subModelSeqBindingName`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto - let d = Binding.subModelSelectedItem(name, (fail: _ -> _ option), fail2) |> getSubModelSelectedItemData + + let d = + Binding.subModelSelectedItem (name, (fail: _ -> _ option), fail2) + |> getSubModelSelectedItemData + test <@ d.SubModelSeqBindingName = name @> } [] let ``final get returns value from original get converted to ValueOption`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! useNone = Gen.bool let get (x: int) = if useNone then None else x |> string |> Some - let d = Binding.subModelSelectedItem("", get, fail2) |> getSubModelSelectedItemData + let d = Binding.subModelSelectedItem ("", get, fail2) |> getSubModelSelectedItemData test <@ d.Get x |> ValueOption.map unbox = (get x |> ValueOption.ofOption) @> } [] let ``final set returns value from original set`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let get _ = None let set (p: string option) m = p |> Option.map (fun p -> p.Length + m |> string) - let d = Binding.subModelSelectedItem("", get, set) |> getSubModelSelectedItemData + let d = Binding.subModelSelectedItem ("", get, set) |> getSubModelSelectedItemData test <@ d.Set (p |> Option.map box |> ValueOption.ofOption) m = set p m @> } @@ -2889,45 +3172,61 @@ module subModelSelectedItem = module voption_noSetModel = - [] - let ``sets the correct binding name`` () = - Property.check <| property { - let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSelectedItem("", (fail: _ -> _ voption), (fail: _ -> obj)) - test <@ binding.Name = bindingName @> - } + [] + let ``sets the correct binding name`` () = + Property.check + <| property { + let! bindingName = GenX.auto + let binding = + bindingName + |> Binding.subModelSelectedItem ("", (fail: _ -> _ voption), (fail: _ -> obj)) - [] - let ``sets the correct subModelSeqBindingName`` () = - Property.check <| property { - let! name = GenX.auto - let d = Binding.subModelSelectedItem(name, (fail: _ -> _ voption), (fail: _ -> obj)) |> getSubModelSelectedItemData - test <@ d.SubModelSeqBindingName = name @> - } + test <@ binding.Name = bindingName @> + } - [] - let ``final get returns value from original get`` () = - Property.check <| property { - let! x = GenX.auto - let! useNone = Gen.bool - let get (x: int) = if useNone then ValueNone else x |> string |> ValueSome - let d = Binding.subModelSelectedItem("", get, (fail: _ -> obj)) |> getSubModelSelectedItemData - test <@ d.Get x |> ValueOption.map unbox = get x @> - } + [] + let ``sets the correct subModelSeqBindingName`` () = + Property.check + <| property { + let! name = GenX.auto + let d = + Binding.subModelSelectedItem (name, (fail: _ -> _ voption), (fail: _ -> obj)) + |> getSubModelSelectedItemData - [] - let ``final set returns value from original set`` () = - Property.check <| property { - let! m = GenX.auto - let! p = GenX.auto - let get _ = ValueNone - let set (p: string voption) = p |> ValueOption.map (fun p -> p.Length |> string) - let d = Binding.subModelSelectedItem("", get, set) |> getSubModelSelectedItemData - test <@ d.Set (p |> ValueOption.map box) m = set p @> - } + test <@ d.SubModelSeqBindingName = name @> + } + + + [] + let ``final get returns value from original get`` () = + Property.check + <| property { + let! x = GenX.auto + let! useNone = Gen.bool + let get (x: int) = if useNone then ValueNone else x |> string |> ValueSome + + let d = + Binding.subModelSelectedItem ("", get, (fail: _ -> obj)) + |> getSubModelSelectedItemData + + test <@ d.Get x |> ValueOption.map unbox = get x @> + } + + + [] + let ``final set returns value from original set`` () = + Property.check + <| property { + let! m = GenX.auto + let! p = GenX.auto + let get _ = ValueNone + let set (p: string voption) = p |> ValueOption.map (fun p -> p.Length |> string) + let d = Binding.subModelSelectedItem ("", get, set) |> getSubModelSelectedItemData + test <@ d.Set (p |> ValueOption.map box) m = set p @> + } module option_noSetModel = @@ -2935,41 +3234,57 @@ module subModelSelectedItem = [] let ``sets the correct binding name`` () = - Property.check <| property { + Property.check + <| property { let! bindingName = GenX.auto - let binding = bindingName |> Binding.subModelSelectedItem("", (fail: _ -> _ option), (fail: _ -> obj)) + + let binding = + bindingName + |> Binding.subModelSelectedItem ("", (fail: _ -> _ option), (fail: _ -> obj)) + test <@ binding.Name = bindingName @> } [] let ``sets the correct subModelSeqBindingName`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto - let d = Binding.subModelSelectedItem(name, (fail: _ -> _ option), (fail: _ -> obj)) |> getSubModelSelectedItemData + + let d = + Binding.subModelSelectedItem (name, (fail: _ -> _ option), (fail: _ -> obj)) + |> getSubModelSelectedItemData + test <@ d.SubModelSeqBindingName = name @> } [] let ``final get returns value from original get converted to ValueOption`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! useNone = Gen.bool let get (x: int) = if useNone then None else x |> string |> Some - let d = Binding.subModelSelectedItem("", get, (fail: _ -> obj)) |> getSubModelSelectedItemData + + let d = + Binding.subModelSelectedItem ("", get, (fail: _ -> obj)) + |> getSubModelSelectedItemData + test <@ d.Get x |> ValueOption.map unbox = (get x |> ValueOption.ofOption) @> } [] let ``final set returns value from original set`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let! p = GenX.auto let get _ = None let set (p: string option) = p |> Option.map (fun p -> p.Length |> string) - let d = Binding.subModelSelectedItem("", get, set) |> getSubModelSelectedItemData + let d = Binding.subModelSelectedItem ("", get, set) |> getSubModelSelectedItemData test <@ d.Set (p |> Option.map box |> ValueOption.ofOption) m = set p @> } @@ -2980,16 +3295,33 @@ module sorting = open BindingVmHelpers [] - let ``SubModelSelectedItemData sorted last`` () = - Property.check <| property { - let! s = GenX.auto - let data = - [ SubModelSelectedItemData { Get = fail; Set = fail2; SubModelSeqBindingName = s } - SubModelSeqKeyedData { GetSubModels = fail; BmToId = fail; CreateViewModel = fail; CreateCollection = fail; UpdateViewModel = fail; ToMsg = fail; VmToId = fail } - SubModelSelectedItemData { Get = fail; Set = fail2; SubModelSeqBindingName = s } - ] |> List.map BaseBindingData - let sorted = data |> List.sortWith (SubModelSelectedItemLast().CompareBindingDatas()) - match sorted with - | [_; BaseBindingData (SubModelSelectedItemData _); BaseBindingData (SubModelSelectedItemData _)] -> () - | _ -> failwith "SubModelSelectedItemData was not sorted last" - } + let ``SubModelSelectedItemData sorted last`` () = + Property.check + <| property { + let! s = GenX.auto + + let data = + [ SubModelSelectedItemData + { Get = fail + Set = fail2 + SubModelSeqBindingName = s } + SubModelSeqKeyedData + { GetSubModels = fail + BmToId = fail + CreateViewModel = fail + CreateCollection = fail + UpdateViewModel = fail + ToMsg = fail + VmToId = fail } + SubModelSelectedItemData + { Get = fail + Set = fail2 + SubModelSeqBindingName = s } ] + |> List.map BaseBindingData + + let sorted = data |> List.sortWith (SubModelSelectedItemLast().CompareBindingDatas()) + + match sorted with + | [ _; BaseBindingData(SubModelSelectedItemData _); BaseBindingData(SubModelSelectedItemData _) ] -> () + | _ -> failwith "SubModelSelectedItemData was not sorted last" + } \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/BindingVmHelpersTests.fs b/src/Elmish.WPF.Tests/BindingVmHelpersTests.fs index 91e96e7b..5978559e 100644 --- a/src/Elmish.WPF.Tests/BindingVmHelpersTests.fs +++ b/src/Elmish.WPF.Tests/BindingVmHelpersTests.fs @@ -31,12 +31,13 @@ module Initialize = module Get = - let check<'a when 'a : equality> (g: Gen<'a>) = - Property.check <| property { + let check<'a when 'a: equality> (g: Gen<'a>) = + Property.check + <| property { let! expectedModel = g - let binding = - BindingData.OneWay.id + let binding = BindingData.OneWay.id + let vmBinding = Initialize(LoggingViewModelArgs.none, name, noGetSelectedItemCall) .Recursive(expectedModel, ignore, (fun () -> expectedModel), binding) @@ -60,8 +61,7 @@ module Get = let ``should return error on bad typing`` () = let binding = Binding.SubModel.opt (fun () -> []) >> Binding.mapModel (fun () -> None) <| "" - let dispatch msg = - failwith $"Should not dispatch, got {msg}" + let dispatch msg = failwith $"Should not dispatch, got {msg}" let vmBinding = Initialize(LoggingViewModelArgs.none, "Nothing", (fun _ -> failwith "Should not call get selected item")) @@ -70,22 +70,27 @@ module Get = let vmBinding2 = vmBinding |> MapOutputType.unboxVm - let getResult: Result = Get("Nothing").Recursive((), vmBinding2) + let getResult: Result = Get("Nothing").Recursive((), vmBinding2) - test <@ match getResult with | Error (GetError.ToNullError (ValueOption.ToNullError.ValueCannotBeNull _)) -> true | _ -> false @> + test + <@ + match getResult with + | Error(GetError.ToNullError(ValueOption.ToNullError.ValueCannotBeNull _)) -> true + | _ -> false + @> module Set = - let check<'a when 'a : equality> (g: Gen<'a>) = - Property.check <| property { + let check<'a when 'a: equality> (g: Gen<'a>) = + Property.check + <| property { let! initialModel = g let! newModel = g |> GenX.notEqualTo initialModel let model = ref initialModel let dispatch msg = model.Value <- msg - let binding = - BindingData.TwoWay.id - + let binding = BindingData.TwoWay.id + let vmBinding = Initialize(LoggingViewModelArgs.none, name, noGetSelectedItemCall) .Recursive(initialModel, dispatch, (fun () -> model.Value), binding) @@ -106,23 +111,22 @@ module Set = module Update = - let check<'a when 'a : equality> (g: Gen<'a>) = - Property.check <| property { + let check<'a when 'a: equality> (g: Gen<'a>) = + Property.check + <| property { let! initialModel = g let! newModel = g |> GenX.notEqualTo initialModel let model = ref initialModel let dispatch msg = failwith $"Should not dispatch message {msg}" - let binding = - BindingData.TwoWay.id + let binding = BindingData.TwoWay.id + let vmBinding = Initialize(LoggingViewModelArgs.none, name, noGetSelectedItemCall) .Recursive(initialModel, dispatch, (fun () -> model.Value), binding) .Value - let updateResult = - Update(LoggingViewModelArgs.none, name) - .Recursive(initialModel, newModel, vmBinding) + let updateResult = Update(LoggingViewModelArgs.none, name).Recursive(initialModel, newModel, vmBinding) test <@ updateResult |> List.length = 1 @> } @@ -133,4 +137,4 @@ module Update = GenX.auto |> check GenX.auto |> check GenX.auto |> GenX.withNull |> check - GenX.auto |> GenX.withNull |> check + GenX.auto |> GenX.withNull |> check \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/DynamicViewModelTests.fs b/src/Elmish.WPF.Tests/DynamicViewModelTests.fs index baaa5bff..ef255d2d 100644 --- a/src/Elmish.WPF.Tests/DynamicViewModelTests.fs +++ b/src/Elmish.WPF.Tests/DynamicViewModelTests.fs @@ -21,81 +21,67 @@ module Extensions = type DynamicViewModel<'model, 'msg> with - member internal this.Get propName = - (?) this propName + member internal this.Get propName = (?) this propName - member internal this.Set propName value = - (?<-) this propName value + member internal this.Set propName value = (?<-) this propName value type internal TestVm<'model, 'msg>(model, bindings) as this = - inherit DynamicViewModel<'model, 'msg>({ initialModel = model; dispatch = (fun x -> this.Dispatch x); loggingArgs = LoggingViewModelArgs.none }, bindings) + inherit + DynamicViewModel<'model, 'msg>( + { initialModel = model + dispatch = (fun x -> this.Dispatch x) + loggingArgs = LoggingViewModelArgs.none }, + bindings + ) let pcTriggers = ConcurrentDictionary() let ecTriggers = ConcurrentDictionary() let ccTriggers = ConcurrentDictionary() let cecTriggers = ConcurrentDictionary() - let dispatchMsgs = ResizeArray<'msg> () + let dispatchMsgs = ResizeArray<'msg>() do - (this :> INotifyPropertyChanged).PropertyChanged.Add (fun e -> - pcTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore - ) + (this :> INotifyPropertyChanged) + .PropertyChanged.Add(fun e -> pcTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore) - (this :> INotifyDataErrorInfo).ErrorsChanged.Add (fun e -> - ecTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore - ) + (this :> INotifyDataErrorInfo) + .ErrorsChanged.Add(fun e -> ecTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore) - new(model, binding) = TestVm(model, [binding]) + new(model, binding) = TestVm(model, [ binding ]) - member _.UpdateModel(m) = IViewModel.updateModel(this, m) + member _.UpdateModel(m) = IViewModel.updateModel (this, m) - member private __.Dispatch x = - dispatchMsgs.Add x + member private __.Dispatch x = dispatchMsgs.Add x - member __.NumPcTriggersFor propName = - pcTriggers.TryGetValue propName |> snd + member __.NumPcTriggersFor propName = pcTriggers.TryGetValue propName |> snd - member __.NumEcTriggersFor propName = - ecTriggers.TryGetValue propName |> snd + member __.NumEcTriggersFor propName = ecTriggers.TryGetValue propName |> snd - member __.NumCcTriggersFor propName = - ccTriggers.GetOrAdd(propName, []).Length + member __.NumCcTriggersFor propName = ccTriggers.GetOrAdd(propName, []).Length - member __.NumCecTriggersFor propName = - cecTriggers.TryGetValue propName |> snd + member __.NumCecTriggersFor propName = cecTriggers.TryGetValue propName |> snd - member __.Dispatches = - dispatchMsgs |> Seq.toList + member __.Dispatches = dispatchMsgs |> Seq.toList - member __.CcTriggersFor propName = - ccTriggers.TryGetValue propName |> snd |> Seq.toList + member __.CcTriggersFor propName = ccTriggers.TryGetValue propName |> snd |> Seq.toList /// Starts tracking CollectionChanged triggers for the specified prop. /// Will cause the property to be retrieved. member this.TrackCcTriggersFor propName = try - (this.Get propName : INotifyCollectionChanged).CollectionChanged.Add (fun e -> - ccTriggers.AddOrUpdate( - propName, - [e], - (fun _ me -> e :: me)) |> ignore - ) + (this.Get propName: INotifyCollectionChanged) + .CollectionChanged.Add(fun e -> ccTriggers.AddOrUpdate(propName, [ e ], (fun _ me -> e :: me)) |> ignore) with _ -> - (this.Get propName |> unbox).CollectionChanged.Add (fun e -> - ccTriggers.AddOrUpdate( - propName, - [e], - (fun _ me -> e :: me)) |> ignore - ) + (this.Get propName |> unbox) + .CollectionChanged.Add(fun e -> ccTriggers.AddOrUpdate(propName, [ e ], (fun _ me -> e :: me)) |> ignore) /// Starts tracking CanExecuteChanged triggers for the specified prop. /// Will cause the property to be retrieved. member this.TrackCecTriggersFor propName = - (this.Get propName : ICommand).CanExecuteChanged.Add (fun _ -> - cecTriggers.AddOrUpdate(propName, 1, (fun _ count -> count + 1)) |> ignore - ) + (this.Get propName: ICommand) + .CanExecuteChanged.Add(fun _ -> cecTriggers.AddOrUpdate(propName, 1, (fun _ count -> count + 1)) |> ignore) @@ -107,11 +93,13 @@ module Helpers = let internal oneWayLazy x = x |> Func3.curry Binding.oneWayLazy let internal oneWaySeqLazy x = x |> Func5.curry Binding.oneWaySeqLazy let internal twoWay x = x |> Func2.curry Binding.twoWay + let internal twoWayValidate - name - (get: 'model -> 'a) - (set: 'a -> 'model -> 'msg) - (validate: 'model -> string voption) = + name + (get: 'model -> 'a) + (set: 'a -> 'model -> 'msg) + (validate: 'model -> string voption) + = Binding.twoWayValidate (get, set, validate) name @@ -119,34 +107,33 @@ module Helpers = - let internal cmdParam - name - (exec: 'a -> 'model -> 'msg voption) - (canExec: 'a -> 'model -> bool) - (autoRequery: bool) = + let internal cmdParam name (exec: 'a -> 'model -> 'msg voption) (canExec: 'a -> 'model -> bool) (autoRequery: bool) = ({ Exec = unbox >> exec CanExec = unbox >> canExec AutoRequery = autoRequery } |> CmdData |> BaseBindingData - |> createBinding) name + |> createBinding) + name let internal subModel - name - (getModel: 'model -> 'subModel voption) - (toMsg: 'subMsg -> 'msg) - (bindings: Binding<'subModel, 'subMsg> list) - (sticky: bool) = - Binding.subModelOpt(getModel, snd, toMsg, (fun () -> bindings), sticky) name + name + (getModel: 'model -> 'subModel voption) + (toMsg: 'subMsg -> 'msg) + (bindings: Binding<'subModel, 'subMsg> list) + (sticky: bool) + = + Binding.subModelOpt (getModel, snd, toMsg, (fun () -> bindings), sticky) name let internal subModelSeq - name - (getModels: 'model -> 'subModel list) - (getId: 'subModel -> 'id) - (toMsg: 'id * 'subMsg -> 'msg) - (bindings: Binding<'subModel, 'subMsg> list) = + name + (getModels: 'model -> 'subModel list) + (getId: 'subModel -> 'id) + (toMsg: 'id * 'subMsg -> 'msg) + (bindings: Binding<'subModel, 'subMsg> list) + = name |> Binding.subModelSeq (getBindings = (fun () -> bindings), getId = getId) |> Binding.mapModel (fun m -> upcast getModels m) @@ -155,10 +142,11 @@ module Helpers = let internal subModelSelectedItem - name - subModelSeqBindingName - (get: 'model -> 'id voption) - (set: 'id voption -> 'model -> 'msg) = + name + subModelSeqBindingName + (get: 'model -> 'id voption) + (set: 'id voption -> 'model -> 'msg) + = Binding.subModelSelectedItem (subModelSeqBindingName, get, set) name @@ -168,7 +156,8 @@ module OneWay = [] let ``when retrieved, should always return the value returned by get`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -183,12 +172,13 @@ module OneWay = vm.UpdateModel m2 test <@ vm.Get name = get m2 @> - } + } [] let ``when model is updated, should trigger PC once iff the return value of get changes`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -200,7 +190,7 @@ module OneWay = vm.UpdateModel m2 test <@ vm.NumPcTriggersFor name = if get m1 = get m2 then 0 else 1 @> - } + } [] let ``on model increment, sticky-to-even binding returns even number`` () = @@ -211,20 +201,22 @@ module OneWay = | b when isEven b -> b | _ -> a - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let binding = oneWay id name |> Binding.addSticky isEven let vm = TestVm(m, binding) - vm.UpdateModel (m + 1) + vm.UpdateModel(m + 1) test <@ vm.Get name = returnEven m (m + 1) @> } [] let ``when model updated, event is not called before view model property is updated`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto |> GenX.notEqualTo m1 @@ -235,16 +227,16 @@ module OneWay = let vm = TestVm(m1, binding) let mutable eventFired = false - (vm :> INotifyPropertyChanged).PropertyChanged.Add (fun e -> - test <@ e.PropertyName = name @> - test <@ vm.Get name = get m2 @> - eventFired <- true - ) + (vm :> INotifyPropertyChanged) + .PropertyChanged.Add(fun e -> + test <@ e.PropertyName = name @> + test <@ vm.Get name = get m2 @> + eventFired <- true) vm.UpdateModel m2 test <@ eventFired @> - } + } @@ -253,7 +245,8 @@ module OneWayLazy = [] let ``when retrieved initially, should return the value returned by map`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto @@ -265,12 +258,13 @@ module OneWayLazy = let vm = TestVm(m, binding) test <@ vm.Get name = (m |> get |> map) @> - } + } [] let ``when retrieved after update and equals returns false, should return the value returned by map`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -284,12 +278,13 @@ module OneWayLazy = vm.UpdateModel m2 test <@ vm.Get name = (m2 |> get |> map) @> - } + } [] let ``when retrieved after update and equals returns true, should return the previous value returned by map`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -300,16 +295,19 @@ module OneWayLazy = let binding = oneWayLazy get equals map name let vm = TestVm(m1, binding) - vm.Get name |> ignore // populate cache + vm.Get name |> ignore // populate cache vm.UpdateModel m2 test <@ vm.Get name = (m1 |> get |> map) @> - } + } [] - let ``when retrieved, updated, and retrieved again, should call map once after the update iff equals returns false`` () = - Property.check <| property { + let ``when retrieved, updated, and retrieved again, should call map once after the update iff equals returns false`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -324,16 +322,17 @@ module OneWayLazy = vm.Get name |> ignore vm.UpdateModel m2 - map.Reset () + map.Reset() vm.Get name |> ignore test <@ map.Count = if eq then 0 else 1 @> - } + } [] let ``map should never be called during model update`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -348,12 +347,13 @@ module OneWayLazy = vm.UpdateModel m2 test <@ map.Count = 0 @> - } + } [] let ``when retrieved several times between updates, map is called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -369,7 +369,7 @@ module OneWayLazy = vm.Get name |> ignore test <@ map.Count <= 1 @> - map.Reset () + map.Reset() vm.UpdateModel m2 vm.Get name |> ignore vm.Get name |> ignore @@ -379,7 +379,8 @@ module OneWayLazy = [] let ``when model is updated, should trigger PC once iff equals is false`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -394,7 +395,7 @@ module OneWayLazy = vm.UpdateModel m2 test <@ vm.NumPcTriggersFor name = if not eq then 1 else 0 @> - } + } @@ -402,13 +403,14 @@ module OneWaySeqLazy = let private testObservableCollectionContainsExpectedItems (vm: DynamicViewModel<_, _>) name expected = - let actual = (vm.Get name : ObservableCollection<_>) |> Seq.toList + let actual = (vm.Get name: ObservableCollection<_>) |> Seq.toList test <@ expected = actual @> [] let ``when retrieved initially, should return an ObservableCollection with the values returned by map`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto @@ -426,8 +428,11 @@ module OneWaySeqLazy = [] - let ``given equals returns false, when retrieved after update, should return an ObservableCollection with the new values returned by map`` () = - Property.check <| property { + let ``given equals returns false, when retrieved after update, should return an ObservableCollection with the new values returned by map`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -448,8 +453,11 @@ module OneWaySeqLazy = [] - let ``given equals returns true, when retrieved after update, should return an ObservableCollection with the previous values returned by map`` () = - Property.check <| property { + let ``given equals returns true, when retrieved after update, should return an ObservableCollection with the previous values returned by map`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -471,7 +479,8 @@ module OneWaySeqLazy = [] let ``during VM instantiation, get should be called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! eq = Gen.bool @@ -491,7 +500,8 @@ module OneWaySeqLazy = [] let ``during VM instantiation, map should have be called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! eq = Gen.bool @@ -511,7 +521,8 @@ module OneWaySeqLazy = [] let ``given equals returns true, during model update, map should be called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -525,7 +536,7 @@ module OneWaySeqLazy = let binding = oneWaySeqLazy get equals map.Fn itemEquals getId name let vm = TestVm(m1, binding) - map.Reset () + map.Reset() vm.UpdateModel m2 test <@ map.Count = 0 @> @@ -534,7 +545,8 @@ module OneWaySeqLazy = [] let ``when equals returns false, during model update, map should be called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -548,7 +560,7 @@ module OneWaySeqLazy = let binding = oneWaySeqLazy get equals map.Fn itemEquals getId name let vm = TestVm(m1, binding) - map.Reset () + map.Reset() vm.UpdateModel m2 test <@ map.Count <= 1 @> @@ -557,7 +569,8 @@ module OneWaySeqLazy = [] let ``during model update, get should be called at most twice`` () = // once on current model and once on new model - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -572,7 +585,7 @@ module OneWaySeqLazy = let binding = oneWaySeqLazy get.Fn equals map itemEquals getId name let vm = TestVm(m1, binding) - get.Reset () + get.Reset() vm.UpdateModel m2 test <@ get.Count <= 2 @> @@ -581,7 +594,8 @@ module OneWaySeqLazy = [] let ``when retrieved several times after VM initialization, map is called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto @@ -603,7 +617,8 @@ module OneWaySeqLazy = [] let ``when retrieved several times after update, map is called at most once`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -617,7 +632,7 @@ module OneWaySeqLazy = let binding = oneWaySeqLazy get equals map.Fn itemEquals getId name let vm = TestVm(m1, binding) - map.Reset () + map.Reset() vm.UpdateModel m2 vm.Get name |> ignore @@ -628,8 +643,9 @@ module OneWaySeqLazy = [] - let ``for any behavior of equals or itemEquals, when model is updated, should never trigger PC`` () = // because this binding should only trigger CC - Property.check <| property { + let ``for any behavior of equals or itemEquals, when model is updated, should never trigger PC`` () = // because this binding should only trigger CC + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -653,7 +669,8 @@ module OneWaySeqLazy = [] let ``given equals returns true, when model is updated, should never trigger CC`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -675,8 +692,11 @@ module OneWaySeqLazy = [] - let ``given equals returns false and itemEquals returns false, when model is updated, should contain expected items in collection`` () = - Property.check <| property { + let ``given equals returns false and itemEquals returns false, when model is updated, should contain expected items in collection`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = Gen.guid |> Gen.list (Range.constant 1 50) let! m2 = Gen.guid |> Gen.list (Range.constant 1 50) @@ -702,7 +722,8 @@ module TwoWay = [] let ``when retrieved, should always return the value returned by get`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -718,12 +739,13 @@ module TwoWay = vm.UpdateModel m2 test <@ vm.Get name = get m2 @> - } + } [] let ``when model is updated, should trigger PC once iff the return value of get changes`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -736,12 +758,13 @@ module TwoWay = vm.UpdateModel m2 test <@ vm.NumPcTriggersFor name = if get m1 = get m2 then 0 else 1 @> - } + } [] let ``when set, should call dispatch once with the value returned by set`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! p = GenX.auto @@ -754,7 +777,7 @@ module TwoWay = vm.Set name p - test <@ vm.Dispatches = [set p m] @> + test <@ vm.Dispatches = [ set p m ] @> } @@ -764,7 +787,8 @@ module TwoWayValidate = [] let ``when retrieved, should always return the value returned by get`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -781,12 +805,13 @@ module TwoWayValidate = vm.UpdateModel m2 test <@ vm.Get name = get m2 @> - } + } [] let ``when model is updated, should trigger PC once iff the return value of get changes`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -801,12 +826,13 @@ module TwoWayValidate = vm.UpdateModel m2 test <@ vm.NumPcTriggersFor name = if get m1 = get m2 then 0 else 1 @> - } + } [] let ``when set, should call dispatch once with the value returned by set`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! p = GenX.auto @@ -820,20 +846,21 @@ module TwoWayValidate = vm.Set name p - test <@ vm.Dispatches = [set p m] @> + test <@ vm.Dispatches = [ set p m ] @> } [] let ``when model is updated, should trigger ErrorsChanged iff the value returned by validate changes`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto let get _ = () let set _ _ = () - let validate m = if m < 0 then ValueSome (string m) else ValueNone + let validate m = if m < 0 then ValueSome(string m) else ValueNone let binding = twoWayValidate name get set validate let vm = TestVm(m1, binding) @@ -845,8 +872,11 @@ module TwoWayValidate = [] - let ``when validate returns ValueNone, HasErrors should return false and GetErrors should return an empty collection`` () = - Property.check <| property { + let ``when validate returns ValueNone, HasErrors should return false and GetErrors should return an empty collection`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -870,50 +900,53 @@ module TwoWayValidate = [] - let ``when validate returns ValueSome, HasErrors should return true and GetErrors should return a collection with a single element equal to the inner value returned by validate`` () = - Property.check <| property { + let ``when validate returns ValueSome, HasErrors should return true and GetErrors should return a collection with a single element equal to the inner value returned by validate`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto let get _ = () let set _ _ = () - let validate m = ValueSome (string m) + let validate m = ValueSome(string m) let binding = twoWayValidate name get set validate let vm = TestVm(m1, binding) let vm' = vm :> INotifyDataErrorInfo test <@ vm'.HasErrors = true @> - test <@ vm'.GetErrors name |> Seq.cast |> Seq.toList = [(validate m1).Value] @> + test <@ vm'.GetErrors name |> Seq.cast |> Seq.toList = [ (validate m1).Value ] @> vm.UpdateModel m2 test <@ vm'.HasErrors = true @> - test <@ vm'.GetErrors name |> Seq.cast |> Seq.toList = [(validate m2).Value] @> + test <@ vm'.GetErrors name |> Seq.cast |> Seq.toList = [ (validate m2).Value ] @> } [] - let ``when validate returns no ValueNone after returning ValueSome, HasErrors should return false and GetErrors should return an empty collection`` () = - Property.check <| property { + let ``when validate returns no ValueNone after returning ValueSome, HasErrors should return false and GetErrors should return an empty collection`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto |> GenX.notEqualTo m1 let get _ = () let set _ _ = () - let validate m = - if m = m1 - then ValueSome (string m) - else ValueNone + let validate m = if m = m1 then ValueSome(string m) else ValueNone let binding = twoWayValidate name get set validate let vm = TestVm(m1, binding) let vm' = vm :> INotifyDataErrorInfo test <@ vm'.HasErrors = true @> - test <@ vm'.GetErrors name |> Seq.cast |> Seq.toList = [(validate m1).Value] @> + test <@ vm'.GetErrors name |> Seq.cast |> Seq.toList = [ (validate m1).Value ] @> vm.UpdateModel m2 @@ -928,50 +961,53 @@ module Cmd = [] let ``the retrieved command's Execute should call dispatch once with the inner value returned by exec`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! p = GenX.auto |> GenX.withNull - let exec m = if m < 0 then ValueNone else ValueSome (string m) + let exec m = if m < 0 then ValueNone else ValueSome(string m) let canExec m = m < 0 let binding = cmd exec canExec name let vm = TestVm(m, binding) - (vm.Get name : ICommand).Execute(p) + (vm.Get name: ICommand).Execute(p) match exec m with - | ValueSome msg -> test <@ vm.Dispatches = [msg] @> + | ValueSome msg -> test <@ vm.Dispatches = [ msg ] @> | ValueNone -> test <@ vm.Dispatches = [] @> } [] let ``the retrieved command's CanExecute should return the value returned by canExec`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! p = GenX.auto |> GenX.withNull - let exec m = if m < 0 then ValueNone else ValueSome (string m) + let exec m = if m < 0 then ValueNone else ValueSome(string m) let canExec m = m < 0 let binding = cmd exec canExec name let vm = TestVm(m, binding) - test <@ (vm.Get name : ICommand).CanExecute(p) = canExec m @> + test <@ (vm.Get name: ICommand).CanExecute(p) = canExec m @> } [] let ``when model is updated, should trigger CanExecuteChanged iff the output of canExec changes`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto - let exec m = if m < 0 then ValueNone else ValueSome (string m) + let exec m = if m < 0 then ValueNone else ValueSome(string m) let canExec m = m < 0 let binding = cmd exec canExec name @@ -986,12 +1022,13 @@ module Cmd = [] let ``when model is updated, should never trigger PC`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto - let exec m = if m < 0 then ValueNone else ValueSome (string m) + let exec m = if m < 0 then ValueNone else ValueSome(string m) let canExec m = m < 0 let binding = cmd exec canExec name @@ -1009,53 +1046,71 @@ module CmdParam = [] let ``the retrieved command's Execute should call dispatch once with the inner value returned by exec`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! p = GenX.auto let! autoRequery = Gen.bool - let exec (p: string) m = if p.Length + m < 0 then ValueNone else ValueSome (string m + p) + let exec (p: string) m = + if p.Length + m < 0 then + ValueNone + else + ValueSome(string m + p) + let canExec (p: string) m = p.Length + m < 0 let binding = cmdParam name exec canExec autoRequery let vm = TestVm(m, binding) - (vm.Get name : ICommand).Execute(p) + (vm.Get name: ICommand).Execute(p) match exec p m with - | ValueSome msg -> test <@ vm.Dispatches = [msg] @> + | ValueSome msg -> test <@ vm.Dispatches = [ msg ] @> | ValueNone -> test <@ vm.Dispatches = [] @> } [] let ``the retrieved command's CanExecute should return the value returned by canExec`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! p = GenX.auto let! autoRequery = Gen.bool - let exec (p: string) m = if p.Length + m < 0 then ValueNone else ValueSome (string m + p) + let exec (p: string) m = + if p.Length + m < 0 then + ValueNone + else + ValueSome(string m + p) + let canExec (p: string) m = p.Length + m < 0 let binding = cmdParam name exec canExec autoRequery let vm = TestVm(m, binding) - test <@ (vm.Get name : ICommand).CanExecute(p) = canExec p m @> + test <@ (vm.Get name: ICommand).CanExecute(p) = canExec p m @> } [] let ``when model is updated, should always trigger CanExecuteChanged`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto let! autoRequery = Gen.bool - let exec (p: string) m = if p.Length + m < 0 then ValueNone else ValueSome (string m + p) + let exec (p: string) m = + if p.Length + m < 0 then + ValueNone + else + ValueSome(string m + p) + let canExec (p: string) m = p.Length + m < 0 let binding = cmdParam name exec canExec autoRequery @@ -1070,13 +1125,19 @@ module CmdParam = [] let ``when model is updated, should never trigger PC`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto let! autoRequery = Gen.bool - let exec (p: string) m = if p.Length + m < 0 then ValueNone else ValueSome (string m + p) + let exec (p: string) m = + if p.Length + m < 0 then + ValueNone + else + ValueSome(string m + p) + let canExec (p: string) m = p.Length + m < 0 let binding = cmdParam name exec canExec autoRequery @@ -1093,8 +1154,11 @@ module SubModel = [] - let ``when retrieved and getModel returns ValueSome, should return a ViewModel whose CurrentModel is the inner value returned by getModel`` () = - Property.check <| property { + let ``when retrieved and getModel returns ValueSome, should return a ViewModel whose CurrentModel is the inner value returned by getModel`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -1106,17 +1170,18 @@ module SubModel = let binding = subModel name getModel toMsg [] sticky let vm = TestVm(m1, binding) - test <@ (vm.Get name : IViewModel).CurrentModel = (getModel m1).Value @> + test <@ (vm.Get name: IViewModel).CurrentModel = (getModel m1).Value @> vm.UpdateModel m2 - test <@ (vm.Get name : IViewModel).CurrentModel = (getModel m2).Value @> + test <@ (vm.Get name: IViewModel).CurrentModel = (getModel m2).Value @> } [] let ``when retrieved initially and getModel returns ValueNone, should return null`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto let! sticky = Gen.bool @@ -1132,12 +1197,15 @@ module SubModel = [] - let ``when retrieved after update and getModel changes between ValueSome and ValueNone, should return null if sticky is false, otherwise the last non-null value`` () = - Property.check <| property { + let ``when retrieved after update and getModel changes between ValueSome and ValueNone, should return null if sticky is false, otherwise the last non-null value`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto |> GenX.notEqualTo m1 - let! m3 = GenX.auto |> GenX.notEqualTo m1 |> GenX.notEqualTo m2 + let! m3 = GenX.auto |> GenX.notEqualTo m1 |> GenX.notEqualTo m2 let! sticky = Gen.bool let getModel (m: byte * int) = @@ -1145,29 +1213,33 @@ module SubModel = elif m = m2 then ValueNone elif m = m3 then (snd m) / 3 |> ValueSome else failwith "Should never happen" + let toMsg _ = () let binding = subModel name getModel toMsg [] sticky let vm = TestVm(m1, binding) - test <@ (vm.Get name : IViewModel).CurrentModel = (getModel m1).Value @> + test <@ (vm.Get name: IViewModel).CurrentModel = (getModel m1).Value @> vm.UpdateModel m2 if sticky then - test <@ (vm.Get name : IViewModel).CurrentModel = (getModel m1).Value @> + test <@ (vm.Get name: IViewModel).CurrentModel = (getModel m1).Value @> else test <@ vm.Get name |> isNull @> vm.UpdateModel m3 - test <@ (vm.Get name : IViewModel).CurrentModel = (getModel m3).Value @> + test <@ (vm.Get name: IViewModel).CurrentModel = (getModel m3).Value @> } [] - let ``when model is updated, should trigger PC once iff getModel changes from ValueNone to ValueSome, or from ValueSome to ValueNone when sticky is false`` () = - Property.check <| property { + let ``when model is updated, should trigger PC once iff getModel changes from ValueNone to ValueSome, or from ValueSome to ValueNone when sticky is false`` + () + = + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto |> GenX.notEqualTo m1 @@ -1185,16 +1257,20 @@ module SubModel = let wasNone = (getModel m1).IsNone let isSome = (getModel m2).IsSome let isNone = (getModel m2).IsNone - test <@ vm.NumPcTriggersFor name = - if wasNone && isSome then 1 - elif wasSome && isNone && not sticky then 1 - else 0 @> + + test + <@ + vm.NumPcTriggersFor name = if wasNone && isSome then 1 + elif wasSome && isNone && not sticky then 1 + else 0 + @> } [] let ``smoke test: when a sub-model OneWay binding is retrieved, returns the value returned by get`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! subName = GenX.auto let! m = GenX.auto @@ -1205,74 +1281,88 @@ module SubModel = let subGet = string let subBinding = oneWay subGet subName - let binding = subModel name getModel toMsg [subBinding] sticky + let binding = subModel name getModel toMsg [ subBinding ] sticky let vm = TestVm(m, binding) - test <@ (vm.Get name : DynamicViewModel).Get subName = ((getModel m).Value |> subGet) @> + test <@ (vm.Get name: DynamicViewModel).Get subName = ((getModel m).Value |> subGet) @> } [] - let ``smoke test: when a sub-model TwoWay binding is set, dispatches the value returned by set transformed by toMsg`` () = - Property.check <| property { + let ``smoke test: when a sub-model TwoWay binding is set, dispatches the value returned by set transformed by toMsg`` + () + = + Property.check + <| property { let! name = GenX.auto let! subName = GenX.auto let! m = GenX.auto let! p = GenX.auto let! sticky = Gen.bool - let getModel : byte * int -> int voption = snd >> ValueSome + let getModel: byte * int -> int voption = snd >> ValueSome let toMsg = String.length - let subGet : int -> string = string + let subGet: int -> string = string let subSet (p: string) (m: int) = p + string m let subBinding = twoWay subGet subSet subName - let binding = subModel name getModel toMsg [subBinding] sticky + let binding = subModel name getModel toMsg [ subBinding ] sticky let vm = TestVm(m, binding) - (vm.Get name : DynamicViewModel).Set subName p + (vm.Get name: DynamicViewModel).Set subName p - test <@ vm.Dispatches = [subSet p (getModel m).Value |> toMsg] @> + test <@ vm.Dispatches = [ subSet p (getModel m).Value |> toMsg ] @> } [] let ``setMsgWithModel given current model after new submodel created`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! subName = GenX.auto let! initialModel = GenX.auto let! newModel = GenX.auto |> GenX.notEqualTo initialModel let subBinding = cmd ValueSome (fun _ -> true) subName + let binding = - Binding.SubModel.opt (fun () -> [subBinding]) name + Binding.SubModel.opt (fun () -> [ subBinding ]) name |> Binding.mapModel (fun m -> if m <> initialModel then Some m else None) |> Binding.setMsgWithModel id + let vm = TestVm(initialModel, binding) vm.UpdateModel newModel - let subVm = vm.Get name : DynamicViewModel - let command = subVm.Get subName : ICommand + let subVm = vm.Get name: DynamicViewModel + let command = subVm.Get subName: ICommand command.Execute(true) - test <@ vm.Dispatches = [newModel] @> + test <@ vm.Dispatches = [ newModel ] @> } module SubModelSeq = - let private testObservableCollectionContainsExpectedItems (vm: DynamicViewModel) name expected = + let private testObservableCollectionContainsExpectedItems + (vm: DynamicViewModel) + name + expected + = let actual = vm.Get name |> unbox>> |> Seq.map IViewModel.currentModel |> Seq.toList + test <@ expected = actual @> [] - let ``when retrieved, should return an ObservableCollection with ViewModels whose CurrentModel is the corresponding value returned by getModels`` () = - Property.check <| property { + let ``when retrieved, should return an ObservableCollection with ViewModels whose CurrentModel is the corresponding value returned by getModels`` + () + = + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto @@ -1288,8 +1378,9 @@ module SubModelSeq = [] - let ``when model is updated, should never trigger PC`` () = // because this binding should only trigger CC - Property.check <| property { + let ``when model is updated, should never trigger PC`` () = // because this binding should only trigger CC + Property.check + <| property { let! name = GenX.auto let! m1 = GenX.auto let! m2 = GenX.auto @@ -1309,7 +1400,8 @@ module SubModelSeq = [] let ``given elements are the same, when model is updated, should not trigger CC`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! m = GenX.auto @@ -1330,7 +1422,8 @@ module SubModelSeq = [] let ``smoke test: when a sub-model OneWay binding is retrieved, returns the value returned by get`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! subName = GenX.auto let! m = GenX.auto @@ -1341,7 +1434,7 @@ module SubModelSeq = let subGet = string let subBinding = oneWay subGet subName - let binding = subModelSeq name getModels getId toMsg [subBinding] + let binding = subModelSeq name getModels getId toMsg [ subBinding ] let vm = TestVm(m, binding) let actual = @@ -1356,8 +1449,11 @@ module SubModelSeq = [] - let ``smoke test: when a sub-model TwoWay binding is set, dispatches the value returned by set transformed by toMsg`` () = - Property.check <| property { + let ``smoke test: when a sub-model TwoWay binding is set, dispatches the value returned by set transformed by toMsg`` + () + = + Property.check + <| property { let! name = GenX.auto let! subName = GenX.auto let! m = GenX.auto @@ -1370,7 +1466,7 @@ module SubModelSeq = let subSet (p: string) (m: Guid) = p + string m let subBinding = twoWay subGet subSet subName - let binding = subModelSeq name getModels getId toMsg [subBinding] + let binding = subModelSeq name getModels getId toMsg [ subBinding ] let vm = TestVm(m, binding) vm.Get name @@ -1388,17 +1484,19 @@ module SubModelSelectedItem = [] let ``Should return the VM corresponding to the ID that has been set`` () = - Property.check <| property { + Property.check + <| property { let! subModelSeqName = GenX.auto let! selectedItemName = GenX.auto |> GenX.notEqualTo subModelSeqName let! m = GenX.auto + let! selectedSubModel = match snd m with | [] -> Gen.constant ValueNone | xs -> Gen.item xs |> Gen.map ValueSome - let getModels : int * Guid list -> Guid list = snd - let getId : Guid -> string = string + let getModels: int * Guid list -> Guid list = snd + let getId: Guid -> string = string let toMsg = snd let get _ = selectedSubModel |> ValueOption.map getId @@ -1407,49 +1505,52 @@ module SubModelSelectedItem = let subModelSeqBinding = subModelSeq subModelSeqName getModels getId toMsg [] let selectedItemBinding = subModelSelectedItem selectedItemName subModelSeqName get set - let vm = TestVm(m, [subModelSeqBinding; selectedItemBinding]) + let vm = TestVm(m, [ subModelSeqBinding; selectedItemBinding ]) match selectedSubModel with - | ValueNone -> - test <@ vm.Get selectedItemName = null @> + | ValueNone -> test <@ vm.Get selectedItemName = null @> | ValueSome sm -> - test <@ (vm.Get selectedItemName |> unbox>) |> Option.ofObj |> Option.map (fun vm -> vm.CurrentModel) - = (m |> getModels |> List.tryFind (fun x -> getId x = getId sm)) - @> + test + <@ + (vm.Get selectedItemName |> unbox>) + |> Option.ofObj + |> Option.map (fun vm -> vm.CurrentModel) = (m |> getModels |> List.tryFind (fun x -> getId x = getId sm)) + @> } [] let ``when set, should dispatch the message returned by set`` () = - Property.check <| property { + Property.check + <| property { let! subModelSeqName = GenX.auto let! selectedItemName = GenX.auto |> GenX.notEqualTo subModelSeqName let! m = GenX.auto + let! selectedSubModel = match snd m with | [] -> Gen.constant ValueNone | xs -> Gen.item xs |> Gen.map ValueSome - let getModels : int * Guid list -> Guid list = snd - let getId : Guid -> string = string + let getModels: int * Guid list -> Guid list = snd + let getId: Guid -> string = string let toMsg = snd let get _ = selectedSubModel |> ValueOption.map getId - let set (p: string voption) (m: int * Guid list) = - p |> ValueOption.map (String.length >> (+) (fst m)) + let set (p: string voption) (m: int * Guid list) = p |> ValueOption.map (String.length >> (+) (fst m)) let subModelSeqBinding = subModelSeq subModelSeqName getModels getId toMsg [] let selectedItemBinding = subModelSelectedItem selectedItemName subModelSeqName get set - let vm = TestVm(m, [subModelSeqBinding; selectedItemBinding]) + let vm = TestVm(m, [ subModelSeqBinding; selectedItemBinding ]) let selectedVm = - selectedSubModel |> ValueOption.bind (fun sm -> + selectedSubModel + |> ValueOption.bind (fun sm -> vm.Get subModelSeqName |> unbox>> |> Seq.tryFind (fun vm -> vm |> IViewModel.currentModel |> getId = getId sm) - |> ValueOption.ofOption - ) + |> ValueOption.ofOption) |> ValueOption.toObj vm.Set selectedItemName selectedVm @@ -1461,19 +1562,24 @@ module SubModelSelectedItem = let ``attempting to select a nonexistent item throws RuntimeBinderException`` () = let selectedItemName = "Foo" let subModelSeqName = "Bar" + let bindings = [ selectedItemName |> Binding.subModelSelectedItem (subModelSeqName, Some, ignore) subModelSeqName |> Binding.subModelSeq ((fun _ -> []), ignore, (fun () -> [])) ] - let mutable error : string option = None + + let mutable error: string option = None + let loggingArgs = - { LoggingViewModelArgs.none - with + { LoggingViewModelArgs.none with log = - { new Microsoft.Extensions.Logging.ILogger - with - member _.BeginScope _ = { new IDisposable with member _.Dispose() = () } + { new Microsoft.Extensions.Logging.ILogger with + member _.BeginScope _ = + { new IDisposable with + member _.Dispose() = () } + member _.IsEnabled _ = true - member _.Log (_, _, state, ex, formatter) = error <- formatter.Invoke(state, ex) |> Some } } + member _.Log(_, _, state, ex, formatter) = error <- formatter.Invoke(state, ex) |> Some } } + let viewModelArgs = ViewModelArgs.create 0.0 ignore "main" loggingArgs let vm = DynamicViewModel(viewModelArgs, bindings) @@ -1487,20 +1593,21 @@ module CacheEffect = [] let ``model mapping called exactly once when Get called twice`` () = - Property.check <| property { + Property.check + <| property { let! name = GenX.auto let! model = GenX.auto let! bindingComponsitionOrder = Gen.bool let mapping = InvokeTester id + let cachingAndMapping = - if bindingComponsitionOrder - then Binding.mapModel mapping.Fn >> Binding.addCaching - else Binding.addCaching >> Binding.mapModel mapping.Fn - let binding = - name - |> Binding.OneWay.id - |> cachingAndMapping + if bindingComponsitionOrder then + Binding.mapModel mapping.Fn >> Binding.addCaching + else + Binding.addCaching >> Binding.mapModel mapping.Fn + + let binding = name |> Binding.OneWay.id |> cachingAndMapping let vm = TestVm(model, binding) vm.Get name |> ignore // populate cache @@ -1515,13 +1622,10 @@ module CacheEffect = let name = "" let model = 0 let newModel = 1 - let binding = - name - |> Binding.OneWay.id - |> Binding.addCaching + let binding = name |> Binding.OneWay.id |> Binding.addCaching let vm = TestVm(model, binding) - vm.Get name |> ignore // populate cache + vm.Get name |> ignore // populate cache vm.UpdateModel newModel // clear cache let actual = vm.Get name |> unbox @@ -1533,17 +1637,13 @@ module CacheEffect = let name = "" let initialModel = 0 let newModel = 1 - let mapping = InvokeTester (fun x -> x) - let binding = - name - |> Binding.TwoWay.id - |> Binding.mapModel mapping.Fn - |> Binding.addCaching + let mapping = InvokeTester(fun x -> x) + let binding = name |> Binding.TwoWay.id |> Binding.mapModel mapping.Fn |> Binding.addCaching let vm = TestVm(initialModel, binding) vm.Get name |> ignore // populate cache vm.Set name newModel - mapping.Reset() // Set calls mapping function, so reset count + mapping.Reset() // Set calls mapping function, so reset count let actual = vm.Get name |> unbox test <@ initialModel = actual @> @@ -1558,6 +1658,7 @@ module LazyEffect = let name = "" let model = 0 let mapping = InvokeTester id + let binding = name |> Binding.TwoWay.id @@ -1575,14 +1676,16 @@ module LazyEffect = let name = "" let model = 0 let mapping = InvokeTester id + let binding = name |> Binding.TwoWay.id |> Binding.addLazy (=) |> Binding.addLazy (=) |> Binding.mapModel mapping.Fn + let vm = TestVm(model, binding) - mapping.Reset () + mapping.Reset() vm.UpdateModel model @@ -1595,14 +1698,16 @@ module LazyEffect = let initialModel = 0 let newModel = 1 let mapping = InvokeTester id + let binding = name |> Binding.TwoWay.id |> Binding.addLazy (=) |> Binding.addLazy (=) |> Binding.mapModel mapping.Fn + let vm = TestVm(initialModel, binding) - mapping.Reset () + mapping.Reset() vm.UpdateModel newModel @@ -1619,12 +1724,10 @@ module AlterMsgStream = let get = ignore let set _ _ = () let alteration = InvokeTester id - let binding = - twoWay get set name - |> Binding.alterMsgStream alteration.Fn + let binding = twoWay get set name |> Binding.alterMsgStream alteration.Fn let vm = TestVm(model, binding) vm.Set name () vm.Set name () - test <@ 1 = alteration.Count @> + test <@ 1 = alteration.Count @> \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/MergeTests.fs b/src/Elmish.WPF.Tests/MergeTests.fs index 3ab11048..28c9563a 100644 --- a/src/Elmish.WPF.Tests/MergeTests.fs +++ b/src/Elmish.WPF.Tests/MergeTests.fs @@ -18,7 +18,7 @@ let internal merge x = x |> Merge.keyed let private trackCC (observableCollection: ObservableCollection<_>) = - let collection = Collection<_> () + let collection = Collection<_>() observableCollection.CollectionChanged.Add collection.Add collection @@ -29,11 +29,14 @@ let private testObservableCollectionContainsDataInArray observableCollection arr [] -let ``starting from empty, when items merged, should contain those items and call create exactly once for each item and never call update`` () = - Property.check <| property { +let ``starting from empty, when items merged, should contain those items and call create exactly once for each item and never call update`` + () + = + Property.check + <| property { let! array = GenX.auto - let observableCollection = ObservableCollection<_> () + let observableCollection = ObservableCollection<_>() let createTracker = InvokeTester2 createAsId let updateTracker = InvokeTester3 updateNoOp @@ -45,8 +48,11 @@ let ``starting from empty, when items merged, should contain those items and cal } [] -let ``starting with random items, when merging the same items, should still contain those items and never call create and call update exactly once for each item and trigger no CC event`` () = - Property.check <| property { +let ``starting with random items, when merging the same items, should still contain those items and never call create and call update exactly once for each item and trigger no CC event`` + () + = + Property.check + <| property { let! array = GenX.auto let observableCollection = ObservableCollection<_> array @@ -65,7 +71,8 @@ let ``starting with random items, when merging the same items, should still cont [] let ``starting with random items, when merging random items, should contain the random items`` () = - Property.check <| property { + Property.check + <| property { let! array1 = GenX.auto let! array2 = GenX.auto @@ -77,8 +84,11 @@ let ``starting with random items, when merging random items, should contain the } [] -let ``starting with random items, when merging after an addition, should contain the merged items and call create exactly once and call update exactly once for each original item`` () = - Property.check <| property { +let ``starting with random items, when merging after an addition, should contain the merged items and call create exactly once and call update exactly once for each original item`` + () + = + Property.check + <| property { let! list1 = GenX.auto let! addedItem = Gen.guid let! list2 = list1 |> Gen.constant |> GenX.addElement addedItem @@ -96,8 +106,11 @@ let ``starting with random items, when merging after an addition, should contain } [] -let ``starting with random items, when merging after a removal, should contain the merged items and never call create and call update exactly once for each remaining item`` () = - Property.check <| property { +let ``starting with random items, when merging after a removal, should contain the merged items and never call create and call update exactly once for each remaining item`` + () + = + Property.check + <| property { let! list2 = GenX.auto let! removedItem = Gen.guid let! list1 = list2 |> Gen.constant |> GenX.addElement removedItem @@ -115,8 +128,11 @@ let ``starting with random items, when merging after a removal, should contain t } [] -let ``starting with random items, when merging after a move, should contain the merged items and never call create and call update exactly once for each item`` () = - Property.check <| property { +let ``starting with random items, when merging after a move, should contain the merged items and never call create and call update exactly once for each item`` + () + = + Property.check + <| property { let! list = GenX.auto let! movedItem = Gen.guid let! additionalItem = Gen.guid @@ -138,8 +154,11 @@ let ``starting with random items, when merging after a move, should contain the } [] -let ``starting with random items, when merging after a replacement, should contain the merged items and call create exactly once and call update exactly once for each original item that remains`` () = - Property.check <| property { +let ``starting with random items, when merging after a replacement, should contain the merged items and call create exactly once and call update exactly once for each original item that remains`` + () + = + Property.check + <| property { let! list1Head = Gen.guid let! list1Tail = GenX.auto let! list2Replacement = Gen.guid @@ -147,10 +166,7 @@ let ``starting with random items, when merging after a replacement, should conta let list1 = list1Head :: list1Tail let observableCollection = ObservableCollection<_> list1 - let array2 = - list1 - |> List.replace replcementIndex list2Replacement - |> List.toArray + let array2 = list1 |> List.replace replcementIndex list2Replacement |> List.toArray let createTracker = InvokeTester2 createAsId let updateTracker = InvokeTester3 updateNoOp @@ -162,16 +178,16 @@ let ``starting with random items, when merging after a replacement, should conta } [] -let ``starting with random items, when merging after swapping two adjacent items, should contain the merged items and never call create and call update exactly once for each item`` () = - Property.check <| property { +let ``starting with random items, when merging after swapping two adjacent items, should contain the merged items and never call create and call update exactly once for each item`` + () + = + Property.check + <| property { let! list1 = Gen.guid |> Gen.list (Range.constant 2 50) let! firstSwapIndex = (0, list1.Length - 2) ||> Range.constant |> Gen.int32 let observableCollection = ObservableCollection<_> list1 - let array2 = - list1 - |> List.swap firstSwapIndex (firstSwapIndex + 1) - |> List.toArray + let array2 = list1 |> List.swap firstSwapIndex (firstSwapIndex + 1) |> List.toArray let createTracker = InvokeTester2 createAsId let updateTracker = InvokeTester3 updateNoOp @@ -183,17 +199,17 @@ let ``starting with random items, when merging after swapping two adjacent items } [] -let ``starting with random items, when merging after swapping two items, should contain the merged items and never call create and call update exactly once for each item`` () = - Property.check <| property { +let ``starting with random items, when merging after swapping two items, should contain the merged items and never call create and call update exactly once for each item`` + () + = + Property.check + <| property { let! list1 = Gen.guid |> Gen.list (Range.constant 2 50) let! i = (0, list1.Length - 1) ||> Range.constant |> Gen.int32 let! j = (0, list1.Length - 1) ||> Range.constant |> Gen.int32 |> GenX.notEqualTo i let observableCollection = ObservableCollection<_> list1 - let array2 = - list1 - |> List.swap i j - |> List.toArray + let array2 = list1 |> List.swap i j |> List.toArray let createTracker = InvokeTester2 createAsId let updateTracker = InvokeTester3 updateNoOp @@ -205,8 +221,11 @@ let ``starting with random items, when merging after swapping two items, should } [] -let ``starting with random items, when merging after shuffling, should contain the merged items and never call create and call update eactly once for each item`` () = - Property.check <| property { +let ``starting with random items, when merging after shuffling, should contain the merged items and never call create and call update eactly once for each item`` + () + = + Property.check + <| property { let! list1 = Gen.guid |> Gen.list (Range.constant 2 50) let! list2 = list1 |> GenX.shuffle |> GenX.notEqualTo list1 @@ -222,20 +241,24 @@ let ``starting with random items, when merging after shuffling, should contain t test <@ updateTracker.Count = array2.Length @> } -type TestClass (id: int, data: string) = +type TestClass(id: int, data: string) = member _.Id = id member _.Data = data override __.GetHashCode() = 0 + override __.Equals that = // All instances of TestClass are considered equal. // Not very helpful, but a valid implementation. that :? TestClass [] -let ``starting with two TestClass instances, when merging after removing the last one, should trigger CC-Remove for removed item`` () = +let ``starting with two TestClass instances, when merging after removing the last one, should trigger CC-Remove for removed item`` + () + = // In test name, using "CC-Remove" instead of "CC.Remove" to avoid this bug: // https://developercommunity.visualstudio.com/t/test-explorer-doesnt-show-tests-correctly-when-dot/297822 - Property.check <| property { + Property.check + <| property { let! id1 = GenX.auto let! id2 = GenX.auto |> GenX.notEqualTo id1 let! data1 = GenX.auto @@ -251,14 +274,23 @@ let ``starting with two TestClass instances, when merging after removing the las merge getId getId createAsId updateNoOp (observableCollection |> CollectionTarget.create) array2 - test <@ ((ccEvents - |> Seq.filter (fun e -> e.Action = NotifyCollectionChangedAction.Remove) - |> Seq.head).OldItems.[0] :?> TestClass).Id = tc2.Id @> + test + <@ + ((ccEvents + |> Seq.filter (fun e -> e.Action = NotifyCollectionChangedAction.Remove) + |> Seq.head) + .OldItems.[0] + :?> TestClass) + .Id = tc2.Id + @> } [] -let ``starting with two TestClass instances, when merging after updating the last one, should call update on updated item`` () = - Property.check <| property { +let ``starting with two TestClass instances, when merging after updating the last one, should call update on updated item`` + () + = + Property.check + <| property { let! id1 = GenX.auto let! id2 = GenX.auto |> GenX.notEqualTo id1 let! data1 = GenX.auto @@ -274,11 +306,10 @@ let ``starting with two TestClass instances, when merging after updating the las let getId (tc: TestClass) = tc.Id let mutable mTarget = None - let update target _ _ = - mTarget <- Some target + let update target _ _ = mTarget <- Some target merge getId getId createAsId update (observableCollection |> CollectionTarget.create) array2 let actual = mTarget test <@ actual.Value.Id = tc2.Id @> - } + } \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/StaticViewModelTests.fs b/src/Elmish.WPF.Tests/StaticViewModelTests.fs index a494fcb7..a9815979 100644 --- a/src/Elmish.WPF.Tests/StaticViewModelTests.fs +++ b/src/Elmish.WPF.Tests/StaticViewModelTests.fs @@ -15,69 +15,62 @@ open Elmish.WPF -type internal TestVm<'model, 'msg, 'B1>(model, binding: string -> Binding<'model,'msg>) as this = - inherit ViewModelBase<'model, 'msg>({ initialModel = model; dispatch = (fun x -> this.Dispatch x); loggingArgs = LoggingViewModelArgs.none }) +type internal TestVm<'model, 'msg, 'B1>(model, binding: string -> Binding<'model, 'msg>) as this = + inherit + ViewModelBase<'model, 'msg>( + { initialModel = model + dispatch = (fun x -> this.Dispatch x) + loggingArgs = LoggingViewModelArgs.none } + ) let pcTriggers = ConcurrentDictionary() let ecTriggers = ConcurrentDictionary() let ccTriggers = ConcurrentDictionary() let cecTriggers = ConcurrentDictionary() - let dispatchMsgs = ResizeArray<'msg> () + let dispatchMsgs = ResizeArray<'msg>() do - (this :> INotifyPropertyChanged).PropertyChanged.Add (fun e -> - pcTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore - ) + (this :> INotifyPropertyChanged) + .PropertyChanged.Add(fun e -> pcTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore) - (this :> INotifyDataErrorInfo).ErrorsChanged.Add (fun e -> - ecTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore - ) + (this :> INotifyDataErrorInfo) + .ErrorsChanged.Add(fun e -> ecTriggers.AddOrUpdate(e.PropertyName, 1, (fun _ count -> count + 1)) |> ignore) - member _.UpdateModel(m) = IViewModel.updateModel(this, m) + member _.UpdateModel(m) = IViewModel.updateModel (this, m) - member x.GetPropertyName = nameof(x.GetProperty) - member _.GetProperty = base.Get<'B1>() (binding >> Binding.unboxT) + member x.GetPropertyName = nameof (x.GetProperty) + member _.GetProperty = base.Get<'B1> () (binding >> Binding.unboxT) - member private __.Dispatch x = - dispatchMsgs.Add x + member private __.Dispatch x = dispatchMsgs.Add x - member __.NumPcTriggersFor propName = - pcTriggers.TryGetValue propName |> snd + member __.NumPcTriggersFor propName = pcTriggers.TryGetValue propName |> snd - member __.NumEcTriggersFor propName = - ecTriggers.TryGetValue propName |> snd + member __.NumEcTriggersFor propName = ecTriggers.TryGetValue propName |> snd - member __.NumCcTriggersFor propName = - ccTriggers.GetOrAdd(propName, []).Length + member __.NumCcTriggersFor propName = ccTriggers.GetOrAdd(propName, []).Length - member __.NumCecTriggersFor propName = - cecTriggers.TryGetValue propName |> snd + member __.NumCecTriggersFor propName = cecTriggers.TryGetValue propName |> snd - member __.Dispatches = - dispatchMsgs |> Seq.toList + member __.Dispatches = dispatchMsgs |> Seq.toList - member __.CcTriggersFor propName = - ccTriggers.TryGetValue propName |> snd |> Seq.toList + member __.CcTriggersFor propName = ccTriggers.TryGetValue propName |> snd |> Seq.toList /// Starts tracking CollectionChanged triggers for the specified prop. /// Will cause the property to be retrieved. - member this.TrackCcTriggersForGetProperty () = - (this.GetProperty |> unbox).CollectionChanged.Add - (fun e -> - ccTriggers.AddOrUpdate( - this.GetPropertyName, - [e], - (fun _ me -> e :: me)) |> ignore - ) + member this.TrackCcTriggersForGetProperty() = + (this.GetProperty |> unbox) + .CollectionChanged.Add(fun e -> + ccTriggers.AddOrUpdate(this.GetPropertyName, [ e ], (fun _ me -> e :: me)) + |> ignore) /// Starts tracking CanExecuteChanged triggers for the specified prop. /// Will cause the property to be retrieved. - member this.TrackCecTriggersForGetProperty () = - (this.GetProperty |> unbox).CanExecuteChanged.Add - (fun _ -> - cecTriggers.AddOrUpdate(this.GetPropertyName, 1, (fun _ count -> count + 1)) |> ignore - ) + member this.TrackCecTriggersForGetProperty() = + (this.GetProperty |> unbox) + .CanExecuteChanged.Add(fun _ -> + cecTriggers.AddOrUpdate(this.GetPropertyName, 1, (fun _ count -> count + 1)) + |> ignore) @@ -89,11 +82,13 @@ module Helpers = let internal oneWayLazy x = x |> Func3.curry Binding.oneWayLazy let internal oneWaySeqLazy x = x |> Func5.curry Binding.oneWaySeqLazy let internal twoWay x = x |> Func2.curry Binding.twoWay + let internal twoWayValidate - name - (get: 'model -> 'a) - (set: 'a -> 'model -> 'msg) - (validate: 'model -> string voption) = + name + (get: 'model -> 'a) + (set: 'a -> 'model -> 'msg) + (validate: 'model -> string voption) + = Binding.twoWayValidate (get, set, validate) name @@ -101,34 +96,33 @@ module Helpers = - let internal cmdParam - name - (exec: 'a -> 'model -> 'msg voption) - (canExec: 'a -> 'model -> bool) - (autoRequery: bool) = + let internal cmdParam name (exec: 'a -> 'model -> 'msg voption) (canExec: 'a -> 'model -> bool) (autoRequery: bool) = ({ Exec = unbox >> exec CanExec = unbox >> canExec AutoRequery = autoRequery } |> CmdData |> BaseBindingData - |> createBinding) name + |> createBinding) + name let internal subModel - name - (getModel: 'model -> 'subModel voption) - (toMsg: 'subMsg -> 'msg) - (bindings: Binding<'subModel, 'subMsg> list) - (sticky: bool) = - Binding.subModelOpt(getModel, snd, toMsg, (fun () -> bindings), sticky) name + name + (getModel: 'model -> 'subModel voption) + (toMsg: 'subMsg -> 'msg) + (bindings: Binding<'subModel, 'subMsg> list) + (sticky: bool) + = + Binding.subModelOpt (getModel, snd, toMsg, (fun () -> bindings), sticky) name let internal subModelSeq - name - (getModels: 'model -> 'subModel list) - (getId: 'subModel -> 'id) - (toMsg: 'id * 'subMsg -> 'msg) - (bindings: Binding<'subModel, 'subMsg> list) = + name + (getModels: 'model -> 'subModel list) + (getId: 'subModel -> 'id) + (toMsg: 'id * 'subMsg -> 'msg) + (bindings: Binding<'subModel, 'subMsg> list) + = name |> Binding.subModelSeq (getBindings = (fun () -> bindings), getId = getId) |> Binding.mapModel (fun m -> upcast getModels m) @@ -137,10 +131,11 @@ module Helpers = let internal subModelSelectedItem - name - subModelSeqBindingName - (get: 'model -> 'id voption) - (set: 'id voption -> 'model -> 'msg) = + name + subModelSeqBindingName + (get: 'model -> 'id voption) + (set: 'id voption -> 'model -> 'msg) + = Binding.subModelSelectedItem (subModelSeqBindingName, get, set) name @@ -149,7 +144,8 @@ module OneWay = [] let ``when retrieved, should always return the value returned by get`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto @@ -163,12 +159,13 @@ module OneWay = vm.UpdateModel m2 test <@ vm.GetProperty = get m2 @> - } + } [] let ``when model is updated, should trigger PC once iff the return value of get changes`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto @@ -180,7 +177,7 @@ module OneWay = vm.UpdateModel m2 test <@ vm.NumPcTriggersFor vm.GetPropertyName = if get m1 = get m2 then 0 else 1 @> - } + } [] let ``on model increment, sticky-to-even binding returns even number`` () = @@ -191,13 +188,14 @@ module OneWay = | b when isEven b -> b | _ -> a - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let binding = oneWay id >> Binding.addSticky isEven let vm = TestVm(m, binding) - vm.UpdateModel (m + 1) + vm.UpdateModel(m + 1) test <@ vm.GetProperty = returnEven m (m + 1) @> } @@ -206,7 +204,8 @@ module OneWayLazy = [] let ``when retrieved initially, should return the value returned by map`` () = - Property.check <| property { + Property.check + <| property { let! m = GenX.auto let get = string @@ -217,12 +216,13 @@ module OneWayLazy = let vm = TestVm(m, binding) test <@ vm.GetProperty = (m |> get |> map) @> - } + } [] let ``when retrieved after update and equals returns false, should return the value returned by map`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto @@ -235,12 +235,13 @@ module OneWayLazy = vm.UpdateModel m2 test <@ vm.GetProperty = (m2 |> get |> map) @> - } + } [] let ``when retrieved after update and equals returns true, should return the previous value returned by map`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto @@ -250,16 +251,19 @@ module OneWayLazy = let binding = oneWayLazy get equals map let vm = TestVm(m1, binding) - let _ = vm.GetProperty // populate cache + let _ = vm.GetProperty // populate cache vm.UpdateModel m2 test <@ vm.GetProperty = (m1 |> get |> map) @> - } + } [] - let ``when retrieved, updated, and retrieved again, should call map once after the update iff equals returns false`` () = - Property.check <| property { + let ``when retrieved, updated, and retrieved again, should call map once after the update iff equals returns false`` + () + = + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto let! eq = Gen.bool @@ -270,19 +274,20 @@ module OneWayLazy = let binding = oneWayLazy get equals map.Fn let vm = TestVm(m1, binding) - + let _ = vm.GetProperty vm.UpdateModel m2 - map.Reset () + map.Reset() let _ = vm.GetProperty test <@ map.Count = if eq then 0 else 1 @> - } + } [] let ``map should never be called during model update`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto @@ -299,12 +304,13 @@ module OneWayLazy = vm.UpdateModel m2 test <@ map.Count = 1 @> - } + } [] let ``when retrieved several times between updates, map is called at most once`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto @@ -314,12 +320,12 @@ module OneWayLazy = let binding = oneWayLazy get equals map.Fn let vm = TestVm(m1, binding) - + let _ = vm.GetProperty let _ = vm.GetProperty test <@ map.Count <= 1 @> - map.Reset () + map.Reset() vm.UpdateModel m2 let _ = vm.GetProperty let _ = vm.GetProperty @@ -329,7 +335,8 @@ module OneWayLazy = [] let ``when model is updated, should trigger PC once iff equals is false`` () = - Property.check <| property { + Property.check + <| property { let! m1 = GenX.auto let! m2 = GenX.auto let! eq = Gen.bool @@ -344,4 +351,4 @@ module OneWayLazy = vm.UpdateModel m2 test <@ vm.NumPcTriggersFor vm.GetPropertyName = if not eq then 1 else 0 @> - } + } \ No newline at end of file diff --git a/src/Elmish.WPF.Tests/UtilsTests.fs b/src/Elmish.WPF.Tests/UtilsTests.fs index e8694cf3..93ff91d0 100644 --- a/src/Elmish.WPF.Tests/UtilsTests.fs +++ b/src/Elmish.WPF.Tests/UtilsTests.fs @@ -12,7 +12,8 @@ module refEq = [] let ``returns true if the arguments are referentially equal`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let y = x test <@ refEq x y = true @> @@ -21,7 +22,8 @@ module refEq = [] let ``returns true if the arguments are not referentially equal`` () = - Property.check <| property { + Property.check + <| property { let! x = GenX.auto let! y = GenX.auto test <@ refEq x y = false @> @@ -42,7 +44,8 @@ module elmEq = let ``returns false if any non-string reference type member is not referentially equal`` () = PropertyConfig.defaultConfig |> PropertyConfig.withTests 1000 - |> Property.checkWith <| property { + |> Property.checkWith + <| property { let! x1 = GenX.auto let! y1 = GenX.auto let! x2 = GenX.auto @@ -54,10 +57,13 @@ module elmEq = [] - let ``returns false if all non-string reference type members are referentially equal and all string and value type members are structurally equal`` () = + let ``returns false if all non-string reference type members are referentially equal and all string and value type members are structurally equal`` + () + = PropertyConfig.defaultConfig |> PropertyConfig.withTests 1000 - |> Property.checkWith <| property { + |> Property.checkWith + <| property { let! x1 = GenX.auto let! y1 = GenX.auto let! x2 = GenX.auto @@ -78,7 +84,8 @@ module elmEq = let ``returns false if any non-string reference type member is not referentially equal`` () = PropertyConfig.defaultConfig |> PropertyConfig.withTests 1000 - |> Property.checkWith <| property { + |> Property.checkWith + <| property { let! t1 = GenX.auto let! t2 = GenX.auto test <@ elmEq t1 t2 = false @> @@ -86,10 +93,13 @@ module elmEq = [] - let ``returns false if all non-string reference type members are referentially equal and all string and value type members are structurally equal`` () = + let ``returns false if all non-string reference type members are referentially equal and all string and value type members are structurally equal`` + () + = PropertyConfig.defaultConfig |> PropertyConfig.withTests 1000 - |> Property.checkWith <| property { + |> Property.checkWith + <| property { let! t1 = GenX.auto let! t2 = GenX.auto let t2 = { t2 with t = t1.t } @@ -104,7 +114,8 @@ module ValueOption = module toNull = let testNonNull (ga: Gen<'a>) = - Property.check <| property { + Property.check + <| property { let! expected = ga test <@ Ok expected = (expected |> ValueSome |> ValueOption.toNull) @> } @@ -116,7 +127,7 @@ module ValueOption = testNonNull GenX.auto testNonNull GenX.auto - let testNullForNullable<'a when 'a : equality> () = + let testNullForNullable<'a when 'a: equality> () = test <@ Ok Unchecked.defaultof<'a> = ValueOption.toNull<'a> ValueNone @> [] @@ -126,7 +137,7 @@ module ValueOption = testNullForNullable> () testNullForNullable> () - let testNullForNonNullable<'a when 'a : equality> () = + let testNullForNonNullable<'a when 'a: equality> () = let expected = typeof<'a>.Name |> ValueOption.ToNullError.ValueCannotBeNull |> Error test <@ expected = ValueOption.toNull<'a> ValueNone @> @@ -145,7 +156,7 @@ module ValueOption = module ofNull = - let testNull<'a when 'a : equality> () = + let testNull<'a when 'a: equality> () = let input = Unchecked.defaultof<'a> test <@ ValueNone = ValueOption.ofNull input @> @@ -156,7 +167,8 @@ module ValueOption = testNull> () let testNonNull (ga: Gen<'a>) = - Property.check <| property { + Property.check + <| property { let! input = ga test <@ ValueSome input = ValueOption.ofNull input @> } @@ -165,4 +177,4 @@ module ValueOption = let ``ofNull returns ValueSome of input when input is nonnull`` () = testNonNull GenX.auto testNonNull GenX.auto - testNonNull GenX.auto + testNonNull GenX.auto \ No newline at end of file diff --git a/src/Elmish.WPF/Binding.fs b/src/Elmish.WPF/Binding.fs index 33d17008..4867130f 100644 --- a/src/Elmish.WPF/Binding.fs +++ b/src/Elmish.WPF/Binding.fs @@ -20,13 +20,14 @@ module Binding = let boxT (binding: Binding<'b, 'msg, 't>) = BindingData.boxT |> mapData <| binding /// Unboxes the output parameter - let unboxT (binding: Binding<'b, 'msg>): Binding<'b, 'msg, 't> = BindingData.unboxT |> mapData <| binding + let unboxT (binding: Binding<'b, 'msg>) : Binding<'b, 'msg, 't> = BindingData.unboxT |> mapData <| binding /// Maps the model of a binding via a contravariant mapping. let mapModel (f: 'a -> 'b) (binding: Binding<'b, 'msg, 't>) = f |> mapModel |> mapData <| binding /// Maps the message of a binding with access to the model via a covariant mapping. - let mapMsgWithModel (f: 'a -> 'model -> 'b) (binding: Binding<'model, 'a, 't>) = f |> mapMsgWithModel |> mapData <| binding + let mapMsgWithModel (f: 'a -> 'model -> 'b) (binding: Binding<'model, 'a, 't>) = + f |> mapMsgWithModel |> mapData <| binding /// Maps the message of a binding via a covariant mapping. let mapMsg (f: 'a -> 'b) (binding: Binding<'model, 'a, 't>) = f |> mapMsg |> mapData <| binding @@ -39,7 +40,8 @@ module Binding = /// Restricts the binding to models that satisfy the predicate after some model satisfies the predicate. - let addSticky (predicate: 'model -> bool) (binding: Binding<'model, 'msg, 't>) = predicate |> addSticky |> mapData <| binding + let addSticky (predicate: 'model -> bool) (binding: Binding<'model, 'msg, 't>) = + predicate |> addSticky |> mapData <| binding /// /// Adds caching to the given binding. The cache holds a single value and @@ -47,9 +49,7 @@ module Binding = /// PropertyChanged event. /// /// The binding to which caching is added. - let addCaching (binding: Binding<'model, 'msg, 't>) : Binding<'model, 'msg, 't> = - binding - |> mapData addCaching + let addCaching (binding: Binding<'model, 'msg, 't>) : Binding<'model, 'msg, 't> = binding |> mapData addCaching /// /// Adds validation to the given binding using INotifyDataErrorInfo. @@ -57,8 +57,7 @@ module Binding = /// Returns the errors associated with the given model. /// The binding to which validation is added. let addValidation (validate: 'model -> string list) (binding: Binding<'model, 'msg, 't>) : Binding<'model, 'msg, 't> = - binding - |> mapData (addValidation validate) + binding |> mapData (addValidation validate) /// /// Adds laziness to the updating of the given binding. If the models are considered equal, @@ -67,8 +66,7 @@ module Binding = /// Updating skipped when this function returns true. /// The binding to which the laziness is added. let addLazy (equals: 'model -> 'model -> bool) (binding: Binding<'model, 'msg, 't>) : Binding<'model, 'msg, 't> = - binding - |> mapData (addLazy equals) + binding |> mapData (addLazy equals) /// /// Alters the message stream via the given function. @@ -91,9 +89,11 @@ module Binding = /// /// The function that can alter the message stream. /// The binding of the altered message stream. - let alterMsgStream (alteration: ('b -> unit) -> 'a -> unit) (binding: Binding<'model, 'a, 't>) : Binding<'model, 'b, 't> = - binding - |> mapData (alterMsgStream alteration) + let alterMsgStream + (alteration: ('b -> unit) -> 'a -> unit) + (binding: Binding<'model, 'a, 't>) + : Binding<'model, 'b, 't> = + binding |> mapData (alterMsgStream alteration) /// @@ -102,9 +102,7 @@ module Binding = module OneWayT = /// Elemental instance of a one-way binding. - let id<'a, 'msg> : string -> Binding<'a, 'msg, 'a> = - OneWay.id - |> createBindingT + let id<'a, 'msg> : string -> Binding<'a, 'msg, 'a> = OneWay.id |> createBindingT /// /// Strongly-typed bindings that update the model from the view. @@ -112,9 +110,7 @@ module Binding = module OneWayToSourceT = /// Elemental instance of a one-way-to-source binding. - let id<'model, 'a> : string -> Binding<'model, 'a, 'a> = - OneWayToSource.id - |> createBindingT + let id<'model, 'a> : string -> Binding<'model, 'a, 'a> = OneWayToSource.id |> createBindingT /// /// Strongly-typed bindings that dispatch messages from the view. @@ -134,12 +130,8 @@ module Binding = /// to another UI property. /// /// Indicates whether the command can execute. - let id<'model> uiBoundCmdParam canExec - : string -> Binding<'model, obj, ICommand> = - Cmd.createWithParam - (fun p _ -> ValueSome p) - canExec - uiBoundCmdParam + let id<'model> uiBoundCmdParam canExec : string -> Binding<'model, obj, ICommand> = + Cmd.createWithParam (fun p _ -> ValueSome p) canExec uiBoundCmdParam |> createBindingT /// @@ -148,10 +140,7 @@ module Binding = /// /// Indicates whether the command can execute. /// Returns the message to dispatch. - let model - canExec - (exec: 'model -> 'msg) - : string -> Binding<'model, 'msg, ICommand> = + let model canExec (exec: 'model -> 'msg) : string -> Binding<'model, 'msg, ICommand> = id false (fun _ m -> m |> canExec) >> mapMsgWithModel (fun _ y -> y |> exec) >> addLazy (fun m1 m2 -> canExec m1 = canExec m2) @@ -161,99 +150,70 @@ module Binding = /// /// Indicates whether the command can execute. /// The message to dispatch. - let set - canExec - (msg: 'msg) - : string -> Binding<'model, 'msg, ICommand> = - id false (fun _ m -> m |> canExec) - >> setMsg msg + let set canExec (msg: 'msg) : string -> Binding<'model, 'msg, ICommand> = + id false (fun _ m -> m |> canExec) >> setMsg msg /// /// Creates a Command binding that depends only on the model (not the /// CommandParameter) and always executes. /// /// Returns the message to dispatch. - let modelAlways - (exec: 'model -> 'msg) - : string -> Binding<'model, 'msg, ICommand> = - model (fun _ -> true) exec + let modelAlways (exec: 'model -> 'msg) : string -> Binding<'model, 'msg, ICommand> = model (fun _ -> true) exec /// /// Creates a Command binding that dispatches the specified message /// and always executes. /// /// The message to dispatch. - let setAlways - (msg: 'msg) - : string -> Binding<'model, 'msg, ICommand> = - set (fun _ -> true) msg + let setAlways (msg: 'msg) : string -> Binding<'model, 'msg, ICommand> = set (fun _ -> true) msg module OneWay = /// Elemental instance of a one-way binding. - let id<'a, 'msg> : string -> Binding<'a, 'msg> = - OneWay.id - |> createBinding + let id<'a, 'msg> : string -> Binding<'a, 'msg> = OneWay.id |> createBinding /// Creates a one-way binding to an optional value. The binding /// automatically converts between a missing value in the model and /// a null value in the view. - let opt<'a, 'msg> : string -> Binding<'a option, 'msg> = - id - >> mapModel Option.box + let opt<'a, 'msg> : string -> Binding<'a option, 'msg> = id >> mapModel Option.box /// Creates a one-way binding to an optional value. The binding /// automatically converts between a missing value in the model and /// a null value in the view. - let vopt<'a, 'msg> : string -> Binding<'a voption, 'msg> = - id - >> mapModel ValueOption.box + let vopt<'a, 'msg> : string -> Binding<'a voption, 'msg> = id >> mapModel ValueOption.box module OneWayToSource = /// Elemental instance of a one-way-to-source binding. - let id<'model, 'a> : string -> Binding<'model, 'a> = - OneWayToSource.id - |> createBinding + let id<'model, 'a> : string -> Binding<'model, 'a> = OneWayToSource.id |> createBinding /// Creates a one-way-to-source binding to an optional value. The binding /// automatically converts between a missing value in the model and /// a null value in the view. - let vopt<'model, 'a> : string -> Binding<'model, 'a voption> = - id<'model, obj> - >> mapMsg ValueOption.unbox + let vopt<'model, 'a> : string -> Binding<'model, 'a voption> = id<'model, obj> >> mapMsg ValueOption.unbox /// Creates a one-way-to-source binding to an optional value. The binding /// automatically converts between a missing value in the model and /// a null value in the view. - let opt<'model, 'a> : string -> Binding<'model, 'a option> = - id<'model, obj> - >> mapMsg Option.unbox + let opt<'model, 'a> : string -> Binding<'model, 'a option> = id<'model, obj> >> mapMsg Option.unbox module TwoWay = /// Elemental instance of a two-way binding. - let id<'a> : string -> Binding<'a, 'a> = - TwoWay.id - |> createBinding + let id<'a> : string -> Binding<'a, 'a> = TwoWay.id |> createBinding /// Creates a one-way-to-source binding to an optional value. The binding /// automatically converts between a missing value in the model and /// a null value in the view. let vopt<'a> : string -> Binding<'a voption, 'a voption> = - id - >> mapModel ValueOption.box - >> mapMsg ValueOption.unbox + id >> mapModel ValueOption.box >> mapMsg ValueOption.unbox /// Creates a one-way-to-source binding to an optional value. The binding /// automatically converts between a missing value in the model and /// a null value in the view. - let opt<'a> : string -> Binding<'a option, 'a option> = - id - >> mapModel Option.box - >> mapMsg Option.unbox + let opt<'a> : string -> Binding<'a option, 'a option> = id >> mapModel Option.box >> mapMsg Option.unbox module SubModelSelectedItem = @@ -299,23 +259,17 @@ module Binding = module Cmd = let internal createWithParam exec canExec autoRequery = - Cmd.createWithParam exec canExec autoRequery - |> createBinding + Cmd.createWithParam exec canExec autoRequery |> createBinding let internal create exec canExec = - createWithParam - (fun _ -> exec) - (fun _ -> canExec) - false + createWithParam (fun _ -> exec) (fun _ -> canExec) false >> addLazy (fun m1 m2 -> canExec m1 = canExec m2) module OneWaySeq = let internal create get itemEquals getId = - OneWaySeq.create itemEquals getId - |> BindingData.mapModel get - |> createBinding + OneWaySeq.create itemEquals getId |> BindingData.mapModel get |> createBinding module SubModel = @@ -325,11 +279,8 @@ module Binding = /// to the DataContext of a UserControl or similar. /// /// Returns the bindings for the sub-model. - let vopt (bindings: unit -> Binding<'model, 'msg> list) - : string -> Binding<'model voption, 'msg> = - SubModel.create - (fun args -> DynamicViewModel<'model, 'msg>(args, bindings ())) - IViewModel.updateModel + let vopt (bindings: unit -> Binding<'model, 'msg> list) : string -> Binding<'model voption, 'msg> = + SubModel.create (fun args -> DynamicViewModel<'model, 'msg>(args, bindings ())) IViewModel.updateModel |> createBinding /// @@ -337,20 +288,16 @@ module Binding = /// to the DataContext of a UserControl or similar. /// /// Returns the bindings for the sub-model. - let opt (bindings: unit -> Binding<'model, 'msg> list) - : string -> Binding<'model option, 'msg> = - vopt bindings - >> mapModel ValueOption.ofOption + let opt (bindings: unit -> Binding<'model, 'msg> list) : string -> Binding<'model option, 'msg> = + vopt bindings >> mapModel ValueOption.ofOption /// /// Creates a binding to a sub-model/component. You typically bind this /// to the DataContext of a UserControl or similar. /// /// Returns the bindings for the sub-model. - let required (bindings: unit -> Binding<'model, 'msg> list) - : string -> Binding<'model, 'msg> = - vopt bindings - >> mapModel ValueSome + let required (bindings: unit -> Binding<'model, 'msg> list) : string -> Binding<'model, 'msg> = + vopt bindings >> mapModel ValueSome /// /// The strongly-typed counterpart of module SubModel. @@ -363,16 +310,13 @@ module Binding = /// Exposes an optional view model member for binding. let opt (createVm: ViewModelArgs<'bindingModel, 'msg> -> #IViewModel<'bindingModel, 'msg>) - : (string -> Binding<'bindingModel voption, 'msg, #IViewModel<'bindingModel, 'msg>>) - = - SubModel.create createVm IViewModel.updateModel - |> createBindingT + : (string -> Binding<'bindingModel voption, 'msg, #IViewModel<'bindingModel, 'msg>>) = + SubModel.create createVm IViewModel.updateModel |> createBindingT /// Exposes a non-optional view model member for binding. let req (createVm: ViewModelArgs<'bindingModel, 'msg> -> #IViewModel<'bindingModel, 'msg>) - : (string -> Binding<'bindingModel, 'msg, #IViewModel<'bindingModel, 'msg>>) - = + : (string -> Binding<'bindingModel, 'msg, #IViewModel<'bindingModel, 'msg>>) = SubModel.create createVm IViewModel.updateModel |> createBindingT >> mapModel ValueSome @@ -384,8 +328,7 @@ module Binding = /// let seq (createVm: ViewModelArgs<'bindingModel, 'msg> -> #seq<#IViewModel<'bindingModel, 'msg>>) - : (string -> Binding<'bindingModel, 'msg, #seq<#IViewModel<'bindingModel, 'msg>>>) - = + : (string -> Binding<'bindingModel, 'msg, #seq<#IViewModel<'bindingModel, 'msg>>>) = SubModel.create createVm (fun (vms, m) -> vms |> Seq.iter (fun vm -> IViewModel.updateModel (vm, m))) |> createBindingT >> mapModel ValueSome @@ -409,10 +352,8 @@ module Binding = /// let id (createVm: ViewModelArgs<'bindingModel, 'msg> -> #IViewModel<'bindingModel, 'msg>) - : (string -> Binding<'bindingModelCollection, int * 'msg, ObservableCollection<#IViewModel<'bindingModel, 'msg>>>) - = - SubModelSeqUnkeyed.create createVm IViewModel.updateModel - |> createBindingT + : (string -> Binding<'bindingModelCollection, int * 'msg, ObservableCollection<#IViewModel<'bindingModel, 'msg>>>) = + SubModelSeqUnkeyed.create createVm IViewModel.updateModel |> createBindingT /// /// The strongly-typed counterpart of Binding.subModelSeq with parameter getId. @@ -437,8 +378,7 @@ module Binding = let id (createVm: ViewModelArgs<'bindingModel, 'msg> -> #IViewModel<'bindingModel, 'msg>) (getId: 'bindingModel -> 'id) - : (string -> Binding<'bindingModelCollection, 'id * 'msg, ObservableCollection<#IViewModel<'bindingModel, 'msg>>>) - = + : (string -> Binding<'bindingModelCollection, 'id * 'msg, ObservableCollection<#IViewModel<'bindingModel, 'msg>>>) = SubModelSeqKeyed.create createVm IViewModel.updateModel getId (IViewModel.currentModel >> getId) |> createBindingT @@ -489,7 +429,10 @@ module Binding = let id (getState: 'model -> WindowState<'bindingModel>) (createVM: ViewModelArgs<'bindingModel, 'bindingMsg> -> #IViewModel<'bindingModel, 'bindingMsg>) - getWindow isModal onCloseRequested = + getWindow + isModal + onCloseRequested + = SubModelWin.create getState createVM IViewModel.updateModel Func2.id2 getWindow isModal onCloseRequested |> createBindingT @@ -502,10 +445,7 @@ module Binding = >> mapMsg (fun i -> if i < 0 then ValueNone else ValueSome i) /// Prebuilt binding intended for use with Selector.SelectedIndex. - let opt = - vopt - >> mapModel ValueOption.ofOption - >> mapMsg ValueOption.toOption + let opt = vopt >> mapModel ValueOption.ofOption >> mapMsg ValueOption.toOption module SubModelWin = @@ -518,8 +458,7 @@ module Binding = module SubModelSeqUnkeyed = let internal create createViewModel updateViewModel = - SubModelSeqUnkeyed.create createViewModel updateViewModel - |> createBinding + SubModelSeqUnkeyed.create createViewModel updateViewModel |> createBinding module SubModelSeqKeyed = @@ -535,7 +474,8 @@ module Bindings = let mapModel (f: 'a -> 'b) (bindings: Binding<'b, 'msg> list) = f |> Binding.mapModel |> List.map <| bindings /// Maps the message of a list of bindings with access to the model via a covariant mapping. - let mapMsgWithModel (f: 'a -> 'model -> 'b) (bindings: Binding<'model, 'a> list) = f |> Binding.mapMsgWithModel |> List.map <| bindings + let mapMsgWithModel (f: 'a -> 'model -> 'b) (bindings: Binding<'model, 'a> list) = + f |> Binding.mapMsgWithModel |> List.map <| bindings /// Maps the message of a list of bindings via a covariant mapping. let mapMsg (f: 'a -> 'b) (bindings: Binding<'model, 'a> list) = f |> Binding.mapMsg |> List.map <| bindings @@ -549,34 +489,22 @@ type Binding private () = /// /// Gets the selected index from the model. /// Returns the message to dispatch. - static member selectedIndex - (get: 'model -> int voption, - set: int voption -> 'msg) = - Binding.SelectedIndex.vopt - >> Binding.mapModel get - >> Binding.mapMsg set + static member selectedIndex(get: 'model -> int voption, set: int voption -> 'msg) = + Binding.SelectedIndex.vopt >> Binding.mapModel get >> Binding.mapMsg set /// /// Creates a binding intended for use with Selector.SelectedIndex. /// /// Gets the selected index from the model. /// Returns the message to dispatch. - static member selectedIndex - (get: 'model -> int option, - set: int option -> 'msg) = - Binding.SelectedIndex.opt - >> Binding.mapModel get - >> Binding.mapMsg set + static member selectedIndex(get: 'model -> int option, set: int option -> 'msg) = + Binding.SelectedIndex.opt >> Binding.mapModel get >> Binding.mapMsg set /// Creates a one-way binding. /// Gets the value from the model. - static member oneWay - (get: 'model -> 'a) - : string -> Binding<'model, 'msg> = - Binding.OneWay.id<'a, 'msg> - >> Binding.addLazy (=) - >> Binding.mapModel get + static member oneWay(get: 'model -> 'a) : string -> Binding<'model, 'msg> = + Binding.OneWay.id<'a, 'msg> >> Binding.addLazy (=) >> Binding.mapModel get /// @@ -586,12 +514,8 @@ type Binding private () = /// null) value on the view side. /// /// Gets the value from the model. - static member oneWayOpt - (get: 'model -> 'a option) - : string -> Binding<'model, 'msg> = - Binding.OneWay.opt<'a, 'msg> - >> Binding.addLazy (=) - >> Binding.mapModel get + static member oneWayOpt(get: 'model -> 'a option) : string -> Binding<'model, 'msg> = + Binding.OneWay.opt<'a, 'msg> >> Binding.addLazy (=) >> Binding.mapModel get /// @@ -601,12 +525,8 @@ type Binding private () = /// null) value on the view side. /// /// Gets the value from the model. - static member oneWayOpt - (get: 'model -> 'a voption) - : string -> Binding<'model, 'msg> = - Binding.OneWay.vopt<'a, 'msg> - >> Binding.addLazy (=) - >> Binding.mapModel get + static member oneWayOpt(get: 'model -> 'a voption) : string -> Binding<'model, 'msg> = + Binding.OneWay.vopt<'a, 'msg> >> Binding.addLazy (=) >> Binding.mapModel get /// @@ -624,10 +544,11 @@ type Binding private () = /// /// Transforms the value into the final type. static member oneWayLazy - (get: 'model -> 'a, - equals: 'a -> 'a -> bool, - map: 'a -> 'b) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + equals: 'a -> 'a -> bool, + map: 'a -> 'b + ) : string -> Binding<'model, 'msg> = Binding.OneWay.id<'b, 'msg> >> Binding.mapModel map >> Binding.addLazy equals @@ -654,10 +575,11 @@ type Binding private () = /// Transforms the intermediate value into the final /// type. static member oneWayOptLazy - (get: 'model -> 'a, - equals: 'a -> 'a -> bool, - map: 'a -> 'b option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + equals: 'a -> 'a -> bool, + map: 'a -> 'b option + ) : string -> Binding<'model, 'msg> = Binding.OneWay.opt<'b, 'msg> >> Binding.mapModel map >> Binding.addLazy equals @@ -684,10 +606,11 @@ type Binding private () = /// Transforms the intermediate value into the final /// type. static member oneWayOptLazy - (get: 'model -> 'a, - equals: 'a -> 'a -> bool, - map: 'a -> 'b voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + equals: 'a -> 'a -> bool, + map: 'a -> 'b voption + ) : string -> Binding<'model, 'msg> = Binding.OneWay.vopt<'b, 'msg> >> Binding.mapModel map >> Binding.addLazy equals @@ -697,11 +620,8 @@ type Binding private () = /// Creates a one-way-to-source binding. /// Returns the message to dispatch. - static member oneWayToSource - (set: 'a -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.OneWayToSource.id<'model, 'a> - >> Binding.mapMsgWithModel set + static member oneWayToSource(set: 'a -> 'model -> 'msg) : string -> Binding<'model, 'msg> = + Binding.OneWayToSource.id<'model, 'a> >> Binding.mapMsgWithModel set /// /// Creates a one-way-to-source binding to an optional value. The binding @@ -709,11 +629,8 @@ type Binding private () = /// a null value in the view. /// /// Returns the message to dispatch. - static member oneWayToSourceOpt - (set: 'a option -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.OneWayToSource.opt - >> Binding.mapMsgWithModel set + static member oneWayToSourceOpt(set: 'a option -> 'model -> 'msg) : string -> Binding<'model, 'msg> = + Binding.OneWayToSource.opt >> Binding.mapMsgWithModel set /// /// Creates a one-way-to-source binding to an optional value. The binding @@ -721,11 +638,8 @@ type Binding private () = /// a null value in the view. /// /// Returns the message to dispatch. - static member oneWayToSourceOpt - (set: 'a voption -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.OneWayToSource.vopt - >> Binding.mapMsgWithModel set + static member oneWayToSourceOpt(set: 'a voption -> 'model -> 'msg) : string -> Binding<'model, 'msg> = + Binding.OneWayToSource.vopt >> Binding.mapMsgWithModel set /// @@ -751,12 +665,13 @@ type Binding private () = /// Gets a unique identifier for a collection /// item. static member oneWaySeqLazy - (get: 'model -> 'a, - equals: 'a -> 'a -> bool, - map: 'a -> #seq<'b>, - itemEquals: 'b -> 'b -> bool, - getId: 'b -> 'id) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + equals: 'a -> 'a -> bool, + map: 'a -> #seq<'b>, + itemEquals: 'b -> 'b -> bool, + getId: 'b -> 'id + ) : string -> Binding<'model, 'msg> = Binding.OneWaySeq.create map itemEquals getId >> Binding.addLazy equals >> Binding.mapModel get @@ -782,10 +697,11 @@ type Binding private () = /// Gets a unique identifier for a collection /// item. static member oneWaySeq - (get: 'model -> #seq<'a>, - itemEquals: 'a -> 'a -> bool, - getId: 'a -> 'id) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> #seq<'a>, + itemEquals: 'a -> 'a -> bool, + getId: 'a -> 'id + ) : string -> Binding<'model, 'msg> = Binding.OneWaySeq.create id itemEquals getId >> Binding.addLazy refEq >> Binding.mapModel get @@ -794,10 +710,7 @@ type Binding private () = /// Creates a two-way binding. /// Gets the value from the model. /// Returns the message to dispatch. - static member twoWay - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = + static member twoWay(get: 'model -> 'a, set: 'a -> 'model -> 'msg) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -812,12 +725,12 @@ type Binding private () = /// [] static member twoWay - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.twoWay (get, set) - >> Binding.alterMsgStream wrapDispatch + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.twoWay (get, set) >> Binding.alterMsgStream wrapDispatch /// @@ -828,9 +741,10 @@ type Binding private () = /// Gets the value from the model. /// Returns the message to dispatch. static member twoWayOpt - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -849,12 +763,12 @@ type Binding private () = /// [] static member twoWayOpt - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.twoWayOpt (get, set) - >> Binding.alterMsgStream wrapDispatch + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.twoWayOpt (get, set) >> Binding.alterMsgStream wrapDispatch /// @@ -865,9 +779,10 @@ type Binding private () = /// Gets the value from the model. /// Returns the message to dispatch. static member twoWayOpt - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -886,12 +801,12 @@ type Binding private () = /// [] static member twoWayOpt - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.twoWayOpt (get, set) - >> Binding.alterMsgStream wrapDispatch + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.twoWayOpt (get, set) >> Binding.alterMsgStream wrapDispatch /// @@ -904,10 +819,11 @@ type Binding private () = /// Returns the validation messages from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> string list) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> string list + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -929,11 +845,12 @@ type Binding private () = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> string list, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> string list, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -948,10 +865,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> string voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> string voption + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -973,11 +891,12 @@ type Binding private () = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> string voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> string voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -992,10 +911,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> string option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> string option + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1017,11 +937,12 @@ type Binding private () = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> string option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> string option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1036,10 +957,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> Result<'ignored, string>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> Result<'ignored, string> + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1061,11 +983,12 @@ type Binding private () = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'model -> 'msg, - validate: 'model -> Result<'ignored, string>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'model -> 'msg, + validate: 'model -> Result<'ignored, string>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1082,10 +1005,11 @@ type Binding private () = /// Returns the validation messages from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> string list) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> string list + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1109,11 +1033,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> string list, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> string list, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1130,10 +1055,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> string voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> string voption + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1157,11 +1083,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> string voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> string voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1178,10 +1105,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> string option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> string option + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1205,11 +1133,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> string option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> string option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1226,10 +1155,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> Result<'ignored, string>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> Result<'ignored, string> + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1253,11 +1183,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'model -> 'msg, - validate: 'model -> Result<'ignored, string>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'model -> 'msg, + validate: 'model -> Result<'ignored, string>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1274,10 +1205,11 @@ type Binding private () = /// Returns the validation messages from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> string list) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> string list + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1301,11 +1233,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> string list, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> string list, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1322,10 +1255,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> string voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> string voption + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1349,11 +1283,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> string voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> string voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1370,10 +1305,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> string option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> string option + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1397,11 +1333,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> string option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> string option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1418,10 +1355,11 @@ type Binding private () = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> Result<'ignored, string>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> Result<'ignored, string> + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -1445,11 +1383,12 @@ type Binding private () = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'model -> 'msg, - validate: 'model -> Result<'ignored, string>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'model -> 'msg, + validate: 'model -> Result<'ignored, string>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -1459,12 +1398,8 @@ type Binding private () = /// CommandParameter) and can always execute. /// /// Returns the message to dispatch. - static member cmd - (exec: 'model -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - (exec >> ValueSome) - (fun _ -> true) + static member cmd(exec: 'model -> 'msg) : string -> Binding<'model, 'msg> = + Binding.Cmd.create (exec >> ValueSome) (fun _ -> true) /// /// Creates a Command binding that depends only on the model (not the @@ -1477,11 +1412,11 @@ type Binding private () = /// [] static member cmd - (exec: 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmd exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmd exec >> Binding.alterMsgStream wrapDispatch /// @@ -1492,13 +1427,8 @@ type Binding private () = /// /// Returns the message to dispatch. /// Indicates whether the command can execute. - static member cmdIf - (exec: 'model -> 'msg, - canExec: 'model -> bool) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - (exec >> ValueSome) - canExec + static member cmdIf(exec: 'model -> 'msg, canExec: 'model -> bool) : string -> Binding<'model, 'msg> = + Binding.Cmd.create (exec >> ValueSome) canExec /// /// Creates a conditional Command binding that depends only on the @@ -1514,12 +1444,12 @@ type Binding private () = /// [] static member cmdIf - (exec: 'model -> 'msg, - canExec: 'model -> bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdIf (exec, canExec) - >> Binding.alterMsgStream wrapDispatch + ( + exec: 'model -> 'msg, + canExec: 'model -> bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdIf (exec, canExec) >> Binding.alterMsgStream wrapDispatch /// @@ -1529,12 +1459,8 @@ type Binding private () = /// returns ValueSome. /// /// Returns the message to dispatch. - static member cmdIf - (exec: 'model -> 'msg voption) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - exec - (exec >> ValueOption.isSome) + static member cmdIf(exec: 'model -> 'msg voption) : string -> Binding<'model, 'msg> = + Binding.Cmd.create exec (exec >> ValueOption.isSome) /// /// Creates a conditional Command binding that depends only on the @@ -1549,11 +1475,11 @@ type Binding private () = /// [] static member cmdIf - (exec: 'model -> 'msg voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: 'model -> 'msg voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdIf exec >> Binding.alterMsgStream wrapDispatch /// @@ -1563,12 +1489,8 @@ type Binding private () = /// returns Some. /// /// Returns the message to dispatch. - static member cmdIf - (exec: 'model -> 'msg option) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - (exec >> ValueOption.ofOption) - (exec >> Option.isSome) + static member cmdIf(exec: 'model -> 'msg option) : string -> Binding<'model, 'msg> = + Binding.Cmd.create (exec >> ValueOption.ofOption) (exec >> Option.isSome) /// /// Creates a conditional Command binding that depends only on the @@ -1583,11 +1505,11 @@ type Binding private () = /// [] static member cmdIf - (exec: 'model -> 'msg option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: 'model -> 'msg option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdIf exec >> Binding.alterMsgStream wrapDispatch /// @@ -1600,12 +1522,8 @@ type Binding private () = /// for inputs and commands. /// /// Returns the message to dispatch. - static member cmdIf - (exec: 'model -> Result<'msg, 'ignored>) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - (exec >> ValueOption.ofOk) - (exec >> Result.isOk) + static member cmdIf(exec: 'model -> Result<'msg, 'ignored>) : string -> Binding<'model, 'msg> = + Binding.Cmd.create (exec >> ValueOption.ofOk) (exec >> Result.isOk) /// /// Creates a conditional Command binding that depends only on the @@ -1623,11 +1541,11 @@ type Binding private () = /// [] static member cmdIf - (exec: 'model -> Result<'msg, 'ignored>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: 'model -> Result<'msg, 'ignored>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdIf exec >> Binding.alterMsgStream wrapDispatch /// @@ -1636,13 +1554,8 @@ type Binding private () = /// and can always execute. /// /// Returns the message to dispatch. - static member cmdParam - (exec: obj -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.Cmd.createWithParam - (fun p model -> exec p model |> ValueSome) - (fun _ _ -> true) - false + static member cmdParam(exec: obj -> 'model -> 'msg) : string -> Binding<'model, 'msg> = + Binding.Cmd.createWithParam (fun p model -> exec p model |> ValueSome) (fun _ _ -> true) false /// /// Creates a Command binding that depends on the @@ -1656,11 +1569,11 @@ type Binding private () = /// [] static member cmdParam - (exec: obj -> 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParam exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParam exec >> Binding.alterMsgStream wrapDispatch /// @@ -1679,14 +1592,12 @@ type Binding private () = /// to another UI property. /// static member cmdParamIf - (exec: obj -> 'model -> 'msg, - canExec: obj -> 'model -> bool, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = - Binding.Cmd.createWithParam - (fun p m -> exec p m |> ValueSome) - canExec - (defaultArg uiBoundCmdParam false) + ( + exec: obj -> 'model -> 'msg, + canExec: obj -> 'model -> bool, + ?uiBoundCmdParam: bool + ) : string -> Binding<'model, 'msg> = + Binding.Cmd.createWithParam (fun p m -> exec p m |> ValueSome) canExec (defaultArg uiBoundCmdParam false) /// /// Creates a Command binding that depends on the @@ -1701,12 +1612,12 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> 'msg, - canExec: obj -> 'model -> bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf (exec, canExec) - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'model -> 'msg, + canExec: obj -> 'model -> bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf (exec, canExec) >> Binding.alterMsgStream wrapDispatch /// /// Creates a Command binding that depends on the @@ -1729,11 +1640,12 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> 'msg, - canExec: obj -> 'model -> bool, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'model -> 'msg, + canExec: obj -> 'model -> bool, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, canExec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -1753,13 +1665,11 @@ type Binding private () = /// to another UI property. /// static member cmdParamIf - (exec: obj -> 'model -> 'msg voption, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = - Binding.Cmd.createWithParam - exec - (fun p m -> exec p m |> ValueOption.isSome) - (defaultArg uiBoundCmdParam false) + ( + exec: obj -> 'model -> 'msg voption, + ?uiBoundCmdParam: bool + ) : string -> Binding<'model, 'msg> = + Binding.Cmd.createWithParam exec (fun p m -> exec p m |> ValueOption.isSome) (defaultArg uiBoundCmdParam false) /// /// Creates a conditional Command binding that depends on the @@ -1773,11 +1683,11 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> 'msg voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'model -> 'msg voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf exec >> Binding.alterMsgStream wrapDispatch /// /// Creates a conditional Command binding that depends on the @@ -1799,10 +1709,11 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> 'msg voption, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'model -> 'msg voption, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -1822,9 +1733,10 @@ type Binding private () = /// to another UI property. /// static member cmdParamIf - (exec: obj -> 'model -> 'msg option, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'model -> 'msg option, + ?uiBoundCmdParam: bool + ) : string -> Binding<'model, 'msg> = Binding.Cmd.createWithParam (fun p m -> exec p m |> ValueOption.ofOption) (fun p m -> exec p m |> Option.isSome) @@ -1842,11 +1754,11 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> 'msg option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'model -> 'msg option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf exec >> Binding.alterMsgStream wrapDispatch /// /// Creates a conditional Command binding that depends on the @@ -1868,10 +1780,11 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> 'msg option, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'model -> 'msg option, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -1894,9 +1807,10 @@ type Binding private () = /// to another UI property. /// static member cmdParamIf - (exec: obj -> 'model -> Result<'msg, 'ignored>, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'model -> Result<'msg, 'ignored>, + ?uiBoundCmdParam: bool + ) : string -> Binding<'model, 'msg> = Binding.Cmd.createWithParam (fun p m -> exec p m |> ValueOption.ofOk) (fun p m -> exec p m |> Result.isOk) @@ -1917,11 +1831,11 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> Result<'msg, 'ignored>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'model -> Result<'msg, 'ignored>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf exec >> Binding.alterMsgStream wrapDispatch /// /// Creates a conditional Command binding that depends on the @@ -1946,10 +1860,11 @@ type Binding private () = /// [] static member cmdParamIf - (exec: obj -> 'model -> Result<'msg, 'ignored>, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'model -> Result<'msg, 'ignored>, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -1970,11 +1885,12 @@ type Binding private () = /// Returns the bindings for the sub-model. [] static member subModel - (getSubModel: 'model -> 'subModel, - toBindingModel: 'model * 'subModel -> 'bindingModel, - toMsg: 'bindingMsg -> 'msg, - bindings: unit -> Binding<'bindingModel, 'bindingMsg> list) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel, + toBindingModel: 'model * 'subModel -> 'bindingModel, + toMsg: 'bindingMsg -> 'msg, + bindings: unit -> Binding<'bindingModel, 'bindingMsg> list + ) : string -> Binding<'model, 'msg> = Binding.SubModel.required bindings >> Binding.mapModel (fun m -> toBindingModel (m, getSubModel m)) >> Binding.mapMsg toMsg @@ -1992,10 +1908,11 @@ type Binding private () = /// Returns the bindings for the sub-model. [] static member subModel - (getSubModel: 'model -> 'subModel, - toMsg: 'subMsg -> 'msg, - bindings: unit -> Binding<'model * 'subModel, 'subMsg> list) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel, + toMsg: 'subMsg -> 'msg, + bindings: unit -> Binding<'model * 'subModel, 'subMsg> list + ) : string -> Binding<'model, 'msg> = Binding.SubModel.required bindings >> Binding.mapModel (fun m -> (m, getSubModel m)) >> Binding.mapMsg toMsg @@ -2010,9 +1927,10 @@ type Binding private () = /// Returns the bindings for the sub-model. [ Binding<'model, 'msg> list\". To avoid a compile error when upgrading, replace this method call with its implementation.")>] static member subModel - (getSubModel: 'model -> 'subModel, - bindings: unit -> Binding<'model * 'subModel, 'msg> list) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel, + bindings: unit -> Binding<'model * 'subModel, 'msg> list + ) : string -> Binding<'model, 'msg> = Binding.SubModel.required bindings >> Binding.mapModel (fun m -> (m, getSubModel m)) @@ -2046,14 +1964,18 @@ type Binding private () = /// [] static member subModelOpt - (getSubModel: 'model -> 'subModel voption, - toBindingModel: 'model * 'subModel -> 'bindingModel, - toMsg: 'bindingMsg -> 'msg, - bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, - ?sticky: bool) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel voption, + toBindingModel: 'model * 'subModel -> 'bindingModel, + toMsg: 'bindingMsg -> 'msg, + bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, + ?sticky: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModel.vopt bindings - >> if (defaultArg sticky false) then Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) else id + >> if (defaultArg sticky false) then + Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) + else + id >> Binding.mapModel (fun m -> getSubModel m |> ValueOption.map (fun sub -> toBindingModel (m, sub))) >> Binding.mapMsg toMsg @@ -2087,14 +2009,18 @@ type Binding private () = /// [] static member subModelOpt - (getSubModel: 'model -> 'subModel option, - toBindingModel: 'model * 'subModel -> 'bindingModel, - toMsg: 'bindingMsg -> 'msg, - bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, - ?sticky: bool) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel option, + toBindingModel: 'model * 'subModel -> 'bindingModel, + toMsg: 'bindingMsg -> 'msg, + bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, + ?sticky: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModel.opt bindings - >> if (defaultArg sticky false) then Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) else id + >> if (defaultArg sticky false) then + Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) + else + id >> Binding.mapModel (fun m -> getSubModel m |> Option.map (fun sub -> toBindingModel (m, sub))) >> Binding.mapMsg toMsg @@ -2124,13 +2050,17 @@ type Binding private () = /// [] static member subModelOpt - (getSubModel: 'model -> 'subModel voption, - toMsg: 'subMsg -> 'msg, - bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, - ?sticky: bool) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel voption, + toMsg: 'subMsg -> 'msg, + bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, + ?sticky: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModel.vopt bindings - >> if (defaultArg sticky false) then Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) else id + >> if (defaultArg sticky false) then + Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) + else + id >> Binding.mapModel (fun m -> getSubModel m |> ValueOption.map (fun sub -> (m, sub))) >> Binding.mapMsg toMsg @@ -2161,13 +2091,17 @@ type Binding private () = /// [] static member subModelOpt - (getSubModel: 'model -> 'subModel option, - toMsg: 'subMsg -> 'msg, - bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, - ?sticky: bool) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel option, + toMsg: 'subMsg -> 'msg, + bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, + ?sticky: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModel.opt bindings - >> if (defaultArg sticky false) then Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) else id + >> if (defaultArg sticky false) then + Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) + else + id >> Binding.mapModel (fun m -> getSubModel m |> Option.map (fun sub -> (m, sub))) >> Binding.mapMsg toMsg @@ -2194,12 +2128,16 @@ type Binding private () = /// [ Binding<'model, 'msg> list\". To avoid a compile error when upgrading, replace this method call with (a specialization of) its implementation.")>] static member subModelOpt - (getSubModel: 'model -> 'subModel voption, - bindings: unit -> Binding<'model * 'subModel, 'msg> list, - ?sticky: bool) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel voption, + bindings: unit -> Binding<'model * 'subModel, 'msg> list, + ?sticky: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModel.vopt bindings - >> if (defaultArg sticky false) then Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) else id + >> if (defaultArg sticky false) then + Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) + else + id >> Binding.mapModel (fun m -> getSubModel m |> ValueOption.map (fun sub -> (m, sub))) @@ -2225,12 +2163,16 @@ type Binding private () = /// [ Binding<'model, 'msg> list\". To avoid a compile error when upgrading, replace this method call with (a specialization of) its implementation.")>] static member subModelOpt - (getSubModel: 'model -> 'subModel option, - bindings: unit -> Binding<'model * 'subModel, 'msg> list, - ?sticky: bool) - : string -> Binding<'model, 'msg> = + ( + getSubModel: 'model -> 'subModel option, + bindings: unit -> Binding<'model * 'subModel, 'msg> list, + ?sticky: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModel.opt bindings - >> if (defaultArg sticky false) then Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) else id + >> if (defaultArg sticky false) then + Binding.addLazy (fun previous next -> previous.IsSome && next.IsNone) + else + id >> Binding.mapModel (fun m -> getSubModel m |> Option.map (fun sub -> (m, sub))) @@ -2277,14 +2219,15 @@ type Binding private () = /// window.Show). /// static member subModelWin - (getState: 'model -> WindowState<'subModel>, - toBindingModel: 'model * 'subModel -> 'bindingModel, - toMsg: 'bindingMsg -> 'msg, - bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, - getWindow: 'model -> Dispatch<'msg> -> #Window, - ?onCloseRequested: 'msg, - ?isModal: bool) - : string -> Binding<'model, 'msg> = + ( + getState: 'model -> WindowState<'subModel>, + toBindingModel: 'model * 'subModel -> 'bindingModel, + toMsg: 'bindingMsg -> 'msg, + bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, + getWindow: 'model -> Dispatch<'msg> -> #Window, + ?onCloseRequested: 'msg, + ?isModal: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModelWin.create (fun m -> getState m |> WindowState.map (fun sub -> toBindingModel (m, sub))) (fun args -> DynamicViewModel<'bindingModel, 'bindingMsg>(args, bindings ())) @@ -2338,15 +2281,16 @@ type Binding private () = /// window.Show). /// static member subModelWin - (getState: 'model -> WindowState<'subModel>, - toBindingModel: 'model * 'subModel -> 'bindingModel, - toMsg: 'bindingMsg -> 'msg, - bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, - getWindow: unit -> #Window, - ?onCloseRequested: 'msg, - ?isModal: bool) - : string -> Binding<'model, 'msg> = - Binding.subModelWin( + ( + getState: 'model -> WindowState<'subModel>, + toBindingModel: 'model * 'subModel -> 'bindingModel, + toMsg: 'bindingMsg -> 'msg, + bindings: unit -> Binding<'bindingModel, 'bindingMsg> list, + getWindow: unit -> #Window, + ?onCloseRequested: 'msg, + ?isModal: bool + ) : string -> Binding<'model, 'msg> = + Binding.subModelWin ( getState, toBindingModel, toMsg, @@ -2393,13 +2337,14 @@ type Binding private () = /// window.Show). /// static member subModelWin - (getState: 'model -> WindowState<'subModel>, - toMsg: 'subMsg -> 'msg, - bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, - getWindow: 'model -> Dispatch<'msg> -> #Window, - ?onCloseRequested: 'msg, - ?isModal: bool) - : string -> Binding<'model, 'msg> = + ( + getState: 'model -> WindowState<'subModel>, + toMsg: 'subMsg -> 'msg, + bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, + getWindow: 'model -> Dispatch<'msg> -> #Window, + ?onCloseRequested: 'msg, + ?isModal: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModelWin.create (fun m -> getState m |> WindowState.map (fun sub -> (m, sub))) (fun args -> DynamicViewModel<'model * 'subModel, 'subMsg>(args, bindings ())) @@ -2446,14 +2391,15 @@ type Binding private () = /// window.Show). /// static member subModelWin - (getState: 'model -> WindowState<'subModel>, - toMsg: 'subMsg -> 'msg, - bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, - getWindow: unit -> #Window, - ?onCloseRequested: 'msg, - ?isModal: bool) - : string -> Binding<'model, 'msg> = - Binding.subModelWin( + ( + getState: 'model -> WindowState<'subModel>, + toMsg: 'subMsg -> 'msg, + bindings: unit -> Binding<'model * 'subModel, 'subMsg> list, + getWindow: unit -> #Window, + ?onCloseRequested: 'msg, + ?isModal: bool + ) : string -> Binding<'model, 'msg> = + Binding.subModelWin ( getState, toMsg, bindings, @@ -2495,12 +2441,13 @@ type Binding private () = /// window.Show). /// static member subModelWin - (getState: 'model -> WindowState<'subModel>, - bindings: unit -> Binding<'model * 'subModel, 'msg> list, - getWindow: 'model -> Dispatch<'msg> -> #Window, - ?onCloseRequested: 'msg, - ?isModal: bool) - : string -> Binding<'model, 'msg> = + ( + getState: 'model -> WindowState<'subModel>, + bindings: unit -> Binding<'model * 'subModel, 'msg> list, + getWindow: 'model -> Dispatch<'msg> -> #Window, + ?onCloseRequested: 'msg, + ?isModal: bool + ) : string -> Binding<'model, 'msg> = Binding.SubModelWin.create (fun m -> getState m |> WindowState.map (fun sub -> (m, sub))) (fun args -> DynamicViewModel<'model * 'subModel, 'msg>(args, bindings ())) @@ -2543,13 +2490,14 @@ type Binding private () = /// window.Show). /// static member subModelWin - (getState: 'model -> WindowState<'subModel>, - bindings: unit -> Binding<'model * 'subModel, 'msg> list, - getWindow: unit -> #Window, - ?onCloseRequested: 'msg, - ?isModal: bool) - : string -> Binding<'model, 'msg> = - Binding.subModelWin( + ( + getState: 'model -> WindowState<'subModel>, + bindings: unit -> Binding<'model * 'subModel, 'msg> list, + getWindow: unit -> #Window, + ?onCloseRequested: 'msg, + ?isModal: bool + ) : string -> Binding<'model, 'msg> = + Binding.subModelWin ( getState, bindings, (fun _ _ -> getWindow ()), @@ -2558,16 +2506,17 @@ type Binding private () = ) static member subModelSeq // TODO: make into function - (getBindings: unit -> Binding<'model, 'msg> list) - : string -> Binding<'model seq, int * 'msg> = + (getBindings: unit -> Binding<'model, 'msg> list) + : string -> Binding<'model seq, int * 'msg> = Binding.SubModelSeqUnkeyed.create (fun args -> DynamicViewModel<'model, 'msg>(args, getBindings ())) IViewModel.updateModel static member subModelSeq // TODO: make into function - (getBindings: unit -> Binding<'model, 'msg> list, - getId: 'model -> 'id) - : string -> Binding<'model seq, 'id * 'msg> = + ( + getBindings: unit -> Binding<'model, 'msg> list, + getId: 'model -> 'id + ) : string -> Binding<'model seq, 'id * 'msg> = Binding.SubModelSeqKeyed.create (fun args -> DynamicViewModel<'model, 'msg>(args, getBindings ())) IViewModel.updateModel @@ -2594,12 +2543,13 @@ type Binding private () = /// /// Returns the bindings for the sub-model. static member subModelSeq - (getSubModels: 'model -> #seq<'subModel>, - toBindingModel: 'model * 'subModel -> 'bindingModel, - getId: 'bindingModel -> 'id, - toMsg: 'id * 'bindingMsg -> 'msg, - bindings: unit -> Binding<'bindingModel, 'bindingMsg> list) - : string -> Binding<'model, 'msg> = + ( + getSubModels: 'model -> #seq<'subModel>, + toBindingModel: 'model * 'subModel -> 'bindingModel, + getId: 'bindingModel -> 'id, + toMsg: 'id * 'bindingMsg -> 'msg, + bindings: unit -> Binding<'bindingModel, 'bindingMsg> list + ) : string -> Binding<'model, 'msg> = Binding.SubModelSeqKeyed.create (fun args -> DynamicViewModel<'bindingModel, 'bindingMsg>(args, bindings ())) IViewModel.updateModel @@ -2625,11 +2575,12 @@ type Binding private () = /// /// Returns the bindings for the sub-model. static member subModelSeq - (getSubModels: 'model -> #seq<'subModel>, - getId: 'subModel -> 'id, - toMsg: 'id * 'subMsg -> 'msg, - bindings: unit -> Binding<'model * 'subModel, 'subMsg> list) - : string -> Binding<'model, 'msg> = + ( + getSubModels: 'model -> #seq<'subModel>, + getId: 'subModel -> 'id, + toMsg: 'id * 'subMsg -> 'msg, + bindings: unit -> Binding<'model * 'subModel, 'subMsg> list + ) : string -> Binding<'model, 'msg> = Binding.SubModelSeqKeyed.create (fun args -> DynamicViewModel<'model * 'subModel, 'subMsg>(args, bindings ())) IViewModel.updateModel @@ -2650,10 +2601,11 @@ type Binding private () = /// Gets a unique identifier for a sub-model. /// Returns the bindings for the sub-model. static member subModelSeq - (getSubModels: 'model -> #seq<'subModel>, - getId: 'subModel -> 'id, - bindings: unit -> Binding<'model * 'subModel, 'msg> list) - : string -> Binding<'model, 'msg> = + ( + getSubModels: 'model -> #seq<'subModel>, + getId: 'subModel -> 'id, + bindings: unit -> Binding<'model * 'subModel, 'msg> list + ) : string -> Binding<'model, 'msg> = Binding.SubModelSeqKeyed.create (fun args -> DynamicViewModel<'model * 'subModel, 'msg>(args, bindings ())) IViewModel.updateModel @@ -2690,10 +2642,11 @@ type Binding private () = /// Returns the message to dispatch on selections/de-selections. /// static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id voption, - set: 'id voption -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id voption, + set: 'id voption -> 'model -> 'msg + ) : string -> Binding<'model, 'msg> = Binding.SubModelSelectedItem.vopt subModelSeqBindingName >> Binding.addLazy (=) >> Binding.mapModel get @@ -2732,11 +2685,12 @@ type Binding private () = /// [] static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id voption, - set: 'id voption -> 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id voption, + set: 'id voption -> 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.subModelSelectedItem (subModelSeqBindingName, get, set) >> Binding.alterMsgStream wrapDispatch @@ -2768,10 +2722,11 @@ type Binding private () = /// Returns the message to dispatch on selections/de-selections. /// static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id option, - set: 'id option -> 'model -> 'msg) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id option, + set: 'id option -> 'model -> 'msg + ) : string -> Binding<'model, 'msg> = Binding.SubModelSelectedItem.opt subModelSeqBindingName >> Binding.addLazy (=) >> Binding.mapModel get @@ -2810,11 +2765,12 @@ type Binding private () = /// [] static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id option, - set: 'id option -> 'model -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id option, + set: 'id option -> 'model -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.subModelSelectedItem (subModelSeqBindingName, get, set) >> Binding.alterMsgStream wrapDispatch @@ -2828,11 +2784,8 @@ module Extensions = /// Creates a one-way-to-source binding. /// Returns the message to dispatch. - static member oneWayToSource - (set: 'a -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.OneWayToSource.id<'model, 'a> - >> Binding.mapMsg set + static member oneWayToSource(set: 'a -> 'msg) : string -> Binding<'model, 'msg> = + Binding.OneWayToSource.id<'model, 'a> >> Binding.mapMsg set /// /// Creates a one-way-to-source binding to an optional value. The binding @@ -2840,11 +2793,8 @@ module Extensions = /// a null value in the view. /// /// Returns the message to dispatch. - static member oneWayToSourceOpt - (set: 'a option -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.OneWayToSource.opt - >> Binding.mapMsg set + static member oneWayToSourceOpt(set: 'a option -> 'msg) : string -> Binding<'model, 'msg> = + Binding.OneWayToSource.opt >> Binding.mapMsg set /// /// Creates a one-way-to-source binding to an optional value. The binding @@ -2852,20 +2802,14 @@ module Extensions = /// a null value in the view. /// /// Returns the message to dispatch. - static member oneWayToSourceOpt - (set: 'a voption -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.OneWayToSource.vopt - >> Binding.mapMsg set + static member oneWayToSourceOpt(set: 'a voption -> 'msg) : string -> Binding<'model, 'msg> = + Binding.OneWayToSource.vopt >> Binding.mapMsg set /// Creates a two-way binding. /// Gets the value from the model. /// Returns the message to dispatch. - static member twoWay - (get: 'model -> 'a, - set: 'a -> 'msg) - : string -> Binding<'model, 'msg> = + static member twoWay(get: 'model -> 'a, set: 'a -> 'msg) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -2880,12 +2824,12 @@ module Extensions = /// [] static member twoWay - (get: 'model -> 'a, - set: 'a -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.twoWay (get, set) - >> Binding.alterMsgStream wrapDispatch + ( + get: 'model -> 'a, + set: 'a -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.twoWay (get, set) >> Binding.alterMsgStream wrapDispatch /// @@ -2895,10 +2839,7 @@ module Extensions = /// /// Gets the value from the model. /// Returns the message to dispatch. - static member twoWayOpt - (get: 'model -> 'a option, - set: 'a option -> 'msg) - : string -> Binding<'model, 'msg> = + static member twoWayOpt(get: 'model -> 'a option, set: 'a option -> 'msg) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -2917,12 +2858,12 @@ module Extensions = /// [] static member twoWayOpt - (get: 'model -> 'a option, - set: 'a option -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.twoWayOpt (get, set) - >> Binding.alterMsgStream wrapDispatch + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.twoWayOpt (get, set) >> Binding.alterMsgStream wrapDispatch /// @@ -2932,10 +2873,7 @@ module Extensions = /// /// Gets the value from the model. /// Returns the message to dispatch. - static member twoWayOpt - (get: 'model -> 'a voption, - set: 'a voption -> 'msg) - : string -> Binding<'model, 'msg> = + static member twoWayOpt(get: 'model -> 'a voption, set: 'a voption -> 'msg) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -2954,12 +2892,12 @@ module Extensions = /// [] static member twoWayOpt - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.twoWayOpt (get, set) - >> Binding.alterMsgStream wrapDispatch + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.twoWayOpt (get, set) >> Binding.alterMsgStream wrapDispatch /// @@ -2972,10 +2910,11 @@ module Extensions = /// Returns the validation messages from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> string list) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> string list + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -2997,11 +2936,12 @@ module Extensions = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> string list, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> string list, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3016,10 +2956,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> string voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> string voption + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3041,11 +2982,12 @@ module Extensions = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> string voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> string voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3060,10 +3002,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> string option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> string option + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3085,11 +3028,12 @@ module Extensions = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> string option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> string option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3104,10 +3048,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> Result<'ignored, string>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> Result<'ignored, string> + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.id<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3129,11 +3074,12 @@ module Extensions = /// [] static member twoWayValidate - (get: 'model -> 'a, - set: 'a -> 'msg, - validate: 'model -> Result<'ignored, string>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a, + set: 'a -> 'msg, + validate: 'model -> Result<'ignored, string>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3150,10 +3096,11 @@ module Extensions = /// Returns the validation messages from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> string list) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> string list + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3177,11 +3124,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> string list, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> string list, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3198,10 +3146,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> string voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> string voption + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3225,11 +3174,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> string voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> string voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3246,10 +3196,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> string option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> string option + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3273,11 +3224,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> string option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> string option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3294,10 +3246,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> Result<'ignored, string>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> Result<'ignored, string> + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.vopt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3321,11 +3274,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a voption, - set: 'a voption -> 'msg, - validate: 'model -> Result<'ignored, string>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a voption, + set: 'a voption -> 'msg, + validate: 'model -> Result<'ignored, string>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3342,10 +3296,11 @@ module Extensions = /// Returns the validation messages from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> string list) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> string list + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3369,11 +3324,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> string list, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> string list, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3390,10 +3346,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> string voption) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> string voption + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3417,11 +3374,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> string voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> string voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3438,10 +3396,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> string option) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> string option + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3465,11 +3424,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> string option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> string option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3486,10 +3446,11 @@ module Extensions = /// Returns the validation message from the updated model. /// static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> Result<'ignored, string>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> Result<'ignored, string> + ) : string -> Binding<'model, 'msg> = Binding.TwoWay.opt<'a> >> Binding.addLazy (=) >> Binding.mapModel get @@ -3513,11 +3474,12 @@ module Extensions = /// [] static member twoWayOptValidate - (get: 'model -> 'a option, - set: 'a option -> 'msg, - validate: 'model -> Result<'ignored, string>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + get: 'model -> 'a option, + set: 'a option -> 'msg, + validate: 'model -> Result<'ignored, string>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.twoWayOptValidate (get, set, validate) >> Binding.alterMsgStream wrapDispatch @@ -3527,12 +3489,8 @@ module Extensions = /// and can always execute. /// /// Returns the message to dispatch. - static member cmd - (exec: 'msg) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - (fun _ -> exec |> ValueSome) - (fun _ -> true) + static member cmd(exec: 'msg) : string -> Binding<'model, 'msg> = + Binding.Cmd.create (fun _ -> exec |> ValueSome) (fun _ -> true) /// /// Creates a Command binding that dispatches the specified message @@ -3544,12 +3502,8 @@ module Extensions = /// throttling, debouncing, or limiting. /// [] - static member cmd - (exec: 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmd exec - >> Binding.alterMsgStream wrapDispatch + static member cmd(exec: 'msg, wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) : string -> Binding<'model, 'msg> = + Binding.cmd exec >> Binding.alterMsgStream wrapDispatch /// @@ -3558,13 +3512,8 @@ module Extensions = /// /// Returns the message to dispatch. /// Indicates whether the command can execute. - static member cmdIf - (exec: 'msg, - canExec: 'model -> bool) - : string -> Binding<'model, 'msg> = - Binding.Cmd.create - (fun _ -> exec |> ValueSome) - canExec + static member cmdIf(exec: 'msg, canExec: 'model -> bool) : string -> Binding<'model, 'msg> = + Binding.Cmd.create (fun _ -> exec |> ValueSome) canExec /// /// Creates a Command binding that dispatches the specified message @@ -3578,12 +3527,12 @@ module Extensions = /// [] static member cmdIf - (exec: 'msg, - canExec: 'model -> bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdIf (exec, canExec) - >> Binding.alterMsgStream wrapDispatch + ( + exec: 'msg, + canExec: 'model -> bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdIf (exec, canExec) >> Binding.alterMsgStream wrapDispatch /// @@ -3592,13 +3541,8 @@ module Extensions = /// and can always execute. /// /// Returns the message to dispatch. - static member cmdParam - (exec: obj -> 'msg) - : string -> Binding<'model, 'msg> = - Binding.Cmd.createWithParam - (fun p _ -> exec p |> ValueSome) - (fun _ _ -> true) - false + static member cmdParam(exec: obj -> 'msg) : string -> Binding<'model, 'msg> = + Binding.Cmd.createWithParam (fun p _ -> exec p |> ValueSome) (fun _ _ -> true) false /// /// Creates a Command binding that depends on the @@ -3612,11 +3556,11 @@ module Extensions = /// [] static member cmdParam - (exec: obj -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParam exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParam exec >> Binding.alterMsgStream wrapDispatch /// @@ -3633,10 +3577,7 @@ module Extensions = /// necessary, but is needed if you have bound the CommandParameter /// to another UI property. /// - static member cmdParamIf - (exec: obj -> 'msg voption, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = + static member cmdParamIf(exec: obj -> 'msg voption, ?uiBoundCmdParam: bool) : string -> Binding<'model, 'msg> = Binding.Cmd.createWithParam (fun p _ -> exec p) (fun p _ -> exec p |> ValueOption.isSome) @@ -3654,11 +3595,11 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> 'msg voption, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'msg voption, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf exec >> Binding.alterMsgStream wrapDispatch /// /// Creates a conditional Command binding that depends on the @@ -3680,10 +3621,11 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> 'msg voption, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'msg voption, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -3702,10 +3644,7 @@ module Extensions = /// necessary, but is needed if you have bound the CommandParameter /// to another UI property. /// - static member cmdParamIf - (exec: obj -> 'msg option, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = + static member cmdParamIf(exec: obj -> 'msg option, ?uiBoundCmdParam: bool) : string -> Binding<'model, 'msg> = Binding.Cmd.createWithParam (fun p _ -> exec p |> ValueOption.ofOption) (fun p _ -> exec p |> Option.isSome) @@ -3723,11 +3662,11 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> 'msg option, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'msg option, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf exec >> Binding.alterMsgStream wrapDispatch /// /// Creates a conditional Command binding that depends on the @@ -3749,10 +3688,11 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> 'msg option, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'msg option, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -3775,9 +3715,10 @@ module Extensions = /// to another UI property. /// static member cmdParamIf - (exec: obj -> Result<'msg, 'ignored>, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> Result<'msg, 'ignored>, + ?uiBoundCmdParam: bool + ) : string -> Binding<'model, 'msg> = Binding.Cmd.createWithParam (fun p _ -> exec p |> ValueOption.ofOk) (fun p _ -> exec p |> Result.isOk) @@ -3798,11 +3739,11 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> Result<'msg, 'ignored>, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf exec - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> Result<'msg, 'ignored>, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf exec >> Binding.alterMsgStream wrapDispatch /// /// Creates a conditional Command binding that depends on the @@ -3827,10 +3768,11 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> Result<'msg, 'ignored>, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> Result<'msg, 'ignored>, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -3851,10 +3793,11 @@ module Extensions = /// to another UI property. /// static member cmdParamIf - (exec: obj -> 'msg, - canExec: obj -> bool, - ?uiBoundCmdParam: bool) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'msg, + canExec: obj -> bool, + ?uiBoundCmdParam: bool + ) : string -> Binding<'model, 'msg> = Binding.Cmd.createWithParam (fun p _ -> exec p |> ValueSome) (fun p _ -> canExec p) @@ -3873,12 +3816,12 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> 'msg, - canExec: obj -> bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = - Binding.cmdParamIf (exec, canExec) - >> Binding.alterMsgStream wrapDispatch + ( + exec: obj -> 'msg, + canExec: obj -> bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = + Binding.cmdParamIf (exec, canExec) >> Binding.alterMsgStream wrapDispatch /// /// Creates a Command binding that depends on the @@ -3901,11 +3844,12 @@ module Extensions = /// [] static member cmdParamIf - (exec: obj -> 'msg, - canExec: obj -> bool, - uiBoundCmdParam: bool, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + exec: obj -> 'msg, + canExec: obj -> bool, + uiBoundCmdParam: bool, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.cmdParamIf (exec, canExec, uiBoundCmdParam) >> Binding.alterMsgStream wrapDispatch @@ -3938,10 +3882,11 @@ module Extensions = /// Returns the message to dispatch on selections/de-selections. /// static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id voption, - set: 'id voption -> 'msg) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id voption, + set: 'id voption -> 'msg + ) : string -> Binding<'model, 'msg> = Binding.SubModelSelectedItem.vopt subModelSeqBindingName >> Binding.addLazy (=) >> Binding.mapModel get @@ -3981,11 +3926,12 @@ module Extensions = /// [] static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id voption, - set: 'id voption -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id voption, + set: 'id voption -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.subModelSelectedItem (subModelSeqBindingName, get, set) >> Binding.alterMsgStream wrapDispatch @@ -4018,10 +3964,11 @@ module Extensions = /// Returns the message to dispatch on selections/de-selections. /// static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id option, - set: 'id option -> 'msg) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id option, + set: 'id option -> 'msg + ) : string -> Binding<'model, 'msg> = Binding.SubModelSelectedItem.opt subModelSeqBindingName >> Binding.addLazy (=) >> Binding.mapModel get @@ -4061,10 +4008,11 @@ module Extensions = /// [] static member subModelSelectedItem - (subModelSeqBindingName: string, - get: 'model -> 'id option, - set: 'id option -> 'msg, - wrapDispatch: Dispatch<'msg> -> Dispatch<'msg>) - : string -> Binding<'model, 'msg> = + ( + subModelSeqBindingName: string, + get: 'model -> 'id option, + set: 'id option -> 'msg, + wrapDispatch: Dispatch<'msg> -> Dispatch<'msg> + ) : string -> Binding<'model, 'msg> = Binding.subModelSelectedItem (subModelSeqBindingName, get, set) - >> Binding.alterMsgStream wrapDispatch + >> Binding.alterMsgStream wrapDispatch \ No newline at end of file diff --git a/src/Elmish.WPF/BindingData.fs b/src/Elmish.WPF/BindingData.fs index 0b19d65e..1a6f4352 100644 --- a/src/Elmish.WPF/BindingData.fs +++ b/src/Elmish.WPF/BindingData.fs @@ -11,22 +11,20 @@ open Elmish module Helper = let mapDispatch - (getCurrentModel: unit -> 'model) - (set: 'bindingMsg -> 'model -> 'msg) - (dispatch: 'msg -> unit) - : 'bindingMsg -> unit = + (getCurrentModel: unit -> 'model) + (set: 'bindingMsg -> 'model -> 'msg) + (dispatch: 'msg -> unit) + : 'bindingMsg -> unit = fun bMsg -> getCurrentModel () |> set bMsg |> dispatch -type OneWayData<'model, 'a> = - { Get: 'model -> 'a } +type OneWayData<'model, 'a> = { Get: 'model -> 'a } -type OneWayToSourceData<'model, 'msg, 'a> = - { Set: 'a -> 'model -> 'msg } +type OneWayToSourceData<'model, 'msg, 'a> = { Set: 'a -> 'model -> 'msg } -type OneWaySeqData<'model, 'a, 'aCollection, 'id when 'id : equality> = +type OneWaySeqData<'model, 'a, 'aCollection, 'id when 'id: equality> = { Get: 'model -> 'a seq CreateCollection: 'a seq -> CollectionTarget<'a, 'aCollection> GetId: 'a -> 'id @@ -34,9 +32,11 @@ type OneWaySeqData<'model, 'a, 'aCollection, 'id when 'id : equality> = member d.Merge(values: CollectionTarget<'a, 'aCollection>, newModel: 'model) = let create v _ = v + let update oldVal newVal oldIdx = if not (d.ItemEquals newVal oldVal) then - values.SetAt (oldIdx, newVal) + values.SetAt(oldIdx, newVal) + let newVals = newModel |> d.Get |> Seq.toArray Merge.keyed d.GetId d.GetId create update values newVals @@ -46,11 +46,10 @@ type TwoWayData<'model, 'msg, 'a> = Set: 'a -> 'model -> 'msg } -type CmdData<'model, 'msg> = { - Exec: obj -> 'model -> 'msg voption - CanExec: obj -> 'model -> bool - AutoRequery: bool -} +type CmdData<'model, 'msg> = + { Exec: obj -> 'model -> 'msg voption + CanExec: obj -> 'model -> bool + AutoRequery: bool } type SubModelSelectedItemData<'model, 'msg, 'id> = @@ -59,23 +58,21 @@ type SubModelSelectedItemData<'model, 'msg, 'id> = SubModelSeqBindingName: string } -type SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = { - GetModel: 'model -> 'bindingModel voption - CreateViewModel: ViewModelArgs<'bindingModel, 'bindingMsg> -> 'vm - UpdateViewModel: 'vm * 'bindingModel -> unit - ToMsg: 'model -> 'bindingMsg -> 'msg -} +type SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = + { GetModel: 'model -> 'bindingModel voption + CreateViewModel: ViewModelArgs<'bindingModel, 'bindingMsg> -> 'vm + UpdateViewModel: 'vm * 'bindingModel -> unit + ToMsg: 'model -> 'bindingMsg -> 'msg } -and SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = { - GetState: 'model -> WindowState<'bindingModel> - CreateViewModel: ViewModelArgs<'bindingModel, 'bindingMsg> -> 'vm - UpdateViewModel: 'vm * 'bindingModel -> unit - ToMsg: 'model -> 'bindingMsg -> 'msg - GetWindow: 'model -> Dispatch<'msg> -> Window - IsModal: bool - OnCloseRequested: 'model -> 'msg voption -} +and SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = + { GetState: 'model -> WindowState<'bindingModel> + CreateViewModel: ViewModelArgs<'bindingModel, 'bindingMsg> -> 'vm + UpdateViewModel: 'vm * 'bindingModel -> unit + ToMsg: 'model -> 'bindingMsg -> 'msg + GetWindow: 'model -> Dispatch<'msg> -> Window + IsModal: bool + OnCloseRequested: 'model -> 'msg voption } and SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection> = @@ -86,7 +83,7 @@ and SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCol ToMsg: 'model -> int * 'bindingMsg -> 'msg } -and SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id when 'id : equality> = +and SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id when 'id: equality> = { GetSubModels: 'model -> 'bindingModel seq CreateViewModel: ViewModelArgs<'bindingModel, 'bindingMsg> -> 'vm CreateCollection: 'vm seq -> CollectionTarget<'vm, 'vmCollection> @@ -96,10 +93,12 @@ and SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmColle VmToId: 'vm -> 'id } member d.MergeKeyed - (create: 'bindingModel -> 'id -> 'vm, - update: 'vm -> 'bindingModel -> unit, - values: CollectionTarget<'vm, 'vmCollection>, - newSubModels: 'bindingModel []) = + ( + create: 'bindingModel -> 'id -> 'vm, + update: 'vm -> 'bindingModel -> unit, + values: CollectionTarget<'vm, 'vmCollection>, + newSubModels: 'bindingModel[] + ) = let update vm bm _ = update vm bm Merge.keyed d.BmToId d.VmToId create update values newSubModels @@ -115,25 +114,18 @@ and LazyData<'model, 'msg, 'bindingModel, 'bindingMsg, 't> = Set: 'bindingMsg -> 'model -> 'msg Equals: 'bindingModel -> 'bindingModel -> bool } - member this.MapDispatch - (getCurrentModel: unit -> 'model, - dispatch: 'msg -> unit) - : 'bindingMsg -> unit = + member this.MapDispatch(getCurrentModel: unit -> 'model, dispatch: 'msg -> unit) : 'bindingMsg -> unit = Helper.mapDispatch getCurrentModel this.Set dispatch and AlterMsgStreamData<'model, 'msg, 'bindingModel, 'bindingMsg, 'dispatchMsg, 't> = - { BindingData: BindingData<'bindingModel, 'bindingMsg, 't> - Get: 'model -> 'bindingModel - Set: 'dispatchMsg -> 'model -> 'msg - AlterMsgStream: ('dispatchMsg -> unit) -> 'bindingMsg -> unit } - - member this.MapDispatch - (getCurrentModel: unit -> 'model, - dispatch: 'msg -> unit) - : 'bindingMsg -> unit = - Helper.mapDispatch getCurrentModel this.Set dispatch - |> this.AlterMsgStream + { BindingData: BindingData<'bindingModel, 'bindingMsg, 't> + Get: 'model -> 'bindingModel + Set: 'dispatchMsg -> 'model -> 'msg + AlterMsgStream: ('dispatchMsg -> unit) -> 'bindingMsg -> unit } + + member this.MapDispatch(getCurrentModel: unit -> 'model, dispatch: 'msg -> unit) : 'bindingMsg -> unit = + Helper.mapDispatch getCurrentModel this.Set dispatch |> this.AlterMsgStream and BaseBindingData<'model, 'msg, 't> = @@ -164,242 +156,242 @@ module BindingData = let baseCase (fOut: 't0 -> 't1) (fIn: 't1 -> 't0) = function - | OneWayData d -> OneWayData { - Get = d.Get >> fOut - } - | OneWayToSourceData d -> OneWayToSourceData { - Set = fIn >> d.Set - } - | OneWaySeqData d -> OneWaySeqData { - Get = d.Get - CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut - GetId = d.GetId - ItemEquals = d.ItemEquals - } - | TwoWayData d -> TwoWayData { - Get = d.Get >> fOut - Set = fIn >> d.Set - } - | CmdData d -> CmdData { - Exec = d.Exec - CanExec = d.CanExec - AutoRequery = d.AutoRequery - } - | SubModelData d -> SubModelData { - GetModel = d.GetModel - CreateViewModel = d.CreateViewModel >> fOut - UpdateViewModel = (fun (vm,m) -> d.UpdateViewModel (fIn vm, m)) - ToMsg = d.ToMsg - } - | SubModelWinData d -> SubModelWinData { - GetState = d.GetState - CreateViewModel = d.CreateViewModel >> fOut - UpdateViewModel = (fun (vm,m) -> d.UpdateViewModel (fIn vm, m)) - ToMsg = d.ToMsg - GetWindow = d.GetWindow - IsModal = d.IsModal - OnCloseRequested = d.OnCloseRequested - } - | SubModelSeqUnkeyedData d -> SubModelSeqUnkeyedData { - GetModels = d.GetModels - CreateViewModel = d.CreateViewModel - CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut - UpdateViewModel = d.UpdateViewModel - ToMsg = d.ToMsg - } - | SubModelSeqKeyedData d -> SubModelSeqKeyedData { - GetSubModels = d.GetSubModels - CreateViewModel = d.CreateViewModel - CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut - UpdateViewModel = d.UpdateViewModel - ToMsg = d.ToMsg - VmToId = d.VmToId - BmToId = d.BmToId - } - | SubModelSelectedItemData d -> SubModelSelectedItemData { - Get = d.Get - Set = d.Set - SubModelSeqBindingName = d.SubModelSeqBindingName - } - - let rec recursiveCase<'model, 'msg, 't0, 't1> (fOut: 't0 -> 't1) (fIn: 't1 -> 't0) + | OneWayData d -> OneWayData { Get = d.Get >> fOut } + | OneWayToSourceData d -> OneWayToSourceData { Set = fIn >> d.Set } + | OneWaySeqData d -> + OneWaySeqData + { Get = d.Get + CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut + GetId = d.GetId + ItemEquals = d.ItemEquals } + | TwoWayData d -> + TwoWayData + { Get = d.Get >> fOut + Set = fIn >> d.Set } + | CmdData d -> + CmdData + { Exec = d.Exec + CanExec = d.CanExec + AutoRequery = d.AutoRequery } + | SubModelData d -> + SubModelData + { GetModel = d.GetModel + CreateViewModel = d.CreateViewModel >> fOut + UpdateViewModel = (fun (vm, m) -> d.UpdateViewModel(fIn vm, m)) + ToMsg = d.ToMsg } + | SubModelWinData d -> + SubModelWinData + { GetState = d.GetState + CreateViewModel = d.CreateViewModel >> fOut + UpdateViewModel = (fun (vm, m) -> d.UpdateViewModel(fIn vm, m)) + ToMsg = d.ToMsg + GetWindow = d.GetWindow + IsModal = d.IsModal + OnCloseRequested = d.OnCloseRequested } + | SubModelSeqUnkeyedData d -> + SubModelSeqUnkeyedData + { GetModels = d.GetModels + CreateViewModel = d.CreateViewModel + CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut + UpdateViewModel = d.UpdateViewModel + ToMsg = d.ToMsg } + | SubModelSeqKeyedData d -> + SubModelSeqKeyedData + { GetSubModels = d.GetSubModels + CreateViewModel = d.CreateViewModel + CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut + UpdateViewModel = d.UpdateViewModel + ToMsg = d.ToMsg + VmToId = d.VmToId + BmToId = d.BmToId } + | SubModelSelectedItemData d -> + SubModelSelectedItemData + { Get = d.Get + Set = d.Set + SubModelSeqBindingName = d.SubModelSeqBindingName } + + let rec recursiveCase<'model, 'msg, 't0, 't1> + (fOut: 't0 -> 't1) + (fIn: 't1 -> 't0) : BindingData<'model, 'msg, 't0> -> BindingData<'model, 'msg, 't1> = function | BaseBindingData d -> d |> baseCase fOut fIn |> BaseBindingData | CachingData d -> d |> recursiveCase<'model, 'msg, 't0, 't1> fOut fIn |> CachingData - | ValidationData d -> ValidationData { - BindingData = recursiveCase<'model, 'msg, 't0, 't1> fOut fIn d.BindingData - Validate = d.Validate - } - | LazyData d -> LazyData { - Get = d.Get - Set = d.Set - BindingData = recursiveCase fOut fIn d.BindingData - Equals = d.Equals - } - | AlterMsgStreamData d -> AlterMsgStreamData { - BindingData = recursiveCase fOut fIn d.BindingData - AlterMsgStream = d.AlterMsgStream - Get = d.Get - Set = d.Set - } + | ValidationData d -> + ValidationData + { BindingData = recursiveCase<'model, 'msg, 't0, 't1> fOut fIn d.BindingData + Validate = d.Validate } + | LazyData d -> + LazyData + { Get = d.Get + Set = d.Set + BindingData = recursiveCase fOut fIn d.BindingData + Equals = d.Equals } + | AlterMsgStreamData d -> + AlterMsgStreamData + { BindingData = recursiveCase fOut fIn d.BindingData + AlterMsgStream = d.AlterMsgStream + Get = d.Get + Set = d.Set } let boxT b = MapT.recursiveCase box unbox b let unboxT b = MapT.recursiveCase unbox box b let mapModel f = let binaryHelper binary x m = binary x (f m) - let baseCase = function - | OneWayData d -> OneWayData { - Get = f >> d.Get - } - | OneWayToSourceData d -> OneWayToSourceData { - Set = binaryHelper d.Set - } - | OneWaySeqData d -> OneWaySeqData { - Get = f >> d.Get - CreateCollection = d.CreateCollection - GetId = d.GetId - ItemEquals = d.ItemEquals - } - | TwoWayData d -> TwoWayData { - Get = f >> d.Get - Set = binaryHelper d.Set - } - | CmdData d -> CmdData { - Exec = binaryHelper d.Exec - CanExec = binaryHelper d.CanExec - AutoRequery = d.AutoRequery - } - | SubModelData d -> SubModelData { - GetModel = f >> d.GetModel - CreateViewModel = d.CreateViewModel - UpdateViewModel = d.UpdateViewModel - ToMsg = f >> d.ToMsg - } - | SubModelWinData d -> SubModelWinData { - GetState = f >> d.GetState - CreateViewModel = d.CreateViewModel - UpdateViewModel = d.UpdateViewModel - ToMsg = f >> d.ToMsg - GetWindow = f >> d.GetWindow - IsModal = d.IsModal - OnCloseRequested = f >> d.OnCloseRequested - } - | SubModelSeqUnkeyedData d -> SubModelSeqUnkeyedData { - GetModels = f >> d.GetModels - CreateViewModel = d.CreateViewModel - CreateCollection = d.CreateCollection - UpdateViewModel = d.UpdateViewModel - ToMsg = f >> d.ToMsg - } - | SubModelSeqKeyedData d -> SubModelSeqKeyedData { - GetSubModels = f >> d.GetSubModels - CreateViewModel = d.CreateViewModel - CreateCollection = d.CreateCollection - UpdateViewModel = d.UpdateViewModel - ToMsg = f >> d.ToMsg - BmToId = d.BmToId - VmToId = d.VmToId - } - | SubModelSelectedItemData d -> SubModelSelectedItemData { - Get = f >> d.Get - Set = binaryHelper d.Set - SubModelSeqBindingName = d.SubModelSeqBindingName - } - let rec recursiveCase = function + + let baseCase = + function + | OneWayData d -> OneWayData { Get = f >> d.Get } + | OneWayToSourceData d -> OneWayToSourceData { Set = binaryHelper d.Set } + | OneWaySeqData d -> + OneWaySeqData + { Get = f >> d.Get + CreateCollection = d.CreateCollection + GetId = d.GetId + ItemEquals = d.ItemEquals } + | TwoWayData d -> + TwoWayData + { Get = f >> d.Get + Set = binaryHelper d.Set } + | CmdData d -> + CmdData + { Exec = binaryHelper d.Exec + CanExec = binaryHelper d.CanExec + AutoRequery = d.AutoRequery } + | SubModelData d -> + SubModelData + { GetModel = f >> d.GetModel + CreateViewModel = d.CreateViewModel + UpdateViewModel = d.UpdateViewModel + ToMsg = f >> d.ToMsg } + | SubModelWinData d -> + SubModelWinData + { GetState = f >> d.GetState + CreateViewModel = d.CreateViewModel + UpdateViewModel = d.UpdateViewModel + ToMsg = f >> d.ToMsg + GetWindow = f >> d.GetWindow + IsModal = d.IsModal + OnCloseRequested = f >> d.OnCloseRequested } + | SubModelSeqUnkeyedData d -> + SubModelSeqUnkeyedData + { GetModels = f >> d.GetModels + CreateViewModel = d.CreateViewModel + CreateCollection = d.CreateCollection + UpdateViewModel = d.UpdateViewModel + ToMsg = f >> d.ToMsg } + | SubModelSeqKeyedData d -> + SubModelSeqKeyedData + { GetSubModels = f >> d.GetSubModels + CreateViewModel = d.CreateViewModel + CreateCollection = d.CreateCollection + UpdateViewModel = d.UpdateViewModel + ToMsg = f >> d.ToMsg + BmToId = d.BmToId + VmToId = d.VmToId } + | SubModelSelectedItemData d -> + SubModelSelectedItemData + { Get = f >> d.Get + Set = binaryHelper d.Set + SubModelSeqBindingName = d.SubModelSeqBindingName } + + let rec recursiveCase = + function | BaseBindingData d -> d |> baseCase |> BaseBindingData | CachingData d -> d |> recursiveCase |> CachingData - | ValidationData d -> ValidationData { - BindingData = recursiveCase d.BindingData - Validate = f >> d.Validate - } - | LazyData d -> LazyData { - BindingData = d.BindingData - Get = f >> d.Get - Set = binaryHelper d.Set - Equals = d.Equals - } - | AlterMsgStreamData d -> AlterMsgStreamData { - BindingData = d.BindingData - AlterMsgStream = d.AlterMsgStream - Get = f >> d.Get - Set = binaryHelper d.Set - } + | ValidationData d -> + ValidationData + { BindingData = recursiveCase d.BindingData + Validate = f >> d.Validate } + | LazyData d -> + LazyData + { BindingData = d.BindingData + Get = f >> d.Get + Set = binaryHelper d.Set + Equals = d.Equals } + | AlterMsgStreamData d -> + AlterMsgStreamData + { BindingData = d.BindingData + AlterMsgStream = d.AlterMsgStream + Get = f >> d.Get + Set = binaryHelper d.Set } + recursiveCase let mapMsgWithModel (f: 'a -> 'model -> 'b) = - let baseCase = function + let baseCase = + function | OneWayData d -> d |> OneWayData - | OneWayToSourceData d -> OneWayToSourceData { - Set = fun v m -> f (d.Set v m) m - } + | OneWayToSourceData d -> OneWayToSourceData { Set = fun v m -> f (d.Set v m) m } | OneWaySeqData d -> d |> OneWaySeqData - | TwoWayData d -> TwoWayData { - Get = d.Get - Set = fun v m -> f (d.Set v m) m - } - | CmdData d -> CmdData { - Exec = fun p m -> d.Exec p m |> ValueOption.map (fun msg -> f msg m) - CanExec = fun p m -> d.CanExec p m - AutoRequery = d.AutoRequery - } - | SubModelData d -> SubModelData { - GetModel = d.GetModel - CreateViewModel = d.CreateViewModel - UpdateViewModel = d.UpdateViewModel - ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m - } - | SubModelWinData d -> SubModelWinData { - GetState = d.GetState - CreateViewModel = d.CreateViewModel - UpdateViewModel = d.UpdateViewModel - ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m - GetWindow = fun m dispatch -> d.GetWindow m (fun msg -> f msg m |> dispatch) - IsModal = d.IsModal - OnCloseRequested = fun m -> m |> d.OnCloseRequested |> ValueOption.map (fun msg -> f msg m) - } - | SubModelSeqUnkeyedData d -> SubModelSeqUnkeyedData { - GetModels = d.GetModels - CreateViewModel = d.CreateViewModel - CreateCollection = d.CreateCollection - UpdateViewModel = d.UpdateViewModel - ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m - } - | SubModelSeqKeyedData d -> SubModelSeqKeyedData { - GetSubModels = d.GetSubModels - CreateViewModel = d.CreateViewModel - CreateCollection = d.CreateCollection - UpdateViewModel = d.UpdateViewModel - ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m - BmToId = d.BmToId - VmToId = d.VmToId - } - | SubModelSelectedItemData d -> SubModelSelectedItemData { - Get = d.Get - Set = fun v m -> f (d.Set v m) m - SubModelSeqBindingName = d.SubModelSeqBindingName - } - let rec recursiveCase = function + | TwoWayData d -> + TwoWayData + { Get = d.Get + Set = fun v m -> f (d.Set v m) m } + | CmdData d -> + CmdData + { Exec = fun p m -> d.Exec p m |> ValueOption.map (fun msg -> f msg m) + CanExec = fun p m -> d.CanExec p m + AutoRequery = d.AutoRequery } + | SubModelData d -> + SubModelData + { GetModel = d.GetModel + CreateViewModel = d.CreateViewModel + UpdateViewModel = d.UpdateViewModel + ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m } + | SubModelWinData d -> + SubModelWinData + { GetState = d.GetState + CreateViewModel = d.CreateViewModel + UpdateViewModel = d.UpdateViewModel + ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m + GetWindow = fun m dispatch -> d.GetWindow m (fun msg -> f msg m |> dispatch) + IsModal = d.IsModal + OnCloseRequested = fun m -> m |> d.OnCloseRequested |> ValueOption.map (fun msg -> f msg m) } + | SubModelSeqUnkeyedData d -> + SubModelSeqUnkeyedData + { GetModels = d.GetModels + CreateViewModel = d.CreateViewModel + CreateCollection = d.CreateCollection + UpdateViewModel = d.UpdateViewModel + ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m } + | SubModelSeqKeyedData d -> + SubModelSeqKeyedData + { GetSubModels = d.GetSubModels + CreateViewModel = d.CreateViewModel + CreateCollection = d.CreateCollection + UpdateViewModel = d.UpdateViewModel + ToMsg = fun m bMsg -> f (d.ToMsg m bMsg) m + BmToId = d.BmToId + VmToId = d.VmToId } + | SubModelSelectedItemData d -> + SubModelSelectedItemData + { Get = d.Get + Set = fun v m -> f (d.Set v m) m + SubModelSeqBindingName = d.SubModelSeqBindingName } + + let rec recursiveCase = + function | BaseBindingData d -> d |> baseCase |> BaseBindingData | CachingData d -> d |> recursiveCase |> CachingData - | ValidationData d -> ValidationData { - BindingData = recursiveCase d.BindingData - Validate = d.Validate - } + | ValidationData d -> + ValidationData + { BindingData = recursiveCase d.BindingData + Validate = d.Validate } | LazyData d -> - LazyData { - BindingData = d.BindingData - Get = d.Get - Set = fun a m -> f (d.Set a m) m - Equals = d.Equals - } - | AlterMsgStreamData d -> AlterMsgStreamData { - BindingData = d.BindingData - Get = d.Get - Set = fun a m -> f (d.Set a m) m - AlterMsgStream = d.AlterMsgStream - } + LazyData + { BindingData = d.BindingData + Get = d.Get + Set = fun a m -> f (d.Set a m) m + Equals = d.Equals } + | AlterMsgStreamData d -> + AlterMsgStreamData + { BindingData = d.BindingData + Get = d.Get + Set = fun a m -> f (d.Set a m) m + AlterMsgStream = d.AlterMsgStream } + recursiveCase let mapMsg f = mapMsgWithModel (fun a _ -> f a) @@ -409,16 +401,18 @@ module BindingData = let addCaching b = b |> CachingData let addValidation validate b = { BindingData = b; Validate = validate } |> ValidationData + let addLazy (equals: 'model -> 'model -> bool) b = - { BindingData = b |> mapModel unbox |> mapMsg box - Get = box - Set = fun (dMsg: obj) _ -> unbox dMsg - Equals = fun m1 m2 -> equals (unbox m1) (unbox m2) - } |> LazyData + { BindingData = b |> mapModel unbox |> mapMsg box + Get = box + Set = fun (dMsg: obj) _ -> unbox dMsg + Equals = fun m1 m2 -> equals (unbox m1) (unbox m2) } + |> LazyData + let alterMsgStream - (alteration: ('dispatchMsg -> unit) -> 'bindingMsg -> unit) - (b: BindingData<'bindingModel, 'bindingMsg, 't>) - : BindingData<'model, 'msg, 't> = + (alteration: ('dispatchMsg -> unit) -> 'bindingMsg -> unit) + (b: BindingData<'bindingModel, 'bindingMsg, 't>) + : BindingData<'model, 'msg, 't> = { BindingData = b |> mapModel unbox |> mapMsg box Get = box Set = fun (dMsg: obj) _ -> unbox dMsg @@ -426,16 +420,19 @@ module BindingData = fun (f: obj -> unit) -> let f' = box >> f let g = alteration f' - unbox >> g - } |> AlterMsgStreamData + unbox >> g } + |> AlterMsgStreamData + let addSticky (predicate: 'model -> bool) (binding: BindingData<'model, 'msg, 't>) = let mutable stickyModel = None + let f newModel = if predicate newModel then stickyModel <- Some newModel newModel else stickyModel |> Option.defaultValue newModel + binding |> mapModel f @@ -452,52 +449,35 @@ module BindingData = module OneWay = - let id<'a, 'msg> : BindingData<'a, 'msg, 'a> = - { Get = id } - |> OneWayData - |> BaseBindingData + let id<'a, 'msg> : BindingData<'a, 'msg, 'a> = { Get = id } |> OneWayData |> BaseBindingData - let private mapFunctions - mGet - (d: OneWayData<'model, 'a>) = - { d with Get = mGet d.Get } + let private mapFunctions mGet (d: OneWayData<'model, 'a>) = { d with Get = mGet d.Get } - let measureFunctions - mGet = - mapFunctions - (mGet "get") + let measureFunctions mGet = mapFunctions (mGet "get") module OneWayToSource = let id<'model, 'a> : BindingData<'model, 'a, 'a> = - { OneWayToSourceData.Set = Func2.id1 } - |> OneWayToSourceData - |> BaseBindingData + { OneWayToSourceData.Set = Func2.id1 } |> OneWayToSourceData |> BaseBindingData - let private mapFunctions - mSet - (d: OneWayToSourceData<'model, 'msg, 'a>) = - { d with Set = mSet d.Set } + let private mapFunctions mSet (d: OneWayToSourceData<'model, 'msg, 'a>) = { d with Set = mSet d.Set } - let measureFunctions - mSet = - mapFunctions - (mSet "set") + let measureFunctions mSet = mapFunctions (mSet "set") module OneWaySeq = let mapMinorTypes - (outMapA: 'a -> 'a0) - (outMapId: 'id -> 'id0) - (inMapA: 'a0 -> 'a) - (d: OneWaySeqData<'model, 'a, 'aCollection, 'id>) = { - Get = d.Get >> Seq.map outMapA - CreateCollection = Seq.map inMapA >> d.CreateCollection >> CollectionTarget.mapA outMapA inMapA - GetId = inMapA >> d.GetId >> outMapId - ItemEquals = fun a1 a2 -> d.ItemEquals (inMapA a1) (inMapA a2) - } + (outMapA: 'a -> 'a0) + (outMapId: 'id -> 'id0) + (inMapA: 'a0 -> 'a) + (d: OneWaySeqData<'model, 'a, 'aCollection, 'id>) + = + { Get = d.Get >> Seq.map outMapA + CreateCollection = Seq.map inMapA >> d.CreateCollection >> CollectionTarget.mapA outMapA inMapA + GetId = inMapA >> d.GetId >> outMapId + ItemEquals = fun a1 a2 -> d.ItemEquals (inMapA a1) (inMapA a2) } let boxMinorTypes d = d |> mapMinorTypes box box unbox @@ -510,46 +490,25 @@ module BindingData = |> OneWaySeqData |> BaseBindingData - let private mapFunctions - mGet - mGetId - mItemEquals - (d: OneWaySeqData<'model, 'a, 'aCollection, 'id>) = - { d with Get = mGet d.Get - GetId = mGetId d.GetId - ItemEquals = mItemEquals d.ItemEquals } - - let measureFunctions - mGet - mGetId - mItemEquals = - mapFunctions - (mGet "get") - (mGetId "getId") - (mItemEquals "itemEquals") + let private mapFunctions mGet mGetId mItemEquals (d: OneWaySeqData<'model, 'a, 'aCollection, 'id>) = + { d with + Get = mGet d.Get + GetId = mGetId d.GetId + ItemEquals = mItemEquals d.ItemEquals } + + let measureFunctions mGet mGetId mItemEquals = mapFunctions (mGet "get") (mGetId "getId") (mItemEquals "itemEquals") module TwoWay = - let id<'a> : BindingData<'a, 'a, 'a> = - { TwoWayData.Get = id - Set = Func2.id1 } - |> TwoWayData - |> BaseBindingData + let id<'a> : BindingData<'a, 'a, 'a> = { TwoWayData.Get = id; Set = Func2.id1 } |> TwoWayData |> BaseBindingData - let private mapFunctions - mGet - mSet - (d: TwoWayData<'model, 'msg, 'a>) = - { d with Get = mGet d.Get - Set = mSet d.Set } - - let measureFunctions - mGet - mSet = - mapFunctions - (mGet "get") - (mSet "set") + let private mapFunctions mGet mSet (d: TwoWayData<'model, 'msg, 'a>) = + { d with + Get = mGet d.Get + Set = mSet d.Set } + + let measureFunctions mGet mSet = mapFunctions (mGet "get") (mSet "set") module Cmd = @@ -561,31 +520,20 @@ module BindingData = |> CmdData |> BaseBindingData - let private mapFunctions - mExec - mCanExec - (d: CmdData<'model, 'msg>) = - { d with Exec = mExec d.Exec - CanExec = mCanExec d.CanExec } - - let measureFunctions - mExec - mCanExec = - mapFunctions - (mExec "exec") - (mCanExec "canExec") + let private mapFunctions mExec mCanExec (d: CmdData<'model, 'msg>) = + { d with + Exec = mExec d.Exec + CanExec = mCanExec d.CanExec } + + let measureFunctions mExec mCanExec = mapFunctions (mExec "exec") (mCanExec "canExec") module SubModelSelectedItem = - let mapMinorTypes - (outMapId: 'id -> 'id0) - (inMapId: 'id0 -> 'id) - (d: SubModelSelectedItemData<'model, 'msg, 'id>) = { - Get = d.Get >> ValueOption.map outMapId - Set = ValueOption.map inMapId >> d.Set - SubModelSeqBindingName = d.SubModelSeqBindingName - } + let mapMinorTypes (outMapId: 'id -> 'id0) (inMapId: 'id0 -> 'id) (d: SubModelSelectedItemData<'model, 'msg, 'id>) = + { Get = d.Get >> ValueOption.map outMapId + Set = ValueOption.map inMapId >> d.Set + SubModelSeqBindingName = d.SubModelSeqBindingName } let boxMinorTypes d = d |> mapMinorTypes box unbox @@ -597,34 +545,27 @@ module BindingData = |> SubModelSelectedItemData |> BaseBindingData - let private mapFunctions - mGet - mSet - (d: SubModelSelectedItemData<'model, 'msg, 'id>) = - { d with Get = mGet d.Get - Set = mSet d.Set } - - let measureFunctions - mGet - mSet = - mapFunctions - (mGet "get") - (mSet "set") + let private mapFunctions mGet mSet (d: SubModelSelectedItemData<'model, 'msg, 'id>) = + { d with + Get = mGet d.Get + Set = mSet d.Set } + + let measureFunctions mGet mSet = mapFunctions (mGet "get") (mSet "set") module SubModel = let mapMinorTypes - (outMapBindingModel: 'bindingModel -> 'bindingModel0) - (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) - (inMapBindingModel: 'bindingModel0 -> 'bindingModel) - (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) - (d: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) = { - GetModel = d.GetModel >> ValueOption.map outMapBindingModel - CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) - UpdateViewModel = fun (vm, m) -> (vm, inMapBindingModel m) |> d.UpdateViewModel - ToMsg = fun m bMsg -> d.ToMsg m (inMapBindingMsg bMsg) - } + (outMapBindingModel: 'bindingModel -> 'bindingModel0) + (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) + (inMapBindingModel: 'bindingModel0 -> 'bindingModel) + (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) + (d: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) + = + { GetModel = d.GetModel >> ValueOption.map outMapBindingModel + CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) + UpdateViewModel = fun (vm, m) -> (vm, inMapBindingModel m) |> d.UpdateViewModel + ToMsg = fun m bMsg -> d.ToMsg m (inMapBindingMsg bMsg) } let boxMinorTypes d = d |> mapMinorTypes box box unbox unbox @@ -638,22 +579,19 @@ module BindingData = |> BaseBindingData let private mapFunctions - mGetModel - mGetBindings - mUpdateViewModel - mToMsg - (d: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) - : SubModelData<'model,'msg,'bindingModel,'bindingMsg,'vm> = - { d with GetModel = mGetModel d.GetModel - CreateViewModel = mGetBindings d.CreateViewModel - UpdateViewModel = mUpdateViewModel d.UpdateViewModel - ToMsg = mToMsg d.ToMsg } - - let measureFunctions - mGetModel - mGetBindings - mUpdateViewModel - mToMsg = + mGetModel + mGetBindings + mUpdateViewModel + mToMsg + (d: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) + : SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = + { d with + GetModel = mGetModel d.GetModel + CreateViewModel = mGetBindings d.CreateViewModel + UpdateViewModel = mUpdateViewModel d.UpdateViewModel + ToMsg = mToMsg d.ToMsg } + + let measureFunctions mGetModel mGetBindings mUpdateViewModel mToMsg = mapFunctions (mGetModel "getSubModel") // sic: "getModel" would be following the pattern (mGetBindings "bindings") // sic: "getBindings" would be following the pattern @@ -664,19 +602,19 @@ module BindingData = module SubModelWin = let mapMinorTypes - (outMapBindingModel: 'bindingModel -> 'bindingModel0) - (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) - (inMapBindingModel: 'bindingModel0 -> 'bindingModel) - (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) - (d: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) = { - GetState = d.GetState >> WindowState.map outMapBindingModel - CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) - UpdateViewModel = fun (vm, m) -> d.UpdateViewModel (vm, inMapBindingModel m) - ToMsg = fun m bMsg -> d.ToMsg m (inMapBindingMsg bMsg) - GetWindow = d.GetWindow - IsModal = d.IsModal - OnCloseRequested = d.OnCloseRequested - } + (outMapBindingModel: 'bindingModel -> 'bindingModel0) + (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) + (inMapBindingModel: 'bindingModel0 -> 'bindingModel) + (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) + (d: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) + = + { GetState = d.GetState >> WindowState.map outMapBindingModel + CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) + UpdateViewModel = fun (vm, m) -> d.UpdateViewModel(vm, inMapBindingModel m) + ToMsg = fun m bMsg -> d.ToMsg m (inMapBindingMsg bMsg) + GetWindow = d.GetWindow + IsModal = d.IsModal + OnCloseRequested = d.OnCloseRequested } let boxMinorTypes d = d |> mapMinorTypes box box unbox unbox @@ -693,25 +631,23 @@ module BindingData = |> BaseBindingData let private mapFunctions - mGetState - mGetBindings - mUpdateViewModel - mToMsg - mGetWindow - mOnCloseRequested - (d: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) = - { d with GetState = mGetState d.GetState - CreateViewModel = mGetBindings d.CreateViewModel - UpdateViewModel = mUpdateViewModel d.UpdateViewModel - ToMsg = mToMsg d.ToMsg - GetWindow = mGetWindow d.GetWindow - OnCloseRequested = mOnCloseRequested d.OnCloseRequested } - - let measureFunctions - mGetState - mGetBindings - mUpdateViewModel - mToMsg = + mGetState + mGetBindings + mUpdateViewModel + mToMsg + mGetWindow + mOnCloseRequested + (d: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) + = + { d with + GetState = mGetState d.GetState + CreateViewModel = mGetBindings d.CreateViewModel + UpdateViewModel = mUpdateViewModel d.UpdateViewModel + ToMsg = mToMsg d.ToMsg + GetWindow = mGetWindow d.GetWindow + OnCloseRequested = mOnCloseRequested d.OnCloseRequested } + + let measureFunctions mGetState mGetBindings mUpdateViewModel mToMsg = mapFunctions (mGetState "getState") (mGetBindings "bindings") // sic: "getBindings" would be following the pattern @@ -724,19 +660,25 @@ module BindingData = module SubModelSeqUnkeyed = let mapMinorTypes - (outMapBindingModel: 'bindingModel -> 'bindingModel0) - (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) - (outMapBindingViewModel: 'vm -> 'vm0) - (inMapBindingModel: 'bindingModel0 -> 'bindingModel) - (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) - (inMapBindingViewModel: 'vm0 -> 'vm) - (d: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection>) = { - GetModels = d.GetModels >> Seq.map outMapBindingModel - CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) |> outMapBindingViewModel - CreateCollection = Seq.map inMapBindingViewModel >> d.CreateCollection >> CollectionTarget.mapA outMapBindingViewModel inMapBindingViewModel - UpdateViewModel = fun (vm, m) -> d.UpdateViewModel (inMapBindingViewModel vm, inMapBindingModel m) - ToMsg = fun m (idx, bMsg) -> d.ToMsg m (idx, (inMapBindingMsg bMsg)) - } + (outMapBindingModel: 'bindingModel -> 'bindingModel0) + (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) + (outMapBindingViewModel: 'vm -> 'vm0) + (inMapBindingModel: 'bindingModel0 -> 'bindingModel) + (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) + (inMapBindingViewModel: 'vm0 -> 'vm) + (d: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection>) + = + { GetModels = d.GetModels >> Seq.map outMapBindingModel + CreateViewModel = + fun args -> + d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) + |> outMapBindingViewModel + CreateCollection = + Seq.map inMapBindingViewModel + >> d.CreateCollection + >> CollectionTarget.mapA outMapBindingViewModel inMapBindingViewModel + UpdateViewModel = fun (vm, m) -> d.UpdateViewModel(inMapBindingViewModel vm, inMapBindingModel m) + ToMsg = fun m (idx, bMsg) -> d.ToMsg m (idx, (inMapBindingMsg bMsg)) } let boxMinorTypes d = d |> mapMinorTypes box box box unbox unbox unbox @@ -751,24 +693,21 @@ module BindingData = |> BaseBindingData let private mapFunctions - mGetModels - mGetBindings - mCreateCollection - mUpdateViewModel - mToMsg - (d: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection>) = - { d with GetModels = mGetModels d.GetModels - CreateViewModel = mGetBindings d.CreateViewModel - CreateCollection = mCreateCollection d.CreateCollection - UpdateViewModel = mUpdateViewModel d.UpdateViewModel - ToMsg = mToMsg d.ToMsg } - - let measureFunctions - mGetModels - mGetBindings - mCreateCollection - mUpdateViewModel - mToMsg = + mGetModels + mGetBindings + mCreateCollection + mUpdateViewModel + mToMsg + (d: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection>) + = + { d with + GetModels = mGetModels d.GetModels + CreateViewModel = mGetBindings d.CreateViewModel + CreateCollection = mCreateCollection d.CreateCollection + UpdateViewModel = mUpdateViewModel d.UpdateViewModel + ToMsg = mToMsg d.ToMsg } + + let measureFunctions mGetModels mGetBindings mCreateCollection mUpdateViewModel mToMsg = mapFunctions (mGetModels "getSubModels") // sic: "getModels" would follow the pattern (mGetBindings "bindings") // sic: "getBindings" would follow the pattern @@ -779,102 +718,89 @@ module BindingData = module SubModelSeqKeyed = - let mapMinorTypes - (outMapBindingModel: 'bindingModel -> 'bindingModel0) - (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) - (outMapBindingViewModel: 'vm -> 'vm0) - (outMapId: 'id -> 'id0) - (inMapBindingModel: 'bindingModel0 -> 'bindingModel) - (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) - (inMapBindingViewModel: 'vm0 -> 'vm) - (inMapId: 'id0 -> 'id) - (d: SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id>) = { - GetSubModels = d.GetSubModels >> Seq.map outMapBindingModel - CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) |> outMapBindingViewModel - CreateCollection = Seq.map inMapBindingViewModel >> d.CreateCollection >> CollectionTarget.mapA outMapBindingViewModel inMapBindingViewModel + let mapMinorTypes + (outMapBindingModel: 'bindingModel -> 'bindingModel0) + (outMapBindingMsg: 'bindingMsg -> 'bindingMsg0) + (outMapBindingViewModel: 'vm -> 'vm0) + (outMapId: 'id -> 'id0) + (inMapBindingModel: 'bindingModel0 -> 'bindingModel) + (inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg) + (inMapBindingViewModel: 'vm0 -> 'vm) + (inMapId: 'id0 -> 'id) + (d: SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id>) + = + { GetSubModels = d.GetSubModels >> Seq.map outMapBindingModel + CreateViewModel = + fun args -> + d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) + |> outMapBindingViewModel + CreateCollection = + Seq.map inMapBindingViewModel + >> d.CreateCollection + >> CollectionTarget.mapA outMapBindingViewModel inMapBindingViewModel UpdateViewModel = fun (vm, m) -> (inMapBindingViewModel vm, inMapBindingModel m) |> d.UpdateViewModel ToMsg = fun m (id, bMsg) -> d.ToMsg m ((inMapId id), (inMapBindingMsg bMsg)) BmToId = inMapBindingModel >> d.BmToId >> outMapId - VmToId = fun vm -> vm |> inMapBindingViewModel |> d.VmToId |> outMapId - } - - let boxMinorTypes d = d |> mapMinorTypes box box box box unbox unbox unbox unbox - - let create createViewModel updateViewModel bmToId vmToId = - { GetSubModels = (fun x -> upcast x) - CreateViewModel = createViewModel - CreateCollection = ObservableCollection >> CollectionTarget.create - UpdateViewModel = updateViewModel - ToMsg = Func2.id2 - BmToId = bmToId - VmToId = vmToId } - |> boxMinorTypes - |> SubModelSeqKeyedData - |> BaseBindingData - - let private mapFunctions - mGetSubModels - mGetBindings - mCreateCollection - mUpdateViewModel - mToMsg - mGetId - mGetVmId - (d: SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id>) = - { d with GetSubModels = mGetSubModels d.GetSubModels - CreateViewModel = mGetBindings d.CreateViewModel - CreateCollection = mCreateCollection d.CreateCollection - UpdateViewModel = mUpdateViewModel d.UpdateViewModel - ToMsg = mToMsg d.ToMsg - BmToId = mGetId d.BmToId - VmToId = mGetVmId d.VmToId } - - let measureFunctions - mGetSubModels - mGetBindings - mCreateCollection - mUpdateViewModel - mToMsg - mGetId - mGetVmId = - mapFunctions - (mGetSubModels "getSubModels") - (mGetBindings "getBindings") - (mCreateCollection "createCollection") - (mUpdateViewModel "updateViewModel") - (mToMsg "toMsg") - (mGetId "getId") - (mGetVmId "getVmId") + VmToId = fun vm -> vm |> inMapBindingViewModel |> d.VmToId |> outMapId } + let boxMinorTypes d = d |> mapMinorTypes box box box box unbox unbox unbox unbox - module Validation = + let create createViewModel updateViewModel bmToId vmToId = + { GetSubModels = (fun x -> upcast x) + CreateViewModel = createViewModel + CreateCollection = ObservableCollection >> CollectionTarget.create + UpdateViewModel = updateViewModel + ToMsg = Func2.id2 + BmToId = bmToId + VmToId = vmToId } + |> boxMinorTypes + |> SubModelSeqKeyedData + |> BaseBindingData let private mapFunctions - mValidate - (d: ValidationData<'model, 'msg, 't>) = - { d with Validate = mValidate d.Validate } - - let measureFunctions - mValidate = + mGetSubModels + mGetBindings + mCreateCollection + mUpdateViewModel + mToMsg + mGetId + mGetVmId + (d: SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id>) + = + { d with + GetSubModels = mGetSubModels d.GetSubModels + CreateViewModel = mGetBindings d.CreateViewModel + CreateCollection = mCreateCollection d.CreateCollection + UpdateViewModel = mUpdateViewModel d.UpdateViewModel + ToMsg = mToMsg d.ToMsg + BmToId = mGetId d.BmToId + VmToId = mGetVmId d.VmToId } + + let measureFunctions mGetSubModels mGetBindings mCreateCollection mUpdateViewModel mToMsg mGetId mGetVmId = mapFunctions - (mValidate "validate") + (mGetSubModels "getSubModels") + (mGetBindings "getBindings") + (mCreateCollection "createCollection") + (mUpdateViewModel "updateViewModel") + (mToMsg "toMsg") + (mGetId "getId") + (mGetVmId "getVmId") + + + module Validation = + + let private mapFunctions mValidate (d: ValidationData<'model, 'msg, 't>) = + { d with + Validate = mValidate d.Validate } + + let measureFunctions mValidate = mapFunctions (mValidate "validate") module Lazy = - let private mapFunctions - mGet - mSet - mEquals - (d: LazyData<'model, 'msg, 'bindingModel, 'bindingMsg, 't>) = - { d with Get = mGet d.Get - Set = mSet d.Set - Equals = mEquals d.Equals } - - let measureFunctions - mGet - mSet - mEquals = - mapFunctions - (mGet "get") - (mSet "set") - (mEquals "equals") + let private mapFunctions mGet mSet mEquals (d: LazyData<'model, 'msg, 'bindingModel, 'bindingMsg, 't>) = + { d with + Get = mGet d.Get + Set = mSet d.Set + Equals = mEquals d.Equals } + + let measureFunctions mGet mSet mEquals = mapFunctions (mGet "get") (mSet "set") (mEquals "equals") \ No newline at end of file diff --git a/src/Elmish.WPF/BindingVmHelpers.fs b/src/Elmish.WPF/BindingVmHelpers.fs index b05517c6..5d454ad9 100644 --- a/src/Elmish.WPF/BindingVmHelpers.fs +++ b/src/Elmish.WPF/BindingVmHelpers.fs @@ -13,7 +13,10 @@ type UpdateData = | CanExecuteChanged of Command module UpdateData = - let isPropertyChanged = function PropertyChanged _ -> true | _ -> false + let isPropertyChanged = + function + | PropertyChanged _ -> true + | _ -> false type GetErrorSubModelSelectedItem = @@ -30,15 +33,16 @@ type GetError = module Helpers2 = let showNewWindow - (winRef: WeakReference) - (getWindow: 'model -> Dispatch<'msg> -> Window) - (isDialog: bool) - (onCloseRequested: 'model -> 'msg voption) - (preventClose: bool ref) - dataContext - (initialVisibility: Visibility) - (getCurrentModel: unit -> 'model) - (dispatch: 'msg -> unit) = + (winRef: WeakReference) + (getWindow: 'model -> Dispatch<'msg> -> Window) + (isDialog: bool) + (onCloseRequested: 'model -> 'msg voption) + (preventClose: bool ref) + dataContext + (initialVisibility: Visibility) + (getCurrentModel: unit -> 'model) + (dispatch: 'msg -> unit) + = let win = getWindow (getCurrentModel ()) dispatch winRef.SetTarget win (* @@ -48,12 +52,13 @@ module Helpers2 = *) win.Dispatcher.InvokeAsync(fun () -> win.DataContext <- dataContext + win.Closing.Add(fun ev -> ev.Cancel <- preventClose.Value - getCurrentModel () |> onCloseRequested |> ValueOption.iter dispatch - ) + getCurrentModel () |> onCloseRequested |> ValueOption.iter dispatch) + if isDialog then - win.ShowDialog () |> ignore + win.ShowDialog() |> ignore else (* * Calling Show achieves the same end result as setting Visibility @@ -67,94 +72,102 @@ module Helpers2 = * returns immediately * https://docs.microsoft.com/en-us/dotnet/api/system.windows.window.show *) - win.Visibility <- initialVisibility - ) |> ignore - - let measure (logPerformance: ILogger) (logLevel: LogLevel) (performanceLogThresholdMs: int) (name: string) (nameChain: string) (callName: string) f = - if not <| logPerformance.IsEnabled(logLevel) then f + win.Visibility <- initialVisibility) + |> ignore + + let measure + (logPerformance: ILogger) + (logLevel: LogLevel) + (performanceLogThresholdMs: int) + (name: string) + (nameChain: string) + (callName: string) + f + = + if not <| logPerformance.IsEnabled(logLevel) then + f else fun a -> - let sw = System.Diagnostics.Stopwatch.StartNew () + let sw = System.Diagnostics.Stopwatch.StartNew() let b = f a - sw.Stop () + sw.Stop() + if sw.ElapsedMilliseconds >= int64 performanceLogThresholdMs then - logPerformance.Log(logLevel, "[{BindingNameChain}] {CallName} ({Elapsed}ms): {MeasureName}", nameChain, callName, sw.ElapsedMilliseconds, name) + logPerformance.Log( + logLevel, + "[{BindingNameChain}] {CallName} ({Elapsed}ms): {MeasureName}", + nameChain, + callName, + sw.ElapsedMilliseconds, + name + ) + b let measure2 (logPerformance: ILogger) (logLevel: LogLevel) performanceLogThresholdMs name nameChain callName f = - if not <| logPerformance.IsEnabled(logLevel) - then f - else fun a -> measure logPerformance logLevel performanceLogThresholdMs name nameChain callName (f a) - - -type OneWayBinding<'model, 'a> = { - OneWayData: OneWayData<'model, 'a> -} - -type OneWayToSourceBinding<'model, 'a> = { - Set: 'a -> 'model -> unit -} - -type OneWaySeqBinding<'model, 'a, 'aCollection, 'id when 'id : equality> = { - OneWaySeqData: OneWaySeqData<'model, 'a, 'aCollection, 'id> - Values: CollectionTarget<'a, 'aCollection> -} - -type TwoWayBinding<'model, 'a> = { - Get: 'model -> 'a - Set: 'a -> 'model -> unit -} - -type SubModelBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = { - SubModelData: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> - Dispatch: 'msg -> unit - GetVm: unit -> 'vm voption - SetVm: 'vm voption -> unit - GetCurrentModel: unit -> 'model -} - -type SubModelWinBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = { - SubModelWinData: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> - Dispatch: 'msg -> unit - WinRef: WeakReference - PreventClose: bool ref - GetVmWinState: unit -> WindowState<'vm> - SetVmWinState: WindowState<'vm> -> unit - GetCurrentModel: unit -> 'model -} - -type SubModelSeqUnkeyedBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection> = { - SubModelSeqUnkeyedData: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection> - Dispatch: 'msg -> unit - Vms: CollectionTarget<'vm, 'vmCollection> - GetCurrentModel: unit -> 'model -} - -type SubModelSeqKeyedBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id when 'id : equality> = + if not <| logPerformance.IsEnabled(logLevel) then + f + else + fun a -> measure logPerformance logLevel performanceLogThresholdMs name nameChain callName (f a) + + +type OneWayBinding<'model, 'a> = { OneWayData: OneWayData<'model, 'a> } + +type OneWayToSourceBinding<'model, 'a> = { Set: 'a -> 'model -> unit } + +type OneWaySeqBinding<'model, 'a, 'aCollection, 'id when 'id: equality> = + { OneWaySeqData: OneWaySeqData<'model, 'a, 'aCollection, 'id> + Values: CollectionTarget<'a, 'aCollection> } + +type TwoWayBinding<'model, 'a> = + { Get: 'model -> 'a + Set: 'a -> 'model -> unit } + +type SubModelBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = + { SubModelData: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> + Dispatch: 'msg -> unit + GetVm: unit -> 'vm voption + SetVm: 'vm voption -> unit + GetCurrentModel: unit -> 'model } + +type SubModelWinBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = + { SubModelWinData: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> + Dispatch: 'msg -> unit + WinRef: WeakReference + PreventClose: bool ref + GetVmWinState: unit -> WindowState<'vm> + SetVmWinState: WindowState<'vm> -> unit + GetCurrentModel: unit -> 'model } + +type SubModelSeqUnkeyedBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection> = + { SubModelSeqUnkeyedData: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection> + Dispatch: 'msg -> unit + Vms: CollectionTarget<'vm, 'vmCollection> + GetCurrentModel: unit -> 'model } + +type SubModelSeqKeyedBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id when 'id: equality> = { SubModelSeqKeyedData: SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id> Dispatch: 'msg -> unit Vms: CollectionTarget<'vm, 'vmCollection> - GetCurrentModel: unit -> 'model - } + GetCurrentModel: unit -> 'model } member b.FromId(id: 'id) = - b.Vms.Enumerate () + b.Vms.Enumerate() |> Seq.tryFind (fun vm -> vm |> b.SubModelSeqKeyedData.VmToId |> (=) id) -type SelectedItemBinding<'bindingModel, 'bindingMsg, 'vm, 'id> = { - FromId: 'id -> 'vm option - VmToId: 'vm -> 'id -} +type SelectedItemBinding<'bindingModel, 'bindingMsg, 'vm, 'id> = + { FromId: 'id -> 'vm option + VmToId: 'vm -> 'id } type SubModelSelectedItemBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'id> = { Get: 'model -> 'id voption Set: 'id voption -> 'model -> unit SubModelSeqBindingName: string - SelectedItemBinding: SelectedItemBinding<'bindingModel, 'bindingMsg, 'vm, 'id> - } + SelectedItemBinding: SelectedItemBinding<'bindingModel, 'bindingMsg, 'vm, 'id> } member b.TypedGet(model: 'model) = - b.Get model |> ValueOption.map (fun selectedId -> selectedId, b.SelectedItemBinding.FromId selectedId) + b.Get model + |> ValueOption.map (fun selectedId -> selectedId, b.SelectedItemBinding.FromId selectedId) member b.TypedSet(model: 'model, vm: 'vm voption) = let id = vm |> ValueOption.map b.SelectedItemBinding.VmToId @@ -174,28 +187,24 @@ type BaseVmBinding<'model, 'msg, 't> = | SubModelSelectedItem of SubModelSelectedItemBinding<'model, 'msg, obj, obj, 't, obj> -type CachedBinding<'model, 'msg, 't> = { - Binding: VmBinding<'model, 'msg, 't> - GetCache: unit -> 't option - SetCache: 't option -> unit -} +type CachedBinding<'model, 'msg, 't> = + { Binding: VmBinding<'model, 'msg, 't> + GetCache: unit -> 't option + SetCache: 't option -> unit } -and ValidationBinding<'model, 'msg, 't> = { - Binding: VmBinding<'model, 'msg, 't> - Validate: 'model -> string list - Errors: string list ref -} +and ValidationBinding<'model, 'msg, 't> = + { Binding: VmBinding<'model, 'msg, 't> + Validate: 'model -> string list + Errors: string list ref } -and LazyBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 't> = { - Binding: VmBinding<'bindingModel, 'bindingMsg, 't> - Get: 'model -> 'bindingModel - Equals: 'bindingModel -> 'bindingModel -> bool -} +and LazyBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 't> = + { Binding: VmBinding<'bindingModel, 'bindingMsg, 't> + Get: 'model -> 'bindingModel + Equals: 'bindingModel -> 'bindingModel -> bool } -and AlterMsgStreamBinding<'model, 'bindingModel, 'bindingMsg, 't> = { - Binding: VmBinding<'bindingModel, 'bindingMsg, 't> - Get: 'model -> 'bindingModel -} +and AlterMsgStreamBinding<'model, 'bindingModel, 'bindingMsg, 't> = + { Binding: VmBinding<'bindingModel, 'bindingMsg, 't> + Get: 'model -> 'bindingModel } /// Represents all necessary data used in an active binding. and VmBinding<'model, 'msg, 't> = @@ -205,106 +214,129 @@ and VmBinding<'model, 'msg, 't> = | Lazy of LazyBinding<'model, 'msg, obj, obj, 't> | AlterMsgStream of AlterMsgStreamBinding<'model, obj, obj, 't> - with - member this.AddCaching = let mutable cache = None in Cached { Binding = this; GetCache = (fun () -> cache); SetCache = fun c -> cache <- c } - member this.AddValidation currentModel validate = + member this.AddCaching = + let mutable cache = None in + + Cached { Binding = this - Validate = validate - Errors = currentModel |> validate |> ref } - |> Validatation + GetCache = (fun () -> cache) + SetCache = fun c -> cache <- c } + + member this.AddValidation currentModel validate = + { Binding = this + Validate = validate + Errors = currentModel |> validate |> ref } + |> Validatation module internal MapOutputType = - let private baseCase (fOut: 'a -> 'b) (fIn: 'b -> 'a) (data: BaseVmBinding<'model, 'msg, 'a>) : BaseVmBinding<'model, 'msg, 'b> = + let private baseCase + (fOut: 'a -> 'b) + (fIn: 'b -> 'a) + (data: BaseVmBinding<'model, 'msg, 'a>) + : BaseVmBinding<'model, 'msg, 'b> = match data with | OneWay b -> OneWay { OneWayData = { Get = b.OneWayData.Get >> fOut } } | OneWayToSource b -> OneWayToSource { Set = fIn >> b.Set } | Cmd b -> Cmd b - | TwoWay b -> TwoWay { Get = b.Get >> fOut; Set = fIn >> b.Set } - | OneWaySeq b -> OneWaySeq { - OneWaySeqData = { - Get = b.OneWaySeqData.Get - CreateCollection = b.OneWaySeqData.CreateCollection >> CollectionTarget.mapCollection fOut - GetId = b.OneWaySeqData.GetId - ItemEquals = b.OneWaySeqData.ItemEquals } - Values = b.Values |> CollectionTarget.mapCollection fOut } - | SubModel b -> SubModel { - SubModelData = { - GetModel = b.SubModelData.GetModel - CreateViewModel = b.SubModelData.CreateViewModel >> fOut - UpdateViewModel = (fun (vm,m) -> b.SubModelData.UpdateViewModel (fIn vm, m)) - ToMsg = b.SubModelData.ToMsg } - Dispatch = b.Dispatch - GetVm = b.GetVm >> ValueOption.map fOut - SetVm = ValueOption.map fIn >> b.SetVm - GetCurrentModel = b.GetCurrentModel } - | SubModelWin b -> SubModelWin { - SubModelWinData = { - GetState = b.SubModelWinData.GetState - CreateViewModel = b.SubModelWinData.CreateViewModel >> fOut - UpdateViewModel = (fun (vm,m) -> b.SubModelWinData.UpdateViewModel (fIn vm, m)) - ToMsg = b.SubModelWinData.ToMsg - GetWindow = b.SubModelWinData.GetWindow - IsModal = b.SubModelWinData.IsModal - OnCloseRequested = b.SubModelWinData.OnCloseRequested } - Dispatch = b.Dispatch - WinRef = b.WinRef - PreventClose = b.PreventClose - GetVmWinState = b.GetVmWinState >> WindowState.map fOut - SetVmWinState = WindowState.map fIn >> b.SetVmWinState - GetCurrentModel = b.GetCurrentModel } - | SubModelSeqUnkeyed b -> SubModelSeqUnkeyed { - SubModelSeqUnkeyedData = { - GetModels = b.SubModelSeqUnkeyedData.GetModels - CreateViewModel = b.SubModelSeqUnkeyedData.CreateViewModel - CreateCollection = b.SubModelSeqUnkeyedData.CreateCollection >> CollectionTarget.mapCollection fOut - UpdateViewModel = b.SubModelSeqUnkeyedData.UpdateViewModel - ToMsg = b.SubModelSeqUnkeyedData.ToMsg } - Dispatch = b.Dispatch - Vms = b.Vms |> CollectionTarget.mapCollection fOut - GetCurrentModel = b.GetCurrentModel } - | SubModelSeqKeyed b -> SubModelSeqKeyed { - SubModelSeqKeyedData = { - GetSubModels = b.SubModelSeqKeyedData.GetSubModels - CreateViewModel = b.SubModelSeqKeyedData.CreateViewModel - CreateCollection = b.SubModelSeqKeyedData.CreateCollection >> CollectionTarget.mapCollection fOut - UpdateViewModel = b.SubModelSeqKeyedData.UpdateViewModel - ToMsg = b.SubModelSeqKeyedData.ToMsg - BmToId = b.SubModelSeqKeyedData.BmToId - VmToId = b.SubModelSeqKeyedData.VmToId } - Dispatch = b.Dispatch - Vms = b.Vms |> CollectionTarget.mapCollection fOut - GetCurrentModel = b.GetCurrentModel } - | SubModelSelectedItem b -> SubModelSelectedItem { - Get = b.Get - Set = b.Set - SubModelSeqBindingName = b.SubModelSeqBindingName - SelectedItemBinding = { - VmToId = fIn >> b.SelectedItemBinding.VmToId - FromId = b.SelectedItemBinding.FromId >> Option.map fOut } } - - let rec private recursiveCase<'model, 'msg, 'a, 'b> (fOut: 'a -> 'b) (fIn: 'b -> 'a) (data: VmBinding<'model, 'msg, 'a>) : VmBinding<'model, 'msg, 'b> = + | TwoWay b -> + TwoWay + { Get = b.Get >> fOut + Set = fIn >> b.Set } + | OneWaySeq b -> + OneWaySeq + { OneWaySeqData = + { Get = b.OneWaySeqData.Get + CreateCollection = b.OneWaySeqData.CreateCollection >> CollectionTarget.mapCollection fOut + GetId = b.OneWaySeqData.GetId + ItemEquals = b.OneWaySeqData.ItemEquals } + Values = b.Values |> CollectionTarget.mapCollection fOut } + | SubModel b -> + SubModel + { SubModelData = + { GetModel = b.SubModelData.GetModel + CreateViewModel = b.SubModelData.CreateViewModel >> fOut + UpdateViewModel = (fun (vm, m) -> b.SubModelData.UpdateViewModel(fIn vm, m)) + ToMsg = b.SubModelData.ToMsg } + Dispatch = b.Dispatch + GetVm = b.GetVm >> ValueOption.map fOut + SetVm = ValueOption.map fIn >> b.SetVm + GetCurrentModel = b.GetCurrentModel } + | SubModelWin b -> + SubModelWin + { SubModelWinData = + { GetState = b.SubModelWinData.GetState + CreateViewModel = b.SubModelWinData.CreateViewModel >> fOut + UpdateViewModel = (fun (vm, m) -> b.SubModelWinData.UpdateViewModel(fIn vm, m)) + ToMsg = b.SubModelWinData.ToMsg + GetWindow = b.SubModelWinData.GetWindow + IsModal = b.SubModelWinData.IsModal + OnCloseRequested = b.SubModelWinData.OnCloseRequested } + Dispatch = b.Dispatch + WinRef = b.WinRef + PreventClose = b.PreventClose + GetVmWinState = b.GetVmWinState >> WindowState.map fOut + SetVmWinState = WindowState.map fIn >> b.SetVmWinState + GetCurrentModel = b.GetCurrentModel } + | SubModelSeqUnkeyed b -> + SubModelSeqUnkeyed + { SubModelSeqUnkeyedData = + { GetModels = b.SubModelSeqUnkeyedData.GetModels + CreateViewModel = b.SubModelSeqUnkeyedData.CreateViewModel + CreateCollection = b.SubModelSeqUnkeyedData.CreateCollection >> CollectionTarget.mapCollection fOut + UpdateViewModel = b.SubModelSeqUnkeyedData.UpdateViewModel + ToMsg = b.SubModelSeqUnkeyedData.ToMsg } + Dispatch = b.Dispatch + Vms = b.Vms |> CollectionTarget.mapCollection fOut + GetCurrentModel = b.GetCurrentModel } + | SubModelSeqKeyed b -> + SubModelSeqKeyed + { SubModelSeqKeyedData = + { GetSubModels = b.SubModelSeqKeyedData.GetSubModels + CreateViewModel = b.SubModelSeqKeyedData.CreateViewModel + CreateCollection = b.SubModelSeqKeyedData.CreateCollection >> CollectionTarget.mapCollection fOut + UpdateViewModel = b.SubModelSeqKeyedData.UpdateViewModel + ToMsg = b.SubModelSeqKeyedData.ToMsg + BmToId = b.SubModelSeqKeyedData.BmToId + VmToId = b.SubModelSeqKeyedData.VmToId } + Dispatch = b.Dispatch + Vms = b.Vms |> CollectionTarget.mapCollection fOut + GetCurrentModel = b.GetCurrentModel } + | SubModelSelectedItem b -> + SubModelSelectedItem + { Get = b.Get + Set = b.Set + SubModelSeqBindingName = b.SubModelSeqBindingName + SelectedItemBinding = + { VmToId = fIn >> b.SelectedItemBinding.VmToId + FromId = b.SelectedItemBinding.FromId >> Option.map fOut } } + + let rec private recursiveCase<'model, 'msg, 'a, 'b> + (fOut: 'a -> 'b) + (fIn: 'b -> 'a) + (data: VmBinding<'model, 'msg, 'a>) + : VmBinding<'model, 'msg, 'b> = match data with | BaseVmBinding b -> baseCase fOut fIn b |> BaseVmBinding - | Cached b -> Cached { - Binding = recursiveCase fOut fIn b.Binding - GetCache = b.GetCache >> Option.map fOut - SetCache = Option.map fIn >> b.SetCache - } - | AlterMsgStream b -> AlterMsgStream { - Binding = recursiveCase fOut fIn b.Binding - Get = b.Get - } - | Lazy b -> Lazy { - Get = b.Get - Binding = recursiveCase fOut fIn b.Binding - Equals = b.Equals - } - | Validatation b -> Validatation { - Binding = recursiveCase fOut fIn b.Binding - Errors = b.Errors - Validate = b.Validate - } + | Cached b -> + Cached + { Binding = recursiveCase fOut fIn b.Binding + GetCache = b.GetCache >> Option.map fOut + SetCache = Option.map fIn >> b.SetCache } + | AlterMsgStream b -> + AlterMsgStream + { Binding = recursiveCase fOut fIn b.Binding + Get = b.Get } + | Lazy b -> + Lazy + { Get = b.Get + Binding = recursiveCase fOut fIn b.Binding + Equals = b.Equals } + | Validatation b -> + Validatation + { Binding = recursiveCase fOut fIn b.Binding + Errors = b.Errors + Validate = b.Validate } let boxVm b = recursiveCase box unbox b let unboxVm b = recursiveCase unbox box b @@ -330,9 +362,7 @@ type SubModelSelectedItemLast() = type FirstValidationErrors() = - member this.Recursive<'model, 'msg, 't> - (binding: VmBinding<'model, 'msg, 't>) - : string list ref option = + member this.Recursive<'model, 'msg, 't>(binding: VmBinding<'model, 'msg, 't>) : string list ref option = match binding with | BaseVmBinding _ -> None | Cached b -> this.Recursive b.Binding @@ -352,8 +382,8 @@ type FuncsFromSubModelSeqKeyed() = | _ -> None member this.Recursive<'model, 'msg, 't> - (binding: VmBinding<'model, 'msg, 't>) - : SelectedItemBinding option = + (binding: VmBinding<'model, 'msg, 't>) + : SelectedItemBinding option = match binding with | BaseVmBinding b -> this.Base b | Cached b -> this.Recursive b.Binding @@ -363,9 +393,11 @@ type FuncsFromSubModelSeqKeyed() = type Initialize<'t> - (loggingArgs: LoggingViewModelArgs, - name: string, - getFunctionsForSubModelSelectedItem: string -> SelectedItemBinding option) = + ( + loggingArgs: LoggingViewModelArgs, + name: string, + getFunctionsForSubModelSelectedItem: string -> SelectedItemBinding option + ) = let { log = log logPerformance = logPerformance @@ -373,418 +405,476 @@ type Initialize<'t> nameChain = nameChain } = loggingArgs - let measure x = x |> Helpers2.measure logPerformance LogLevel.Trace performanceLogThresholdMs name nameChain - let measure2 x = x |> Helpers2.measure2 logPerformance LogLevel.Trace performanceLogThresholdMs name nameChain + let measure x = + x + |> Helpers2.measure logPerformance LogLevel.Trace performanceLogThresholdMs name nameChain + + let measure2 x = + x + |> Helpers2.measure2 logPerformance LogLevel.Trace performanceLogThresholdMs name nameChain member _.Base<'model, 'msg> - (initialModel: 'model, - dispatch: 'msg -> unit, - getCurrentModel: unit -> 'model, - binding: BaseBindingData<'model, 'msg, 't>) - : BaseVmBinding<'model, 'msg, 't> option = + ( + initialModel: 'model, + dispatch: 'msg -> unit, + getCurrentModel: unit -> 'model, + binding: BaseBindingData<'model, 'msg, 't> + ) : BaseVmBinding<'model, 'msg, 't> option = match binding with - | OneWayData d -> - { OneWayData = d |> BindingData.OneWay.measureFunctions measure } - |> OneWay - |> Some - | OneWayToSourceData d -> - let d = d |> BindingData.OneWayToSource.measureFunctions measure - { Set = fun obj m -> d.Set obj m |> dispatch } - |> OneWayToSource - |> Some - | OneWaySeqData d -> - { OneWaySeqData = d |> BindingData.OneWaySeq.measureFunctions measure measure measure2 - Values = d.CreateCollection (initialModel |> d.Get) } - |> OneWaySeq - |> Some - | TwoWayData d -> - let d = d |> BindingData.TwoWay.measureFunctions measure measure - { Get = d.Get - Set = fun obj m -> d.Set obj m |> dispatch } - |> TwoWay - |> Some - | CmdData d -> - let d = d |> BindingData.Cmd.measureFunctions measure2 measure2 - let execute param = d.Exec param (getCurrentModel ()) |> ValueOption.iter dispatch - let canExecute param = d.CanExec param (getCurrentModel ()) - let cmd = Command(execute, canExecute) - if d.AutoRequery then - cmd.AddRequeryHandler () - cmd - |> Cmd - |> Some - | SubModelData d -> - let d = d |> BindingData.SubModel.measureFunctions measure measure measure measure2 - let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg - let chain = LoggingViewModelArgs.getNameChainFor nameChain name - d.GetModel initialModel - |> ValueOption.map (fun m -> ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs) - |> ValueOption.map d.CreateViewModel - |> (fun vm -> let mutable vm = vm in { SubModelData = d - Dispatch = dispatch - GetVm = (fun () -> vm) - SetVm = fun nvm -> vm <- nvm - GetCurrentModel = getCurrentModel - }) - |> SubModel - |> Some - | SubModelWinData d -> - let d = d |> BindingData.SubModelWin.measureFunctions measure measure measure measure2 - let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg - match d.GetState initialModel with - | WindowState.Closed -> - let mutable vmWinState = WindowState.Closed - { SubModelWinData = d - Dispatch = dispatch - WinRef = WeakReference<_>(null) - PreventClose = ref true - GetVmWinState = fun () -> vmWinState - SetVmWinState = fun vmState -> vmWinState <- vmState - GetCurrentModel = getCurrentModel - } - | WindowState.Hidden m -> - let chain = LoggingViewModelArgs.getNameChainFor nameChain name - let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs - let vm = d.CreateViewModel args - let winRef = WeakReference<_>(null) - let preventClose = ref true - log.LogTrace("[{BindingNameChain}] Creating hidden window", chain) - Helpers2.showNewWindow winRef d.GetWindow d.IsModal d.OnCloseRequested preventClose vm Visibility.Hidden getCurrentModel dispatch - let mutable vmWinState = WindowState.Hidden vm - { SubModelWinData = d - Dispatch = dispatch - WinRef = winRef - PreventClose = preventClose - GetVmWinState = fun () -> vmWinState - SetVmWinState = fun vm -> vmWinState <- vm - GetCurrentModel = getCurrentModel - } - | WindowState.Visible m -> - let chain = LoggingViewModelArgs.getNameChainFor nameChain name - let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs - let vm = d.CreateViewModel args - let winRef = WeakReference<_>(null) - let preventClose = ref true - log.LogTrace("[{BindingNameChain}] Creating visible window", chain) - Helpers2.showNewWindow winRef d.GetWindow d.IsModal d.OnCloseRequested preventClose vm Visibility.Visible getCurrentModel dispatch - let mutable vmWinState = WindowState.Visible vm - { SubModelWinData = d - Dispatch = dispatch - WinRef = winRef - PreventClose = preventClose - GetVmWinState = fun () -> vmWinState - SetVmWinState = fun vm -> vmWinState <- vm - GetCurrentModel = getCurrentModel - } - |> SubModelWin - |> Some - | SubModelSeqUnkeyedData d -> - let d = d |> BindingData.SubModelSeqUnkeyed.measureFunctions measure measure measure measure measure2 - let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg - let vms = - d.GetModels initialModel - |> Seq.indexed - |> Seq.map (fun (idx, m) -> - let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (idx |> string) - let args = ViewModelArgs.create m (fun msg -> toMsg (idx, msg) |> dispatch) chain loggingArgs - d.CreateViewModel args) - |> d.CreateCollection - { SubModelSeqUnkeyedData = d - Dispatch = dispatch - Vms = vms - GetCurrentModel = getCurrentModel - } - |> SubModelSeqUnkeyed - |> Some - | SubModelSeqKeyedData d -> - let d = d |> BindingData.SubModelSeqKeyed.measureFunctions measure measure measure measure measure2 measure measure - let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg - let vms = - d.GetSubModels initialModel - |> Seq.map (fun m -> - let mId = d.BmToId m - let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (mId |> string) - let args = ViewModelArgs.create m (fun msg -> toMsg (mId, msg) |> dispatch) chain loggingArgs - d.CreateViewModel args) - |> d.CreateCollection - { SubModelSeqKeyedData = d - Dispatch = dispatch - Vms = vms - GetCurrentModel = getCurrentModel - } - |> SubModelSeqKeyed - |> Some - | SubModelSelectedItemData d -> - let d = d |> BindingData.SubModelSelectedItem.measureFunctions measure measure2 - d.SubModelSeqBindingName - |> getFunctionsForSubModelSelectedItem - |> Option.map (fun selectedItemBinding -> - { Get = d.Get - Set = fun obj m -> d.Set obj m |> dispatch - SubModelSeqBindingName = d.SubModelSeqBindingName - SelectedItemBinding = selectedItemBinding } - |> SubModelSelectedItem) + | OneWayData d -> + { OneWayData = d |> BindingData.OneWay.measureFunctions measure } + |> OneWay + |> Some + | OneWayToSourceData d -> + let d = d |> BindingData.OneWayToSource.measureFunctions measure + { Set = fun obj m -> d.Set obj m |> dispatch } |> OneWayToSource |> Some + | OneWaySeqData d -> + { OneWaySeqData = d |> BindingData.OneWaySeq.measureFunctions measure measure measure2 + Values = d.CreateCollection(initialModel |> d.Get) } + |> OneWaySeq + |> Some + | TwoWayData d -> + let d = d |> BindingData.TwoWay.measureFunctions measure measure + + { Get = d.Get + Set = fun obj m -> d.Set obj m |> dispatch } + |> TwoWay + |> Some + | CmdData d -> + let d = d |> BindingData.Cmd.measureFunctions measure2 measure2 + let execute param = d.Exec param (getCurrentModel ()) |> ValueOption.iter dispatch + let canExecute param = d.CanExec param (getCurrentModel ()) + let cmd = Command(execute, canExecute) + + if d.AutoRequery then + cmd.AddRequeryHandler() + + cmd |> Cmd |> Some + | SubModelData d -> + let d = d |> BindingData.SubModel.measureFunctions measure measure measure measure2 + let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg + let chain = LoggingViewModelArgs.getNameChainFor nameChain name + + d.GetModel initialModel + |> ValueOption.map (fun m -> ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs) + |> ValueOption.map d.CreateViewModel + |> (fun vm -> + let mutable vm = vm in + + { SubModelData = d + Dispatch = dispatch + GetVm = (fun () -> vm) + SetVm = fun nvm -> vm <- nvm + GetCurrentModel = getCurrentModel }) + |> SubModel + |> Some + | SubModelWinData d -> + let d = d |> BindingData.SubModelWin.measureFunctions measure measure measure measure2 + let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg + + (match d.GetState initialModel with + | WindowState.Closed -> + let mutable vmWinState = WindowState.Closed + + { SubModelWinData = d + Dispatch = dispatch + WinRef = WeakReference<_>(null) + PreventClose = ref true + GetVmWinState = fun () -> vmWinState + SetVmWinState = fun vmState -> vmWinState <- vmState + GetCurrentModel = getCurrentModel } + | WindowState.Hidden m -> + let chain = LoggingViewModelArgs.getNameChainFor nameChain name + let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs + let vm = d.CreateViewModel args + let winRef = WeakReference<_>(null) + let preventClose = ref true + log.LogTrace("[{BindingNameChain}] Creating hidden window", chain) + + Helpers2.showNewWindow + winRef + d.GetWindow + d.IsModal + d.OnCloseRequested + preventClose + vm + Visibility.Hidden + getCurrentModel + dispatch + + let mutable vmWinState = WindowState.Hidden vm + + { SubModelWinData = d + Dispatch = dispatch + WinRef = winRef + PreventClose = preventClose + GetVmWinState = fun () -> vmWinState + SetVmWinState = fun vm -> vmWinState <- vm + GetCurrentModel = getCurrentModel } + | WindowState.Visible m -> + let chain = LoggingViewModelArgs.getNameChainFor nameChain name + let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs + let vm = d.CreateViewModel args + let winRef = WeakReference<_>(null) + let preventClose = ref true + log.LogTrace("[{BindingNameChain}] Creating visible window", chain) + + Helpers2.showNewWindow + winRef + d.GetWindow + d.IsModal + d.OnCloseRequested + preventClose + vm + Visibility.Visible + getCurrentModel + dispatch + + let mutable vmWinState = WindowState.Visible vm + + { SubModelWinData = d + Dispatch = dispatch + WinRef = winRef + PreventClose = preventClose + GetVmWinState = fun () -> vmWinState + SetVmWinState = fun vm -> vmWinState <- vm + GetCurrentModel = getCurrentModel }) + |> SubModelWin + |> Some + | SubModelSeqUnkeyedData d -> + let d = + d + |> BindingData.SubModelSeqUnkeyed.measureFunctions measure measure measure measure measure2 + + let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg + + let vms = + d.GetModels initialModel + |> Seq.indexed + |> Seq.map (fun (idx, m) -> + let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (idx |> string) + let args = ViewModelArgs.create m (fun msg -> toMsg (idx, msg) |> dispatch) chain loggingArgs + d.CreateViewModel args) + |> d.CreateCollection + + { SubModelSeqUnkeyedData = d + Dispatch = dispatch + Vms = vms + GetCurrentModel = getCurrentModel } + |> SubModelSeqUnkeyed + |> Some + | SubModelSeqKeyedData d -> + let d = + d + |> BindingData.SubModelSeqKeyed.measureFunctions measure measure measure measure measure2 measure measure + + let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg + + let vms = + d.GetSubModels initialModel + |> Seq.map (fun m -> + let mId = d.BmToId m + let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (mId |> string) + let args = ViewModelArgs.create m (fun msg -> toMsg (mId, msg) |> dispatch) chain loggingArgs + d.CreateViewModel args) + |> d.CreateCollection + + { SubModelSeqKeyedData = d + Dispatch = dispatch + Vms = vms + GetCurrentModel = getCurrentModel } + |> SubModelSeqKeyed + |> Some + | SubModelSelectedItemData d -> + let d = d |> BindingData.SubModelSelectedItem.measureFunctions measure measure2 + + d.SubModelSeqBindingName + |> getFunctionsForSubModelSelectedItem + |> Option.map (fun selectedItemBinding -> + { Get = d.Get + Set = fun obj m -> d.Set obj m |> dispatch + SubModelSeqBindingName = d.SubModelSeqBindingName + SelectedItemBinding = selectedItemBinding } + |> SubModelSelectedItem) member this.Recursive<'model, 'msg> - (initialModel: 'model, - dispatch: 'msg -> unit, - getCurrentModel: unit -> 'model, - binding: BindingData<'model, 'msg, 't>) - : VmBinding<'model, 'msg, 't> option = + ( + initialModel: 'model, + dispatch: 'msg -> unit, + getCurrentModel: unit -> 'model, + binding: BindingData<'model, 'msg, 't> + ) : VmBinding<'model, 'msg, 't> option = option { match binding with | BaseBindingData d -> - let! b = this.Base(initialModel, dispatch, getCurrentModel, d) - return BaseVmBinding b + let! b = this.Base(initialModel, dispatch, getCurrentModel, d) + return BaseVmBinding b | CachingData d -> - let! b = this.Recursive(initialModel, dispatch, getCurrentModel, d) - return b.AddCaching + let! b = this.Recursive(initialModel, dispatch, getCurrentModel, d) + return b.AddCaching | ValidationData d -> - let d = d |> BindingData.Validation.measureFunctions measure - let! b = this.Recursive(initialModel, dispatch, getCurrentModel, d.BindingData) - return b.AddValidation initialModel d.Validate + let d = d |> BindingData.Validation.measureFunctions measure + let! b = this.Recursive(initialModel, dispatch, getCurrentModel, d.BindingData) + return b.AddValidation initialModel d.Validate | LazyData d -> - let initialModel' : obj = d.Get initialModel - let getCurrentModel' : unit -> obj = getCurrentModel >> d.Get - let dispatch' : obj -> unit = d.MapDispatch(getCurrentModel, dispatch) - let d = d |> BindingData.Lazy.measureFunctions measure measure2 measure2 - let! b = this.Recursive(initialModel', dispatch', getCurrentModel', d.BindingData) - return { Binding = b - Get = d.Get - Equals = d.Equals - } |> Lazy + let initialModel': obj = d.Get initialModel + let getCurrentModel': unit -> obj = getCurrentModel >> d.Get + let dispatch': obj -> unit = d.MapDispatch(getCurrentModel, dispatch) + let d = d |> BindingData.Lazy.measureFunctions measure measure2 measure2 + let! b = this.Recursive(initialModel', dispatch', getCurrentModel', d.BindingData) + + return + { Binding = b + Get = d.Get + Equals = d.Equals } + |> Lazy | AlterMsgStreamData d -> - let initialModel' : obj = d.Get initialModel - let getCurrentModel' : unit -> obj = getCurrentModel >> d.Get - let dispatch' : obj -> unit = d.MapDispatch(getCurrentModel, dispatch) - let! b = this.Recursive(initialModel', dispatch', getCurrentModel', d.BindingData) - return { Binding = b - Get = d.Get - } |> AlterMsgStream + let initialModel': obj = d.Get initialModel + let getCurrentModel': unit -> obj = getCurrentModel >> d.Get + let dispatch': obj -> unit = d.MapDispatch(getCurrentModel, dispatch) + let! b = this.Recursive(initialModel', dispatch', getCurrentModel', d.BindingData) + return { Binding = b; Get = d.Get } |> AlterMsgStream } /// Updates the binding and returns a list indicating what events to raise for this binding -type Update<'t> - (loggingArgs: LoggingViewModelArgs, - name: string) = +type Update<'t>(loggingArgs: LoggingViewModelArgs, name: string) = - let { log = log - nameChain = nameChain } = - loggingArgs + let { log = log; nameChain = nameChain } = loggingArgs - member _.Base<'model, 'msg> - (newModel: 'model, - binding: BaseVmBinding<'model, 'msg, 't>) = + member _.Base<'model, 'msg>(newModel: 'model, binding: BaseVmBinding<'model, 'msg, 't>) = match binding with - | OneWay _ - | TwoWay _ - | SubModelSelectedItem _ -> [ PropertyChanged name ] - | OneWayToSource _ -> [] - | OneWaySeq b -> - b.OneWaySeqData.Merge(b.Values, newModel) - [] - | Cmd cmd -> cmd |> CanExecuteChanged |> List.singleton - | SubModel b -> - let d = b.SubModelData - match b.GetVm (), d.GetModel newModel with - | ValueNone, ValueNone -> [] - | ValueSome _, ValueNone -> - b.SetVm ValueNone - [ PropertyChanged name ] - | ValueNone, ValueSome m -> - let toMsg = fun msg -> d.ToMsg (b.GetCurrentModel ()) msg - let chain = LoggingViewModelArgs.getNameChainFor nameChain name - let args = ViewModelArgs.create m (toMsg >> b.Dispatch) chain loggingArgs - b.SetVm (ValueSome <| d.CreateViewModel(args)) - [ PropertyChanged name ] - | ValueSome vm, ValueSome m -> - d.UpdateViewModel (vm, m) - [] - | SubModelWin b -> - let d = b.SubModelWinData - let winPropChain = LoggingViewModelArgs.getNameChainFor nameChain name - let close () = - b.PreventClose.Value <- false - match b.WinRef.TryGetTarget () with - | false, _ -> - log.LogError("[{BindingNameChain}] Attempted to close window, but did not find window reference", winPropChain) - | true, w -> - log.LogTrace("[{BindingNameChain}] Closing window", winPropChain) - b.WinRef.SetTarget null - (* + | OneWay _ + | TwoWay _ + | SubModelSelectedItem _ -> [ PropertyChanged name ] + | OneWayToSource _ -> [] + | OneWaySeq b -> + b.OneWaySeqData.Merge(b.Values, newModel) + [] + | Cmd cmd -> cmd |> CanExecuteChanged |> List.singleton + | SubModel b -> + let d = b.SubModelData + + match b.GetVm(), d.GetModel newModel with + | ValueNone, ValueNone -> [] + | ValueSome _, ValueNone -> + b.SetVm ValueNone + [ PropertyChanged name ] + | ValueNone, ValueSome m -> + let toMsg = fun msg -> d.ToMsg (b.GetCurrentModel()) msg + let chain = LoggingViewModelArgs.getNameChainFor nameChain name + let args = ViewModelArgs.create m (toMsg >> b.Dispatch) chain loggingArgs + b.SetVm(ValueSome <| d.CreateViewModel(args)) + [ PropertyChanged name ] + | ValueSome vm, ValueSome m -> + d.UpdateViewModel(vm, m) + [] + | SubModelWin b -> + let d = b.SubModelWinData + let winPropChain = LoggingViewModelArgs.getNameChainFor nameChain name + + let close () = + b.PreventClose.Value <- false + + match b.WinRef.TryGetTarget() with + | false, _ -> + log.LogError( + "[{BindingNameChain}] Attempted to close window, but did not find window reference", + winPropChain + ) + | true, w -> + log.LogTrace("[{BindingNameChain}] Closing window", winPropChain) + b.WinRef.SetTarget null + (* * The Window might be in the process of closing, * so instead of immediately executing Window.Close via Dispatcher.Invoke, * queue a call to Window.Close via Dispatcher.InvokeAsync. * https://github.com/elmish/Elmish.WPF/issues/330 *) - w.Dispatcher.InvokeAsync(w.Close) |> ignore - b.WinRef.SetTarget null - - let hide () = - match b.WinRef.TryGetTarget () with - | false, _ -> - log.LogError("[{BindingNameChain}] Attempted to hide window, but did not find window reference", winPropChain) - | true, w -> - log.LogTrace("[{BindingNameChain}] Hiding window", winPropChain) - w.Dispatcher.Invoke(fun () -> w.Visibility <- Visibility.Hidden) - - let showHidden () = - match b.WinRef.TryGetTarget () with - | false, _ -> - log.LogError("[{BindingNameChain}] Attempted to show existing hidden window, but did not find window reference", winPropChain) - | true, w -> - log.LogTrace("[{BindingNameChain}] Showing existing hidden window", winPropChain) - w.Dispatcher.Invoke(fun () -> w.Visibility <- Visibility.Visible) - - let showNew vm = - b.PreventClose.Value <- true - Helpers2.showNewWindow b.WinRef d.GetWindow d.IsModal d.OnCloseRequested b.PreventClose vm - - let newVm model = - let toMsg = fun msg -> d.ToMsg (b.GetCurrentModel ()) msg - let chain = LoggingViewModelArgs.getNameChainFor nameChain name - let args = ViewModelArgs.create model (toMsg >> b.Dispatch) chain loggingArgs - d.CreateViewModel args - - match b.GetVmWinState(), d.GetState newModel with - | WindowState.Closed, WindowState.Closed -> - [] - | WindowState.Hidden vm, WindowState.Hidden m - | WindowState.Visible vm, WindowState.Visible m -> - d.UpdateViewModel (vm, m) - [] - | WindowState.Hidden _, WindowState.Closed - | WindowState.Visible _, WindowState.Closed -> - close () - b.SetVmWinState WindowState.Closed - [ PropertyChanged name ] - | WindowState.Visible vm, WindowState.Hidden m -> - hide () - d.UpdateViewModel (vm, m) - b.SetVmWinState (WindowState.Hidden vm) - [] - | WindowState.Hidden vm, WindowState.Visible m -> - d.UpdateViewModel (vm, m) - showHidden () - b.SetVmWinState (WindowState.Visible vm) - [] - | WindowState.Closed, WindowState.Hidden m -> - let vm = newVm m - log.LogTrace("[{BindingNameChain}] Creating hidden window", winPropChain) - showNew vm Visibility.Hidden b.GetCurrentModel b.Dispatch - b.SetVmWinState (WindowState.Hidden vm) - [ PropertyChanged name ] - | WindowState.Closed, WindowState.Visible m -> - let vm = newVm m - log.LogTrace("[{BindingNameChain}] Creating visible window", winPropChain) - showNew vm Visibility.Visible b.GetCurrentModel b.Dispatch - b.SetVmWinState (WindowState.Visible vm) - [ PropertyChanged name ] - | SubModelSeqUnkeyed b -> - let d = b.SubModelSeqUnkeyedData - let create m idx = - let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (idx |> string) - let args = ViewModelArgs.create m (fun msg -> d.ToMsg (b.GetCurrentModel ()) (idx, msg) |> b.Dispatch) chain loggingArgs - d.CreateViewModel args - let update vm m = d.UpdateViewModel (vm, m) - Merge.unkeyed create update b.Vms (d.GetModels newModel) - [] - | SubModelSeqKeyed b -> - let d = b.SubModelSeqKeyedData - let create m id = - let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (id |> string) - let args = ViewModelArgs.create m (fun msg -> d.ToMsg (b.GetCurrentModel ()) (id, msg) |> b.Dispatch) chain loggingArgs - d.CreateViewModel args - let update vm m = d.UpdateViewModel (vm, m) - let newSubModels = newModel |> d.GetSubModels |> Seq.toArray - try - d.MergeKeyed(create, update, b.Vms, newSubModels) - with - | :? DuplicateIdException as e -> - let messageTemplate = "[{BindingNameChain}] In the {SourceOrTarget} sequence of the binding {BindingName}, the elements at indices {Index1} and {Index2} have the same ID {ID}. To avoid this problem, the elements will be merged without using IDs." - log.LogError(messageTemplate, nameChain, e.SourceOrTarget, name, e.Index1, e.Index2, e.Id) - let create m _ = create m (d.BmToId m) - Merge.unkeyed create update b.Vms newSubModels - [] + w.Dispatcher.InvokeAsync(w.Close) |> ignore + + b.WinRef.SetTarget null + + let hide () = + match b.WinRef.TryGetTarget() with + | false, _ -> + log.LogError("[{BindingNameChain}] Attempted to hide window, but did not find window reference", winPropChain) + | true, w -> + log.LogTrace("[{BindingNameChain}] Hiding window", winPropChain) + w.Dispatcher.Invoke(fun () -> w.Visibility <- Visibility.Hidden) + + let showHidden () = + match b.WinRef.TryGetTarget() with + | false, _ -> + log.LogError( + "[{BindingNameChain}] Attempted to show existing hidden window, but did not find window reference", + winPropChain + ) + | true, w -> + log.LogTrace("[{BindingNameChain}] Showing existing hidden window", winPropChain) + w.Dispatcher.Invoke(fun () -> w.Visibility <- Visibility.Visible) + + let showNew vm = + b.PreventClose.Value <- true + Helpers2.showNewWindow b.WinRef d.GetWindow d.IsModal d.OnCloseRequested b.PreventClose vm + + let newVm model = + let toMsg = fun msg -> d.ToMsg (b.GetCurrentModel()) msg + let chain = LoggingViewModelArgs.getNameChainFor nameChain name + let args = ViewModelArgs.create model (toMsg >> b.Dispatch) chain loggingArgs + d.CreateViewModel args + + match b.GetVmWinState(), d.GetState newModel with + | WindowState.Closed, WindowState.Closed -> [] + | WindowState.Hidden vm, WindowState.Hidden m + | WindowState.Visible vm, WindowState.Visible m -> + d.UpdateViewModel(vm, m) + [] + | WindowState.Hidden _, WindowState.Closed + | WindowState.Visible _, WindowState.Closed -> + close () + b.SetVmWinState WindowState.Closed + [ PropertyChanged name ] + | WindowState.Visible vm, WindowState.Hidden m -> + hide () + d.UpdateViewModel(vm, m) + b.SetVmWinState(WindowState.Hidden vm) + [] + | WindowState.Hidden vm, WindowState.Visible m -> + d.UpdateViewModel(vm, m) + showHidden () + b.SetVmWinState(WindowState.Visible vm) + [] + | WindowState.Closed, WindowState.Hidden m -> + let vm = newVm m + log.LogTrace("[{BindingNameChain}] Creating hidden window", winPropChain) + showNew vm Visibility.Hidden b.GetCurrentModel b.Dispatch + b.SetVmWinState(WindowState.Hidden vm) + [ PropertyChanged name ] + | WindowState.Closed, WindowState.Visible m -> + let vm = newVm m + log.LogTrace("[{BindingNameChain}] Creating visible window", winPropChain) + showNew vm Visibility.Visible b.GetCurrentModel b.Dispatch + b.SetVmWinState(WindowState.Visible vm) + [ PropertyChanged name ] + | SubModelSeqUnkeyed b -> + let d = b.SubModelSeqUnkeyedData + + let create m idx = + let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (idx |> string) + + let args = + ViewModelArgs.create m (fun msg -> d.ToMsg (b.GetCurrentModel()) (idx, msg) |> b.Dispatch) chain loggingArgs + + d.CreateViewModel args + + let update vm m = d.UpdateViewModel(vm, m) + Merge.unkeyed create update b.Vms (d.GetModels newModel) + [] + | SubModelSeqKeyed b -> + let d = b.SubModelSeqKeyedData + + let create m id = + let chain = LoggingViewModelArgs.getNameChainForItem nameChain name (id |> string) + + let args = + ViewModelArgs.create m (fun msg -> d.ToMsg (b.GetCurrentModel()) (id, msg) |> b.Dispatch) chain loggingArgs + + d.CreateViewModel args + + let update vm m = d.UpdateViewModel(vm, m) + let newSubModels = newModel |> d.GetSubModels |> Seq.toArray + + try + d.MergeKeyed(create, update, b.Vms, newSubModels) + with :? DuplicateIdException as e -> + let messageTemplate = + "[{BindingNameChain}] In the {SourceOrTarget} sequence of the binding {BindingName}, the elements at indices {Index1} and {Index2} have the same ID {ID}. To avoid this problem, the elements will be merged without using IDs." + + log.LogError(messageTemplate, nameChain, e.SourceOrTarget, name, e.Index1, e.Index2, e.Id) + let create m _ = create m (d.BmToId m) + Merge.unkeyed create update b.Vms newSubModels + + [] member this.Recursive<'model, 'msg> - (currentModel: 'model, - newModel: 'model, - binding: VmBinding<'model, 'msg, 't>) - : UpdateData list = + ( + currentModel: 'model, + newModel: 'model, + binding: VmBinding<'model, 'msg, 't> + ) : UpdateData list = match binding with - | BaseVmBinding b -> this.Base(newModel, b) - | Cached b -> - let updates = this.Recursive(currentModel, newModel, b.Binding) - updates - |> List.filter UpdateData.isPropertyChanged - |> List.iter (fun _ -> b.SetCache None) - updates - | Validatation b -> - let updates = this.Recursive(currentModel, newModel, b.Binding) - let newErrors = b.Validate newModel - if b.Errors.Value <> newErrors then - b.Errors.Value <- newErrors - ErrorsChanged name :: updates - else - updates - | Lazy b -> - let currentModel' = currentModel |> b.Get - let newModel' = newModel |> b.Get - if b.Equals currentModel' newModel' then - [] - else - this.Recursive(currentModel', newModel', b.Binding) - | AlterMsgStream b -> - this.Recursive(currentModel |> b.Get, b.Get newModel, b.Binding) + | BaseVmBinding b -> this.Base(newModel, b) + | Cached b -> + let updates = this.Recursive(currentModel, newModel, b.Binding) + + updates + |> List.filter UpdateData.isPropertyChanged + |> List.iter (fun _ -> b.SetCache None) + + updates + | Validatation b -> + let updates = this.Recursive(currentModel, newModel, b.Binding) + let newErrors = b.Validate newModel + + if b.Errors.Value <> newErrors then + b.Errors.Value <- newErrors + ErrorsChanged name :: updates + else + updates + | Lazy b -> + let currentModel' = currentModel |> b.Get + let newModel' = newModel |> b.Get + + if b.Equals currentModel' newModel' then + [] + else + this.Recursive(currentModel', newModel', b.Binding) + | AlterMsgStream b -> this.Recursive(currentModel |> b.Get, b.Get newModel, b.Binding) type Get<'t>(nameChain: string) = - member _.Base (model: 'model, binding: BaseVmBinding<'model, 'msg, 't>) = + member _.Base(model: 'model, binding: BaseVmBinding<'model, 'msg, 't>) = match binding with | OneWay { OneWayData = d } -> d.Get model |> Ok | TwoWay b -> b.Get model |> Ok | OneWayToSource _ -> GetError.OneWayToSource |> Error - | OneWaySeq { Values = vals } -> vals.GetCollection () |> Ok + | OneWaySeq { Values = vals } -> vals.GetCollection() |> Ok | Cmd cmd -> cmd |> unbox |> Ok - | SubModel { GetVm = getvm } -> getvm() |> ValueOption.toNull |> Result.mapError GetError.ToNullError + | SubModel { GetVm = getvm } -> getvm () |> ValueOption.toNull |> Result.mapError GetError.ToNullError | SubModelWin { GetVmWinState = getvm } -> - getvm() - |> WindowState.toVOption - |> ValueOption.toNull - |> Result.mapError GetError.ToNullError + getvm () + |> WindowState.toVOption + |> ValueOption.toNull + |> Result.mapError GetError.ToNullError | SubModelSeqUnkeyed { Vms = vms } - | SubModelSeqKeyed { Vms = vms } -> vms.GetCollection () |> Ok + | SubModelSeqKeyed { Vms = vms } -> vms.GetCollection() |> Ok | SubModelSelectedItem b -> - b.TypedGet model - |> function - | ValueNone -> ValueNone |> Ok // deselecting successful - | ValueSome (id, mVm) -> - match mVm with - | Some vm -> vm |> ValueSome |> Ok // selecting successful - | None -> // selecting failed - { NameChain = nameChain - SubModelSeqBindingName = b.SubModelSeqBindingName - Id = id.ToString() } - |> GetError.SubModelSelectedItem - |> Error - |> Result.bind (ValueOption.toNull >> Result.mapError GetError.ToNullError) - - member this.Recursive<'model, 'msg> - (model: 'model, - binding: VmBinding<'model, 'msg, 't>) - : Result<'t, GetError> = + b.TypedGet model + |> function + | ValueNone -> ValueNone |> Ok // deselecting successful + | ValueSome(id, mVm) -> + match mVm with + | Some vm -> vm |> ValueSome |> Ok // selecting successful + | None -> // selecting failed + { NameChain = nameChain + SubModelSeqBindingName = b.SubModelSeqBindingName + Id = id.ToString() } + |> GetError.SubModelSelectedItem + |> Error + |> Result.bind (ValueOption.toNull >> Result.mapError GetError.ToNullError) + + member this.Recursive<'model, 'msg>(model: 'model, binding: VmBinding<'model, 'msg, 't>) : Result<'t, GetError> = match binding with | BaseVmBinding b -> this.Base(model, b) | Cached b -> - match b.GetCache() with - | Some v -> v |> Ok - | None -> - let x = this.Recursive(model, b.Binding) - x |> Result.iter (fun v -> b.SetCache (Some v)) - x + match b.GetCache() with + | Some v -> v |> Ok + | None -> + let x = this.Recursive(model, b.Binding) + x |> Result.iter (fun v -> b.SetCache(Some v)) + x | Validatation b -> this.Recursive(model, b.Binding) | Lazy b -> this.Recursive(b.Get model, b.Binding) | AlterMsgStream b -> this.Recursive(b.Get model, b.Binding) @@ -795,31 +885,30 @@ type Set<'t>(value: 't) = member _.Base(model: 'model, binding: BaseVmBinding<'model, 'msg, 't>) = match binding with | TwoWay b -> - b.Set value model - true + b.Set value model + true | OneWayToSource b -> - b.Set value model - true + b.Set value model + true | SubModelSelectedItem b -> - b.TypedSet(model, ValueOption.ofNull value) - true + b.TypedSet(model, ValueOption.ofNull value) + true | OneWay _ | OneWaySeq _ | Cmd _ | SubModel _ | SubModelWin _ | SubModelSeqUnkeyed _ - | SubModelSeqKeyed _ -> - false + | SubModelSeqKeyed _ -> false member this.Recursive<'model, 'msg>(model: 'model, binding: VmBinding<'model, 'msg, 't>) : bool = match binding with | BaseVmBinding b -> this.Base(model, b) | Cached b -> - // UpdateModel changes the model, - // but Set only dispatches a message, - // so don't clear the cache here - this.Recursive<'model, 'msg>(model, b.Binding) + // UpdateModel changes the model, + // but Set only dispatches a message, + // so don't clear the cache here + this.Recursive<'model, 'msg>(model, b.Binding) | Validatation b -> this.Recursive<'model, 'msg>(model, b.Binding) | Lazy b -> this.Recursive(b.Get model, b.Binding) - | AlterMsgStream b -> this.Recursive(b.Get model, b.Binding) + | AlterMsgStream b -> this.Recursive(b.Get model, b.Binding) \ No newline at end of file diff --git a/src/Elmish.WPF/Command.fs b/src/Elmish.WPF/Command.fs index c4fe663a..4149067a 100644 --- a/src/Elmish.WPF/Command.fs +++ b/src/Elmish.WPF/Command.fs @@ -17,15 +17,17 @@ type internal Command(execute, canExecute) = // which is achieved by this mutable let-binding. // Can test this via the UiBoundCmdParam sample. let mutable _handler = Unchecked.defaultof - member this.AddRequeryHandler () = + + member this.AddRequeryHandler() = let handler = EventHandler(fun _ _ -> this.RaiseCanExecuteChanged()) CommandManager.RequerySuggested.AddHandler handler _handler <- handler - member this.RaiseCanExecuteChanged () = canExecuteChanged.Trigger(this, EventArgs.Empty) + member this.RaiseCanExecuteChanged() = canExecuteChanged.Trigger(this, EventArgs.Empty) interface ICommand with [] member _.CanExecuteChanged = canExecuteChanged.Publish + member _.CanExecute p = canExecute p member _.Execute p = execute p \ No newline at end of file diff --git a/src/Elmish.WPF/InternalUtils.fs b/src/Elmish.WPF/InternalUtils.fs index 959b6d02..99bee9b7 100644 --- a/src/Elmish.WPF/InternalUtils.fs +++ b/src/Elmish.WPF/InternalUtils.fs @@ -11,18 +11,14 @@ let ignore2 _ _ = () /// Deconstructs a KeyValuePair into a tuple. [] -let (|Kvp|) (kvp: KeyValuePair<_,_>) = - Kvp (kvp.Key, kvp.Value) +let (|Kvp|) (kvp: KeyValuePair<_, _>) = Kvp(kvp.Key, kvp.Value) [] type OptionalBuilder = - member _.Bind(ma, f) = - ma |> Option.bind f - member _.Return(a) = - Some a - member _.ReturnFrom(ma) = - ma + member _.Bind(ma, f) = ma |> Option.bind f + member _.Return(a) = Some a + member _.ReturnFrom(ma) = ma let option = OptionalBuilder() @@ -30,21 +26,21 @@ let option = OptionalBuilder() [] module Kvp = - let key (kvp: KeyValuePair<_,_>) = - kvp.Key + let key (kvp: KeyValuePair<_, _>) = kvp.Key - let value (kvp: KeyValuePair<_,_>) = - kvp.Value + let value (kvp: KeyValuePair<_, _>) = kvp.Value [] module Result = - let isOk = function + let isOk = + function | Ok _ -> true | Error _ -> false - let iter f = function + let iter f = + function | Ok x -> f x | Error _ -> () @@ -52,35 +48,40 @@ module Result = [] module ValueOption = - let ofOption = function + let ofOption = + function | Some x -> ValueSome x | None -> ValueNone - let toOption = function + let toOption = + function | ValueSome x -> Some x | ValueNone -> None - let ofError = function + let ofError = + function | Ok _ -> ValueNone | Error x -> ValueSome x - let ofOk = function + let ofOk = + function | Ok x -> ValueSome x | Error _ -> ValueNone [] - type ToNullError = - | ValueCannotBeNull of string + type ToNullError = ValueCannotBeNull of string let ofNull<'a> (x: 'a) = match box x with | null -> ValueNone | _ -> ValueSome x - let toNull<'a> = function + let toNull<'a> = + function | ValueSome x -> Ok x | ValueNone -> let default' = Unchecked.defaultof<'a> + if box default' = null then default' |> Ok else @@ -90,29 +91,25 @@ module ValueOption = [] module ByRefPair = - let toOption (b, a) = - if b then Some a else None + let toOption (b, a) = if b then Some a else None [] module Dictionary = - let tryFind key (d: Dictionary<_, _>) = - key |> d.TryGetValue |> ByRefPair.toOption + let tryFind key (d: Dictionary<_, _>) = key |> d.TryGetValue |> ByRefPair.toOption [] module IReadOnlyDictionary = - let tryFind key (d: IReadOnlyDictionary<_, _>) = - key |> d.TryGetValue |> ByRefPair.toOption + let tryFind key (d: IReadOnlyDictionary<_, _>) = key |> d.TryGetValue |> ByRefPair.toOption [] module Option = - let fromBool a b = - if b then Some a else None + let fromBool a b = if b then Some a else None [] @@ -124,7 +121,7 @@ module SeqOption = [] module Pair = - let ofKvp (kvp: KeyValuePair<_,_>) = (kvp.Key, kvp.Value) + let ofKvp (kvp: KeyValuePair<_, _>) = (kvp.Key, kvp.Value) let mapAll f g (a, c) = (f a, g c) @@ -134,8 +131,9 @@ module Pair = [] module PairOption = - let sequence = function - | Some a, Some b -> Some (a, b) + let sequence = + function + | Some a, Some b -> Some(a, b) | _ -> None @@ -154,4 +152,4 @@ module Func3 = [] module Func5 = - let curry f a b c d e = f (a, b, c, d, e) + let curry f a b c d e = f (a, b, c, d, e) \ No newline at end of file diff --git a/src/Elmish.WPF/Merge.fs b/src/Elmish.WPF/Merge.fs index 264a810c..31af3683 100644 --- a/src/Elmish.WPF/Merge.fs +++ b/src/Elmish.WPF/Merge.fs @@ -9,8 +9,17 @@ type SourceOrTarget = | Source | Target -type DuplicateIdException (sourceOrTarget: SourceOrTarget, index1: int, index2: int, id: string) = - inherit System.Exception(sprintf "In the %A sequence, the elements at indices %d and %d have the same ID %s" sourceOrTarget index1 index2 id) +type DuplicateIdException(sourceOrTarget: SourceOrTarget, index1: int, index2: int, id: string) = + inherit + System.Exception( + sprintf + "In the %A sequence, the elements at indices %d and %d have the same ID %s" + sourceOrTarget + index1 + index2 + id + ) + member this.SourceOrTarget = sourceOrTarget member this.Index1 = index1 member this.Index2 = index2 @@ -42,7 +51,11 @@ module CollectionTarget = Enumerate = fun () -> upcast oc GetCollection = fun () -> oc } - let mapA (fOut: 'a0 -> 'a1) (fIn: 'a1 -> 'a0) (ct: CollectionTarget<'a0, 'aCollection>) : CollectionTarget<'a1, 'aCollection> = + let mapA + (fOut: 'a0 -> 'a1) + (fIn: 'a1 -> 'a0) + (ct: CollectionTarget<'a0, 'aCollection>) + : CollectionTarget<'a1, 'aCollection> = { GetLength = ct.GetLength GetAt = ct.GetAt >> fOut Append = fIn >> ct.Append @@ -54,7 +67,10 @@ module CollectionTarget = Enumerate = ct.Enumerate >> Seq.map fOut GetCollection = ct.GetCollection } - let mapCollection (fOut: 'aCollection0 -> 'aCollection1) (ct: CollectionTarget<'a, 'aCollection0>) : CollectionTarget<'a, 'aCollection1> = + let mapCollection + (fOut: 'aCollection0 -> 'aCollection1) + (ct: CollectionTarget<'a, 'aCollection0>) + : CollectionTarget<'a, 'aCollection1> = { GetLength = ct.GetLength GetAt = ct.GetAt Append = ct.Append @@ -71,48 +87,55 @@ module CollectionTarget = module Merge = let unkeyed - (create: 's -> int -> 't) - (update: 't -> 's -> unit) - (target: CollectionTarget<'t, 'tCollection>) - (source: 's seq) = + (create: 's -> int -> 't) + (update: 't -> 's -> unit) + (target: CollectionTarget<'t, 'tCollection>) + (source: 's seq) + = let mutable lastIdx = -1 + for (idx, s) in source |> Seq.indexed do lastIdx <- idx + if idx < target.GetLength() then update (target.GetAt idx) s else // source is longer than target create s idx |> target.Append + let mutable idx = target.GetLength() - 1 + while idx > lastIdx do // target is longer than source target.RemoveAt idx idx <- idx - 1 let keyed - (getSourceId: 's -> 'id) - (getTargetId: 't -> 'id) - (create: 's -> 'id -> 't) - (update: 't -> 's -> int -> unit) - (target: CollectionTarget<'t, 'tCollection>) - (source: 's array) = + (getSourceId: 's -> 'id) + (getTargetId: 't -> 'id) + (create: 's -> 'id -> 't) + (update: 't -> 's -> int -> unit) + (target: CollectionTarget<'t, 'tCollection>) + (source: 's array) + = (* * Based on Elm's HTML.keyed * https://guide.elm-lang.org/optimization/keyed.html * https://github.com/elm/virtual-dom/blob/5a5bcf48720bc7d53461b3cd42a9f19f119c5503/src/Elm/Kernel/VirtualDom.js#L980-L1226 *) - let removals = Dictionary<_, _> () - let additions = Dictionary<_, _> () + let removals = Dictionary<_, _>() + let additions = Dictionary<_, _>() let recordRemoval curTargetIdx curTarget curTargetId = if removals.ContainsKey curTargetId then let (firstIdx, _) = removals.[curTargetId] - raise (DuplicateIdException (Target, firstIdx, curTargetIdx, curTargetId.ToString())) + raise (DuplicateIdException(Target, firstIdx, curTargetIdx, curTargetId.ToString())) else removals.Add(curTargetId, (curTargetIdx, curTarget)) + let recordAddition curSourceIdx curSource curSourceId = if additions.ContainsKey curSourceId then let (firstIdx, _) = additions.[curSourceId] - raise (DuplicateIdException (Source, firstIdx, curSourceIdx, curSourceId.ToString())) + raise (DuplicateIdException(Source, firstIdx, curSourceIdx, curSourceId.ToString())) else additions.Add(curSourceId, (curSourceIdx, curSource)) @@ -145,52 +168,55 @@ module Merge = s, id, id = curTargetId) // true => need to add let mNextTarget = - if curTargetIdx + 1 < targetCount then target.GetAt (curTargetIdx + 1) |> Some else None + (if curTargetIdx + 1 < targetCount then + target.GetAt(curTargetIdx + 1) |> Some + else + None) |> Option.map (fun t -> let id = getTargetId t t, id, id = curSourceId) // true => need to remove match mNextSource, mNextTarget with - | Some (nextSource, _, true), Some (nextTarget, _, true) -> // swap adjacent - target.SetAt (curTargetIdx, nextTarget) - target.SetAt (curTargetIdx + 1, curTarget) - - update curTarget nextSource (curTargetIdx + 1) - update nextTarget curSource curTargetIdx - - curSourceIdx <- curSourceIdx + 2 - curTargetIdx <- curTargetIdx + 2 - | None, Some (nextTarget, _, true) - | Some (_, _, false), Some (nextTarget, _, true) -> // remove + | Some(nextSource, _, true), Some(nextTarget, _, true) -> // swap adjacent + target.SetAt(curTargetIdx, nextTarget) + target.SetAt(curTargetIdx + 1, curTarget) + + update curTarget nextSource (curTargetIdx + 1) + update nextTarget curSource curTargetIdx + + curSourceIdx <- curSourceIdx + 2 + curTargetIdx <- curTargetIdx + 2 + | None, Some(nextTarget, _, true) + | Some(_, _, false), Some(nextTarget, _, true) -> // remove + recordRemoval curTargetIdx curTarget curTargetId + + update nextTarget curSource curTargetIdx + + curSourceIdx <- curSourceIdx + 1 + curTargetIdx <- curTargetIdx + 2 + | Some(nextSource, _, true), None + | Some(nextSource, _, true), Some(_, _, false) -> // add + recordAddition curSourceIdx curSource curSourceId + + update curTarget nextSource (curTargetIdx + 1) + + curSourceIdx <- curSourceIdx + 2 + curTargetIdx <- curTargetIdx + 1 + | Some(_, _, false), None + | None, Some(_, _, false) + | None, None -> // source and target have different lengths and we have reached the end of one + shouldContinue <- false + | Some(nextSource, nextSourceId, false), Some(nextTarget, nextTargetId, false) -> + if nextSourceId = nextTargetId then // replace recordRemoval curTargetIdx curTarget curTargetId - - update nextTarget curSource curTargetIdx - - curSourceIdx <- curSourceIdx + 1 - curTargetIdx <- curTargetIdx + 2 - | Some (nextSource, _, true), None - | Some (nextSource, _, true), Some (_, _, false) -> // add recordAddition curSourceIdx curSource curSourceId - update curTarget nextSource (curTargetIdx + 1) + update nextTarget nextSource (curTargetIdx + 1) curSourceIdx <- curSourceIdx + 2 - curTargetIdx <- curTargetIdx + 1 - | Some (_, _, false), None - | None, Some (_, _, false) - | None, None -> // source and target have different lengths and we have reached the end of one + curTargetIdx <- curTargetIdx + 2 + else // collections very different shouldContinue <- false - | Some (nextSource, nextSourceId, false), Some (nextTarget, nextTargetId, false) -> - if nextSourceId = nextTargetId then // replace - recordRemoval curTargetIdx curTarget curTargetId - recordAddition curSourceIdx curSource curSourceId - - update nextTarget nextSource (curTargetIdx + 1) - - curSourceIdx <- curSourceIdx + 2 - curTargetIdx <- curTargetIdx + 2 - else // collections very different - shouldContinue <- false // replace many while (curSourceIdx < sourceCount && curTargetIdx < targetCount) do @@ -207,13 +233,13 @@ module Merge = curTargetIdx <- curTargetIdx + 1 // remove many - for i in targetCount - 1..-1..curTargetIdx do + for i in targetCount - 1 .. -1 .. curTargetIdx do let t = target.GetAt i let id = getTargetId t recordRemoval i t id // add many - for i in curSourceIdx..sourceCount - 1 do + for i in curSourceIdx .. sourceCount - 1 do let s = source.[i] let id = getSourceId s recordAddition i s id @@ -221,13 +247,13 @@ module Merge = let moves = additions |> Seq.toList // make copy of additions so that calling Remove doesn't happen on the same data structure while enumerating - |> List.collect (fun (Kvp (id, (sIdx, s))) -> + |> List.collect (fun (Kvp(id, (sIdx, s))) -> removals |> Dictionary.tryFind id |> Option.map (fun (tIdx, t) -> - removals.Remove id |> ignore - additions.Remove id |> ignore - (tIdx, sIdx, t, s) |> List.singleton) + removals.Remove id |> ignore + additions.Remove id |> ignore + (tIdx, sIdx, t, s) |> List.singleton) |> Option.defaultValue []) let actuallyRemove () = @@ -239,24 +265,24 @@ module Merge = let actuallyAdd () = Seq.empty - |> Seq.append (additions |> Seq.map (fun (Kvp (id, (idx, s))) -> idx, create s id)) + |> Seq.append (additions |> Seq.map (fun (Kvp(id, (idx, s))) -> idx, create s id)) |> Seq.append (moves |> Seq.map (fun (_, sIdx, t, _) -> sIdx, t)) |> Seq.sortBy fst // insert by index from smallest to largest |> Seq.iter target.InsertAt match moves, removals.Count, additions.Count with | [ (tIdx, sIdx, _, _) ], 0, 0 -> // single move - target.Move(tIdx, sIdx) - | [ (t1Idx, s1Idx, _, _); (t2Idx, s2Idx, _, _) ], 0, 0 when t1Idx = s2Idx && t2Idx = s1Idx-> // single swap - let temp = target.GetAt t1Idx - target.SetAt (t1Idx, target.GetAt t2Idx) - target.SetAt (t2Idx, temp) + target.Move(tIdx, sIdx) + | [ (t1Idx, s1Idx, _, _); (t2Idx, s2Idx, _, _) ], 0, 0 when t1Idx = s2Idx && t2Idx = s1Idx -> // single swap + let temp = target.GetAt t1Idx + target.SetAt(t1Idx, target.GetAt t2Idx) + target.SetAt(t2Idx, temp) | _, rc, _ when rc = targetCount && rc > 0 -> // remove everything (implies moves = []) - target.Clear () - actuallyAdd () + target.Clear() + actuallyAdd () | _ -> - actuallyRemove () - actuallyAdd () + actuallyRemove () + actuallyAdd () // update moved elements moves |> Seq.iter (fun (_, sIdx, t, s) -> update t s sIdx) \ No newline at end of file diff --git a/src/Elmish.WPF/Utils.fs b/src/Elmish.WPF/Utils.fs index 2f6be341..d7874401 100644 --- a/src/Elmish.WPF/Utils.fs +++ b/src/Elmish.WPF/Utils.fs @@ -16,13 +16,13 @@ open System.Reflection let buildUntypedGetter (propertyInfo: PropertyInfo) : obj -> obj = let method = propertyInfo.GetMethod let objExpr = Expression.Parameter(typeof, "o") + let expr = Expression.Lambda>( - Expression.Convert( - Expression.Call( - Expression.Convert(objExpr, method.DeclaringType), method), - typeof), - objExpr) + Expression.Convert(Expression.Call(Expression.Convert(objExpr, method.DeclaringType), method), typeof), + objExpr + ) + let action = expr.Compile() fun target -> action.Invoke(target) @@ -32,16 +32,17 @@ type private ElmEq<'a>() = static let gettersAndEq = typeof<'a>.GetProperties() |> Array.map (fun pi -> - let getter = buildUntypedGetter pi - let eq = - if pi.PropertyType.IsValueType || pi.PropertyType = typeof - then (fun (a, b) -> a = b) - else obj.ReferenceEquals - getter, eq - ) + let getter = buildUntypedGetter pi + + let eq = + if pi.PropertyType.IsValueType || pi.PropertyType = typeof then + (fun (a, b) -> a = b) + else + obj.ReferenceEquals + + getter, eq) - static member Eq x1 x2 = - gettersAndEq |> Array.forall (fun (get, eq) -> eq (get (box x1), get (box x2))) + static member Eq x1 x2 = gettersAndEq |> Array.forall (fun (get, eq) -> eq (get (box x1), get (box x2))) /// Memberwise equality where value-typed members and string members are @@ -52,5 +53,4 @@ type private ElmEq<'a>() = /// normally immutable. For a direct reference equality check (not memberwise), /// see refEq (which should be used when passing a single non-string reference /// type from the model). -let elmEq<'a> : 'a -> 'a -> bool = - ElmEq<'a>.Eq \ No newline at end of file +let elmEq<'a> : 'a -> 'a -> bool = ElmEq<'a>.Eq \ No newline at end of file diff --git a/src/Elmish.WPF/ViewModelArgs.fs b/src/Elmish.WPF/ViewModelArgs.fs index 8ddd6f96..471671f4 100644 --- a/src/Elmish.WPF/ViewModelArgs.fs +++ b/src/Elmish.WPF/ViewModelArgs.fs @@ -12,8 +12,7 @@ type internal LoggingViewModelArgs = module internal LoggingViewModelArgs = - let getNameChainFor nameChain name = - sprintf "%s.%s" nameChain name + let getNameChainFor nameChain name = sprintf "%s.%s" nameChain name let getNameChainForItem nameChain collectionBindingName itemId = sprintf "%s.%s.%s" nameChain collectionBindingName itemId @@ -48,5 +47,5 @@ module ViewModelArgs = { initialModel = initialModel dispatch = dispatch loggingArgs = LoggingViewModelArgs.none } - - let simple initialModel = createWithoutLogging initialModel ignore + + let simple initialModel = createWithoutLogging initialModel ignore \ No newline at end of file diff --git a/src/Elmish.WPF/ViewModels.fs b/src/Elmish.WPF/ViewModels.fs index e881e6b8..80a9f80f 100644 --- a/src/Elmish.WPF/ViewModels.fs +++ b/src/Elmish.WPF/ViewModels.fs @@ -24,15 +24,15 @@ module internal Helpers = { Name = name Data = data |> BindingData.boxT } - let createBindingT data name = - { Name = name - Data = data } + let createBindingT data name = { Name = name; Data = data } type SubModelSelectedItemLast with + member this.CompareBindings() : Binding<'model, 'msg> -> Binding<'model, 'msg> -> int = fun a b -> this.Recursive(a.Data) - this.Recursive(b.Data) -type [] IViewModel<'model, 'msg> = +[] +type IViewModel<'model, 'msg> = abstract member CurrentModel: 'model abstract member UpdateModel: 'model -> unit @@ -56,15 +56,18 @@ type internal ViewModelHelper<'model, 'msg> = interface INotifyDataErrorInfo with [] member x.ErrorsChanged = x.ErrorsChanged.Publish + member x.HasErrors = // WPF calls this too often, so don't log https://github.com/elmish/Elmish.WPF/issues/354 x.ValidationErrors |> Seq.map (fun (Kvp(_, errors)) -> errors.Value) |> Seq.filter (not << List.isEmpty) |> (not << Seq.isEmpty) + member x.GetErrors name = let name = name |> Option.ofObj |> Option.defaultValue "" // entity-level errors are being requested when given null or "" https://docs.microsoft.com/en-us/dotnet/api/system.componentmodel.inotifydataerrorinfo.geterrors#:~:text=null%20or%20Empty%2C%20to%20retrieve%20entity-level%20errors x.LoggingArgs.log.LogTrace("[{BindingNameChain}] GetErrors {BindingName}", x.LoggingArgs.nameChain, name) + x.ValidationErrors |> IReadOnlyDictionary.tryFind name |> Option.map (fun errors -> errors.Value) @@ -73,37 +76,35 @@ type internal ViewModelHelper<'model, 'msg> = module internal ViewModelHelper = - let create getSender args bindings validationErrors = { - GetSender = getSender - LoggingArgs = args.loggingArgs - Model = args.initialModel - ValidationErrors = validationErrors - Bindings = bindings - PropertyChanged = Event() - ErrorsChanged = DelegateEvent>() - } + let create getSender args bindings validationErrors = + { GetSender = getSender + LoggingArgs = args.loggingArgs + Model = args.initialModel + ValidationErrors = validationErrors + Bindings = bindings + PropertyChanged = Event() + ErrorsChanged = DelegateEvent>() } - let empty getSender args = - create getSender args Map.empty Map.empty + let empty getSender args = create getSender args Map.empty Map.empty let getEventsToRaise newModel helper = helper.Bindings - |> Seq.collect (fun (Kvp (name, binding)) -> Update(helper.LoggingArgs, name).Recursive(helper.Model, newModel, binding)) - |> Seq.toList + |> Seq.collect (fun (Kvp(name, binding)) -> + Update(helper.LoggingArgs, name).Recursive(helper.Model, newModel, binding)) + |> Seq.toList let raiseEvents eventsToRaise helper = - let { - log = log - nameChain = nameChain } = helper.LoggingArgs + let { log = log; nameChain = nameChain } = helper.LoggingArgs let raisePropertyChanged name = log.LogTrace("[{BindingNameChain}] PropertyChanged {BindingName}", nameChain, name) - helper.PropertyChanged.Trigger(helper.GetSender (), PropertyChangedEventArgs name) - let raiseCanExecuteChanged (cmd: Command) = - cmd.RaiseCanExecuteChanged () + helper.PropertyChanged.Trigger(helper.GetSender(), PropertyChangedEventArgs name) + + let raiseCanExecuteChanged (cmd: Command) = cmd.RaiseCanExecuteChanged() + let raiseErrorsChanged name = log.LogTrace("[{BindingNameChain}] ErrorsChanged {BindingName}", nameChain, name) - helper.ErrorsChanged.Trigger([| helper.GetSender (); box <| DataErrorsChangedEventArgs name |]) + helper.ErrorsChanged.Trigger([| helper.GetSender(); box <| DataErrorsChangedEventArgs name |]) eventsToRaise |> List.iter (function @@ -113,35 +114,47 @@ module internal ViewModelHelper = let getFunctionsForSubModelSelectedItem loggingArgs initializedBindings (name: string) = let log = loggingArgs.log + initializedBindings |> IReadOnlyDictionary.tryFind name |> function | Some b -> match FuncsFromSubModelSeqKeyed().Recursive(b |> MapOutputType.unboxVm) with | Some x -> Some x - | None -> log.LogError("SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but it is not a SubModelSeq binding", name) - None - | None -> log.LogError("SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but no binding was found with that name", name) - None - -type [] internal DynamicViewModel<'model, 'msg> - ( args: ViewModelArgs<'model, 'msg>, - bindings: Binding<'model, 'msg> list) - as this = + | None -> + log.LogError( + "SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but it is not a SubModelSeq binding", + name + ) + + None + | None -> + log.LogError( + "SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but no binding was found with that name", + name + ) + + None + +[] +type internal DynamicViewModel<'model, 'msg>(args: ViewModelArgs<'model, 'msg>, bindings: Binding<'model, 'msg> list) as this + = inherit DynamicObject() let { initialModel = initialModel dispatch = dispatch - loggingArgs = loggingArgs - } = args + loggingArgs = loggingArgs } = + args - let { log = log - nameChain = nameChain - } = loggingArgs + let { log = log; nameChain = nameChain } = loggingArgs let (bindings, validationErrors) = let initializeBinding initializedBindings binding = - Initialize(loggingArgs, binding.Name, ViewModelHelper.getFunctionsForSubModelSelectedItem loggingArgs initializedBindings) + Initialize( + loggingArgs, + binding.Name, + ViewModelHelper.getFunctionsForSubModelSelectedItem loggingArgs initializedBindings + ) .Recursive(initialModel, dispatch, (fun () -> this |> IViewModel.currentModel), binding.Data) log.LogTrace("[{BindingNameChain}] Initializing bindings", nameChain) @@ -149,9 +162,8 @@ type [] internal DynamicViewModel<'model, 'msg> let bindingDict = Dictionary>(bindings.Length) let validationDict = Dictionary() - let sortedBindings = - bindings - |> List.sortWith (SubModelSelectedItemLast().CompareBindings()) + let sortedBindings = bindings |> List.sortWith (SubModelSelectedItemLast().CompareBindings()) + for b in sortedBindings do if bindingDict.ContainsKey b.Name then log.LogError("Binding name {BindingName} is duplicated. Only the first occurrence will be used.", b.Name) @@ -162,64 +174,109 @@ type [] internal DynamicViewModel<'model, 'msg> let! errorList = FirstValidationErrors().Recursive(vmBinding) do validationDict.Add(b.Name, errorList) return () - } |> Option.defaultValue () - (bindingDict |> Seq.map (|KeyValue|) |> Map.ofSeq, - validationDict |> Seq.map (|KeyValue|) |> Map.ofSeq) + } + |> Option.defaultValue () - let mutable helper = - ViewModelHelper.create - (fun () -> this) - args - bindings - validationErrors + (bindingDict |> Seq.map (|KeyValue|) |> Map.ofSeq, validationDict |> Seq.map (|KeyValue|) |> Map.ofSeq) + + let mutable helper = ViewModelHelper.create (fun () -> this) args bindings validationErrors interface IViewModel<'model, 'msg> with - member _.CurrentModel : 'model = helper.Model + member _.CurrentModel: 'model = helper.Model - member _.UpdateModel (newModel: 'model) : unit = + member _.UpdateModel(newModel: 'model) : unit = let eventsToRaise = ViewModelHelper.getEventsToRaise newModel helper helper <- { helper with Model = newModel } ViewModelHelper.raiseEvents eventsToRaise helper - override _.TryGetMember (binder, result) = + override _.TryGetMember(binder, result) = log.LogTrace("[{BindingNameChain}] TryGetMember {BindingName}", nameChain, binder.Name) + match bindings.TryGetValue binder.Name with | false, _ -> - log.LogError("[{BindingNameChain}] TryGetMember FAILED: Property {BindingName} doesn't exist", nameChain, binder.Name) - false + log.LogError( + "[{BindingNameChain}] TryGetMember FAILED: Property {BindingName} doesn't exist", + nameChain, + binder.Name + ) + + false | true, binding -> - try - match Get(nameChain).Recursive(helper.Model, binding) with - | Ok v -> - result <- v - true - | Error e -> - match e with - | GetError.OneWayToSource -> log.LogError("[{BindingNameChain}] TryGetMember FAILED: Binding {BindingName} is read-only", nameChain, binder.Name) - | GetError.SubModelSelectedItem d -> log.LogError("[{BindingNameChain}] TryGetMember FAILED: Failed to find an element of the SubModelSeq binding {SubModelSeqBindingName} with ID {ID} in the getter for the binding {BindingName}", d.NameChain, d.SubModelSeqBindingName, d.Id, binder.Name) - | GetError.ToNullError (ValueOption.ToNullError.ValueCannotBeNull nonNullTypeName) -> log.LogError("[{BindingNameChain}] TryGetMember FAILED: Binding {BindingName} is null, but type {Type} is non-nullable", nameChain, binder.Name, nonNullTypeName) - false - with e -> - log.LogError(e, "[{BindingNameChain}] TryGetMember FAILED: Exception thrown while processing binding {BindingName}", nameChain, binder.Name) - reraise () - - override _.TrySetMember (binder, value) = + try + match Get(nameChain).Recursive(helper.Model, binding) with + | Ok v -> + result <- v + true + | Error e -> + match e with + | GetError.OneWayToSource -> + log.LogError( + "[{BindingNameChain}] TryGetMember FAILED: Binding {BindingName} is read-only", + nameChain, + binder.Name + ) + | GetError.SubModelSelectedItem d -> + log.LogError( + "[{BindingNameChain}] TryGetMember FAILED: Failed to find an element of the SubModelSeq binding {SubModelSeqBindingName} with ID {ID} in the getter for the binding {BindingName}", + d.NameChain, + d.SubModelSeqBindingName, + d.Id, + binder.Name + ) + | GetError.ToNullError(ValueOption.ToNullError.ValueCannotBeNull nonNullTypeName) -> + log.LogError( + "[{BindingNameChain}] TryGetMember FAILED: Binding {BindingName} is null, but type {Type} is non-nullable", + nameChain, + binder.Name, + nonNullTypeName + ) + + false + with e -> + log.LogError( + e, + "[{BindingNameChain}] TryGetMember FAILED: Exception thrown while processing binding {BindingName}", + nameChain, + binder.Name + ) + + reraise () + + override _.TrySetMember(binder, value) = log.LogTrace("[{BindingNameChain}] TrySetMember {BindingName}", nameChain, binder.Name) + match bindings.TryGetValue binder.Name with | false, _ -> - log.LogError("[{BindingNameChain}] TrySetMember FAILED: Property {BindingName} doesn't exist", nameChain, binder.Name) - false + log.LogError( + "[{BindingNameChain}] TrySetMember FAILED: Property {BindingName} doesn't exist", + nameChain, + binder.Name + ) + + false | true, binding -> - try - let success = Set(value).Recursive(helper.Model, binding) - if not success then - log.LogError("[{BindingNameChain}] TrySetMember FAILED: Binding {BindingName} is read-only", nameChain, binder.Name) - success - with e -> - log.LogError(e, "[{BindingNameChain}] TrySetMember FAILED: Exception thrown while processing binding {BindingName}", nameChain, binder.Name) - reraise () - - override _.GetDynamicMemberNames () = + try + let success = Set(value).Recursive(helper.Model, binding) + + if not success then + log.LogError( + "[{BindingNameChain}] TrySetMember FAILED: Binding {BindingName} is read-only", + nameChain, + binder.Name + ) + + success + with e -> + log.LogError( + e, + "[{BindingNameChain}] TrySetMember FAILED: Exception thrown while processing binding {BindingName}", + nameChain, + binder.Name + ) + + reraise () + + override _.GetDynamicMemberNames() = log.LogTrace("[{BindingNameChain}] GetDynamicMemberNames", nameChain) bindings.Keys @@ -231,13 +288,14 @@ type [] internal DynamicViewModel<'model, 'msg> interface INotifyDataErrorInfo with [] member _.ErrorsChanged = (helper :> INotifyDataErrorInfo).ErrorsChanged + member _.HasErrors = (helper :> INotifyDataErrorInfo).HasErrors member _.GetErrors name = (helper :> INotifyDataErrorInfo).GetErrors name open System.Runtime.CompilerServices -type [] ViewModelBase<'model, 'msg>(args: ViewModelArgs<'model, 'msg>) - as this = +[] +type ViewModelBase<'model, 'msg>(args: ViewModelArgs<'model, 'msg>) as this = let mutable setBindings = Map.empty> @@ -245,74 +303,119 @@ type [] ViewModelBase<'model, 'msg>(args: ViewModelArgs<'model let { loggingArgs = loggingArgs initialModel = initialModel - dispatch = dispatch } = args + dispatch = dispatch } = + args + let { log = log; nameChain = nameChain } = loggingArgs let initializeBinding initializedBindings binding = - Initialize(loggingArgs, binding.Name, ViewModelHelper.getFunctionsForSubModelSelectedItem loggingArgs initializedBindings) + Initialize( + loggingArgs, + binding.Name, + ViewModelHelper.getFunctionsForSubModelSelectedItem loggingArgs initializedBindings + ) .Recursive(initialModel, dispatch, (fun () -> this |> IViewModel.currentModel), binding.Data) - member _.Get<'a> ([] ?memberName: string) = + member _.Get<'a>([] ?memberName: string) = fun (binding: string -> Binding<'model, 'msg, 'a>) -> let result = option { let! name = memberName - let! vmBinding = option { - match helper.Bindings.TryGetValue name with - | true, value -> - return value |> MapOutputType.unboxVm - | false, _ -> - let binding = binding name - let! vmBinding = binding |> initializeBinding helper.Bindings - let newBindings = helper.Bindings.Add (name, vmBinding |> MapOutputType.boxVm) - let newValidationErrors = - FirstValidationErrors().Recursive(vmBinding) - |> Option.map (fun errorList -> helper.ValidationErrors.Add (name, errorList)) - |> Option.defaultValue helper.ValidationErrors - helper <- - { helper with - Bindings = newBindings - ValidationErrors = newValidationErrors } - return vmBinding - } + + let! vmBinding = + option { + match helper.Bindings.TryGetValue name with + | true, value -> return value |> MapOutputType.unboxVm + | false, _ -> + let binding = binding name + let! vmBinding = binding |> initializeBinding helper.Bindings + let newBindings = helper.Bindings.Add(name, vmBinding |> MapOutputType.boxVm) + + let newValidationErrors = + FirstValidationErrors().Recursive(vmBinding) + |> Option.map (fun errorList -> helper.ValidationErrors.Add(name, errorList)) + |> Option.defaultValue helper.ValidationErrors + + helper <- + { helper with + Bindings = newBindings + ValidationErrors = newValidationErrors } + + return vmBinding + } + return Get(nameChain).Recursive(helper.Model, vmBinding) } + match result with | None -> - log.LogError("[{BindingNameChain}] Get FAILED: Binding {BindingName} could not be constructed", nameChain, memberName) + log.LogError( + "[{BindingNameChain}] Get FAILED: Binding {BindingName} could not be constructed", + nameChain, + memberName + ) + failwithf $"[%s{nameChain}] Get FAILED: Binding {memberName} could not be constructed" - | Some (Error e) -> + | Some(Error e) -> match e with - | GetError.OneWayToSource -> log.LogError("[{BindingNameChain}] Get FAILED: Binding {BindingName} is read-only", nameChain, memberName) - | GetError.SubModelSelectedItem d -> log.LogError("[{BindingNameChain}] Get FAILED: Failed to find an element of the SubModelSeq binding {SubModelSeqBindingName} with ID {ID} in the getter for the binding {BindingName}", d.NameChain, d.SubModelSeqBindingName, d.Id, memberName) - | GetError.ToNullError (ValueOption.ToNullError.ValueCannotBeNull nonNullTypeName) -> log.LogError("[{BindingNameChain}] Get FAILED: Binding {BindingName} is null, but type {Type} is non-nullable", nameChain, memberName, nonNullTypeName) + | GetError.OneWayToSource -> + log.LogError("[{BindingNameChain}] Get FAILED: Binding {BindingName} is read-only", nameChain, memberName) + | GetError.SubModelSelectedItem d -> + log.LogError( + "[{BindingNameChain}] Get FAILED: Failed to find an element of the SubModelSeq binding {SubModelSeqBindingName} with ID {ID} in the getter for the binding {BindingName}", + d.NameChain, + d.SubModelSeqBindingName, + d.Id, + memberName + ) + | GetError.ToNullError(ValueOption.ToNullError.ValueCannotBeNull nonNullTypeName) -> + log.LogError( + "[{BindingNameChain}] Get FAILED: Binding {BindingName} is null, but type {Type} is non-nullable", + nameChain, + memberName, + nonNullTypeName + ) + failwithf $"[%s{nameChain}] Get FAILED: Binding {memberName} returned an error {e}" - | Some (Ok r) -> r + | Some(Ok r) -> r - member _.Set<'a> (value: 'a, [] ?memberName: string) = + member _.Set<'a>(value: 'a, [] ?memberName: string) = fun (binding: string -> Binding<'model, 'msg, 'a>) -> try let success = option { let! name = memberName - let! vmBinding = option { - match setBindings.TryGetValue name with - | true, value -> - return value |> MapOutputType.unboxVm - | false, _ -> - let binding = binding name - let! vmBinding = initializeBinding helper.Bindings binding - setBindings <- setBindings.Add (name, vmBinding |> MapOutputType.boxVm) - return vmBinding - } + + let! vmBinding = + option { + match setBindings.TryGetValue name with + | true, value -> return value |> MapOutputType.unboxVm + | false, _ -> + let binding = binding name + let! vmBinding = initializeBinding helper.Bindings binding + setBindings <- setBindings.Add(name, vmBinding |> MapOutputType.boxVm) + return vmBinding + } + return Set(value).Recursive(helper.Model, vmBinding) } + if success = Some false then log.LogError("[{BindingNameChain}] Set FAILED: Binding {BindingName} is read-only", nameChain, memberName) else if success = None then - log.LogError("[{BindingNameChain}] Set FAILED: Binding {BindingName} could not be constructed", nameChain, memberName) + log.LogError( + "[{BindingNameChain}] Set FAILED: Binding {BindingName} could not be constructed", + nameChain, + memberName + ) with e -> - log.LogError(e, "[{BindingNameChain}] Set FAILED: Exception thrown while processing binding {BindingName}", nameChain, memberName) + log.LogError( + e, + "[{BindingNameChain}] Set FAILED: Exception thrown while processing binding {BindingName}", + nameChain, + memberName + ) + reraise () interface IViewModel<'model, 'msg> with @@ -330,5 +433,6 @@ type [] ViewModelBase<'model, 'msg>(args: ViewModelArgs<'model interface INotifyDataErrorInfo with [] member _.ErrorsChanged = (helper :> INotifyDataErrorInfo).ErrorsChanged + member _.HasErrors = (helper :> INotifyDataErrorInfo).HasErrors - member _.GetErrors name = (helper :> INotifyDataErrorInfo).GetErrors name + member _.GetErrors name = (helper :> INotifyDataErrorInfo).GetErrors name \ No newline at end of file diff --git a/src/Elmish.WPF/WindowState.fs b/src/Elmish.WPF/WindowState.fs index c6cec452..5798702c 100644 --- a/src/Elmish.WPF/WindowState.fs +++ b/src/Elmish.WPF/WindowState.fs @@ -3,37 +3,26 @@ [] type WindowState<'model> = | Closed - | Hidden of 'model + | Hidden of 'model | Visible of 'model module WindowState = - let cata a f g = function - | WindowState.Closed -> a - | WindowState.Hidden a -> a |> f + let cata a f g = + function + | WindowState.Closed -> a + | WindowState.Hidden a -> a |> f | WindowState.Visible a -> a |> g - let map f = - cata - WindowState.Closed - (f >> WindowState.Hidden) - (f >> WindowState.Visible) + let map f = cata WindowState.Closed (f >> WindowState.Hidden) (f >> WindowState.Visible) let set a = map (fun _ -> a) - let toHidden a = - cata - (WindowState.Hidden a) - WindowState.Hidden - WindowState.Hidden + let toHidden a = cata (WindowState.Hidden a) WindowState.Hidden WindowState.Hidden - let toVisible a = - cata - (WindowState.Visible a) - WindowState.Visible - WindowState.Visible + let toVisible a = cata (WindowState.Visible a) WindowState.Visible WindowState.Visible - let toOption state = state |> cata None Some Some + let toOption state = state |> cata None Some Some let toVOption state = state |> cata ValueNone ValueSome ValueSome /// Converts None to WindowState.Closed, and Some(x) to @@ -41,11 +30,11 @@ module WindowState = let ofOption (model: 'model option) = match model with | Some a -> a |> WindowState.Visible - | None -> WindowState.Closed + | None -> WindowState.Closed /// Converts ValueNone to WindowState.Closed, and ValueSome(x) to /// WindowState.Visible(x). let ofVOption (model: 'model voption) = match model with | ValueSome a -> a |> WindowState.Visible - | ValueNone -> WindowState.Closed \ No newline at end of file + | ValueNone -> WindowState.Closed \ No newline at end of file diff --git a/src/Elmish.WPF/WpfProgram.fs b/src/Elmish.WPF/WpfProgram.fs index f1683fc6..cae61e95 100644 --- a/src/Elmish.WPF/WpfProgram.fs +++ b/src/Elmish.WPF/WpfProgram.fs @@ -7,15 +7,16 @@ open Elmish type WpfProgram<'model, 'msg, 'viewModel> = - internal { - ElmishProgram: Program - CreateViewModel: ViewModelArgs<'model,'msg> -> 'viewModel - UpdateViewModel: 'viewModel * 'model -> unit - LoggerFactory: ILoggerFactory - ErrorHandler: string -> exn -> unit - /// Only log calls that take at least this many milliseconds. Default 1. - PerformanceLogThreshold: int - } + internal + { + ElmishProgram: Program + CreateViewModel: ViewModelArgs<'model, 'msg> -> 'viewModel + UpdateViewModel: 'viewModel * 'model -> unit + LoggerFactory: ILoggerFactory + ErrorHandler: string -> exn -> unit + /// Only log calls that take at least this many milliseconds. Default 1. + PerformanceLogThreshold: int + } type WpfProgram<'model, 'msg> = WpfProgram<'model, 'msg, obj> @@ -31,9 +32,9 @@ module WpfProgram = ErrorHandler = p.ErrorHandler PerformanceLogThreshold = p.PerformanceLogThreshold } - let private createWithBindings (getBindings: unit -> Binding<'model,'msg> list) program = + let private createWithBindings (getBindings: unit -> Binding<'model, 'msg> list) program = { ElmishProgram = program - CreateViewModel = fun args -> DynamicViewModel<'model,'msg>(args, getBindings ()) + CreateViewModel = fun args -> DynamicViewModel<'model, 'msg>(args, getBindings ()) UpdateViewModel = IViewModel.updateModel LoggerFactory = NullLoggerFactory.Instance ErrorHandler = fun _ _ -> () @@ -51,44 +52,44 @@ module WpfProgram = /// Creates a WpfProgram that does not use commands. let mkSimple - (init: unit -> 'model) - (update: 'msg -> 'model -> 'model) - (bindings: unit -> Binding<'model, 'msg> list) = - Program.mkSimple init update (fun _ _ -> ()) - |> createWithBindings bindings + (init: unit -> 'model) + (update: 'msg -> 'model -> 'model) + (bindings: unit -> Binding<'model, 'msg> list) + = + Program.mkSimple init update (fun _ _ -> ()) |> createWithBindings bindings /// Creates a WpfProgram that uses commands let mkProgram - (init: unit -> 'model * Cmd<'msg>) - (update: 'msg -> 'model -> 'model * Cmd<'msg>) - (bindings: unit -> Binding<'model, 'msg> list) = - Program.mkProgram init update (fun _ _ -> ()) - |> createWithBindings bindings + (init: unit -> 'model * Cmd<'msg>) + (update: 'msg -> 'model -> 'model * Cmd<'msg>) + (bindings: unit -> Binding<'model, 'msg> list) + = + Program.mkProgram init update (fun _ _ -> ()) |> createWithBindings bindings /// Creates a WpfProgram that does not use commands. let mkSimpleT - (init: unit -> 'model) - (update: 'msg -> 'model -> 'model) - (createVm: ViewModelArgs<'model, 'msg> -> 'viewModel) = - Program.mkSimple init update (fun _ _ -> ()) - |> createWithVm createVm + (init: unit -> 'model) + (update: 'msg -> 'model -> 'model) + (createVm: ViewModelArgs<'model, 'msg> -> 'viewModel) + = + Program.mkSimple init update (fun _ _ -> ()) |> createWithVm createVm /// Creates a WpfProgram that uses commands let mkProgramT - (init: unit -> 'model * Cmd<'msg>) - (update: 'msg -> 'model -> 'model * Cmd<'msg>) - (createVm: ViewModelArgs<'model, 'msg> -> 'viewModel) = - Program.mkProgram init update (fun _ _ -> ()) - |> createWithVm createVm + (init: unit -> 'model * Cmd<'msg>) + (update: 'msg -> 'model -> 'model * Cmd<'msg>) + (createVm: ViewModelArgs<'model, 'msg> -> 'viewModel) + = + Program.mkProgram init update (fun _ _ -> ()) |> createWithVm createVm [] type ElmishThreaderBehavior = - | SingleThreaded - | Threaded_NoUIDispatch - | Threaded_PendingUIDispatch of pending: System.Threading.Tasks.TaskCompletionSource unit> - | Threaded_UIDispatch of active: System.Threading.Tasks.TaskCompletionSource unit> + | SingleThreaded + | Threaded_NoUIDispatch + | Threaded_PendingUIDispatch of pending: System.Threading.Tasks.TaskCompletionSource unit> + | Threaded_UIDispatch of active: System.Threading.Tasks.TaskCompletionSource unit> /// Starts an Elmish dispatch loop, setting the bindings as the DataContext for the /// specified FrameworkElement. Non-blocking. If you have an explicit entry point where @@ -115,18 +116,26 @@ module WpfProgram = /// /// /// - let startElmishLoop - (element: FrameworkElement) - (program: WpfProgram<'model, 'msg, 'viewModel>) = + let startElmishLoop (element: FrameworkElement) (program: WpfProgram<'model, 'msg, 'viewModel>) = let mutable viewModel = None let updateLogger = program.LoggerFactory.CreateLogger("Elmish.WPF.Update") let bindingsLogger = program.LoggerFactory.CreateLogger("Elmish.WPF.Bindings") let performanceLogger = program.LoggerFactory.CreateLogger("Elmish.WPF.Performance") - let measure callName f = BindingVmHelpers.Helpers2.measure performanceLogger LogLevel.Debug program.PerformanceLogThreshold "" "main" callName f + let measure callName f = + BindingVmHelpers.Helpers2.measure + performanceLogger + LogLevel.Debug + program.PerformanceLogThreshold + "" + "main" + callName + f - let program = { program with UpdateViewModel = measure "updateViewModel" program.UpdateViewModel } + let program = + { program with + UpdateViewModel = measure "updateViewModel" program.UpdateViewModel } (* * Capture the dispatch function before wrapping it with Dispatcher.InvokeAsync @@ -142,6 +151,7 @@ module WpfProgram = let mutable dispatch = Unchecked.defaultof> let elmishDispatcher = Threading.Dispatcher.CurrentDispatcher + let mutable threader = if element.Dispatcher = elmishDispatcher then SingleThreaded @@ -167,10 +177,10 @@ module WpfProgram = // Wait on `elmishDispatcher` to get to this invocation and collect result let continuationOnUIThread = uiWaiter.Task.Result // Result is the `program.UpdateViewModel` call, so execute here on the UI thread - continuationOnUIThread() + continuationOnUIThread () | Threaded_PendingUIDispatch uiWaiter | Threaded_UIDispatch uiWaiter -> - uiWaiter.SetException(exn("Error in core Elmish.WPF threading code. Invalid state reached!")) + uiWaiter.SetException(exn ("Error in core Elmish.WPF threading code. Invalid state reached!")) else // message is not from the UI thread elmishDispatcher.InvokeAsync(fun () -> dispatch msg) |> ignore // handle as a command message @@ -178,6 +188,7 @@ module WpfProgram = // (which is UI thread in single-threaded case) let mutable pendingModel = ValueNone let mutable ct = 0 + let setUiState model _syncDispatch = let i = ct ct <- ct + 1 @@ -186,53 +197,55 @@ module WpfProgram = match viewModel with | None -> // no view model yet, so create one - let args = - { initialModel = model - dispatch = dispatchFromViewModel - loggingArgs = - { performanceLogThresholdMs = program.PerformanceLogThreshold - nameChain = "main" - log = bindingsLogger - logPerformance = performanceLogger } } - let vm = program.CreateViewModel args - element.Dispatcher.Invoke(fun () -> element.DataContext <- vm) - viewModel <- Some vm + let args = + { initialModel = model + dispatch = dispatchFromViewModel + loggingArgs = + { performanceLogThresholdMs = program.PerformanceLogThreshold + nameChain = "main" + log = bindingsLogger + logPerformance = performanceLogger } } + + let vm = program.CreateViewModel args + element.Dispatcher.Invoke(fun () -> element.DataContext <- vm) + viewModel <- Some vm | Some vm -> // view model exists, so update - match threader with - | Threaded_UIDispatch uiWaiter -> // We are in the specific dispatch call from the UI thread (see `synchronizedUiDispatch` in `dispatchFromViewModel`) - updateLogger.LogDebug("SetUIState {i} UIDISPATCH", i); + match threader with + | Threaded_UIDispatch uiWaiter -> // We are in the specific dispatch call from the UI thread (see `synchronizedUiDispatch` in `dispatchFromViewModel`) + updateLogger.LogDebug("SetUIState {i} UIDISPATCH", i) + + let unscheduleJob () = + pendingModel <- ValueNone + updateLogger.LogDebug("Unscheduled job already completed from main thread {i}", i) + + let executeJobImmediately () = + program.UpdateViewModel(vm, model) + updateLogger.LogDebug("Update done from main thread {i}", i) + + element.Dispatcher.InvokeAsync(unscheduleJob, scheduleJobThreadPriority) + |> ignore // Unschedule update (already done) - let unscheduleJob () = + uiWaiter.SetResult(executeJobImmediately) // execute `UpdateViewModel` on UI thread + | Threaded_PendingUIDispatch _ // We are in a non-UI dispatch that updated the model before the UI got its update in, but after the user interacted + | Threaded_NoUIDispatch -> // We are in a non-UI dispatch with no pending user interactions known + updateLogger.LogDebug("SetUIState {i} NOUIDISPATCH {threader}", i, threader) + + let scheduleJob () = + pendingModel <- ValueSome model + updateLogger.LogDebug("Scheduled new job {i}", i) + + let executeJob () = + match pendingModel with + | ValueSome m -> + program.UpdateViewModel(vm, m) pendingModel <- ValueNone - updateLogger.LogDebug("Unscheduled job already completed from main thread {i}", i) - - let executeJobImmediately () = - program.UpdateViewModel (vm, model) - updateLogger.LogDebug("Update done from main thread {i}", i) - - element.Dispatcher.InvokeAsync(unscheduleJob, scheduleJobThreadPriority) |> ignore // Unschedule update (already done) - uiWaiter.SetResult(executeJobImmediately) // execute `UpdateViewModel` on UI thread - | Threaded_PendingUIDispatch _ // We are in a non-UI dispatch that updated the model before the UI got its update in, but after the user interacted - | Threaded_NoUIDispatch -> // We are in a non-UI dispatch with no pending user interactions known - updateLogger.LogDebug("SetUIState {i} NOUIDISPATCH {threader}", i, threader); - - let scheduleJob () = - pendingModel <- ValueSome model - updateLogger.LogDebug("Scheduled new job {i}", i) - - let executeJob () = - match pendingModel with - | ValueSome m -> - program.UpdateViewModel (vm, m) - pendingModel <- ValueNone - updateLogger.LogDebug("Job was full - Update done {i}", i) - | ValueNone -> - updateLogger.LogDebug("Job was empty - No update done {i}", i) - - element.Dispatcher.InvokeAsync(scheduleJob, scheduleJobThreadPriority) |> ignore // Schedule update - element.Dispatcher.InvokeAsync(executeJob, executeJobThreadPriority) |> ignore // Execute Update - | SingleThreaded -> // If we aren't using different threads, always process normally - element.Dispatcher.Invoke(fun () -> program.UpdateViewModel (vm, model)) + updateLogger.LogDebug("Job was full - Update done {i}", i) + | ValueNone -> updateLogger.LogDebug("Job was empty - No update done {i}", i) + + element.Dispatcher.InvokeAsync(scheduleJob, scheduleJobThreadPriority) |> ignore // Schedule update + element.Dispatcher.InvokeAsync(executeJob, executeJobThreadPriority) |> ignore // Execute Update + | SingleThreaded -> // If we aren't using different threads, always process normally + element.Dispatcher.Invoke(fun () -> program.UpdateViewModel(vm, model)) let cmdDispatch (innerDispatch: Dispatch<'msg>) : Dispatch<'msg> = let innerDispatch = measure "dispatch" innerDispatch @@ -252,7 +265,10 @@ module WpfProgram = program.ErrorHandler msg ex program.ElmishProgram - |> if updateLogger.IsEnabled LogLevel.Trace then Program.withTrace logMsgAndModel else id + |> if updateLogger.IsEnabled LogLevel.Trace then + Program.withTrace logMsgAndModel + else + id |> Program.withErrorHandler errorHandler |> Program.withSetState setUiState |> Program.runWithDispatch cmdDispatch () @@ -262,7 +278,7 @@ module WpfProgram = /// running. let private initializeApplication window = if isNull Application.Current then - Application () |> ignore + Application() |> ignore Application.Current.MainWindow <- window @@ -282,7 +298,7 @@ module WpfProgram = *) initializeApplication window startElmishLoop window program - window.Show () + window.Show() Application.Current.Run window @@ -293,16 +309,13 @@ module WpfProgram = /// general; this is just a trivial convenience function that automatically /// converts CmdMsg to Cmd<'msg> for you in init and update. let mkProgramWithCmdMsg - (init: unit -> 'model * 'cmdMsg list) - (update: 'msg -> 'model -> 'model * 'cmdMsg list) - (bindings: unit -> Binding<'model, 'msg> list) - (toCmd: 'cmdMsg -> Cmd<'msg>) = - let convert (model, cmdMsgs) = - model, (cmdMsgs |> List.map toCmd |> Cmd.batch) - mkProgram - (init >> convert) - (fun msg model -> update msg model |> convert) - bindings + (init: unit -> 'model * 'cmdMsg list) + (update: 'msg -> 'model -> 'model * 'cmdMsg list) + (bindings: unit -> Binding<'model, 'msg> list) + (toCmd: 'cmdMsg -> Cmd<'msg>) + = + let convert (model, cmdMsgs) = model, (cmdMsgs |> List.map toCmd |> Cmd.batch) + mkProgram (init >> convert) (fun msg model -> update msg model |> convert) bindings /// Same as mkProgramT, except that init and update don't return Cmd<'msg> @@ -312,21 +325,19 @@ module WpfProgram = /// general; this is just a trivial convenience function that automatically /// converts CmdMsg to Cmd<'msg> for you in init and update. let mkProgramWithCmdMsgT - (init: unit -> 'model * 'cmdMsg list) - (update: 'msg -> 'model -> 'model * 'cmdMsg list) - (createVm: ViewModelArgs<'model, 'msg> -> 'viewModel) - (toCmd: 'cmdMsg -> Cmd<'msg>) = - let convert (model, cmdMsgs) = - model, (cmdMsgs |> List.map toCmd |> Cmd.batch) - mkProgramT - (init >> convert) - (fun msg model -> update msg model |> convert) - createVm + (init: unit -> 'model * 'cmdMsg list) + (update: 'msg -> 'model -> 'model * 'cmdMsg list) + (createVm: ViewModelArgs<'model, 'msg> -> 'viewModel) + (toCmd: 'cmdMsg -> Cmd<'msg>) + = + let convert (model, cmdMsgs) = model, (cmdMsgs |> List.map toCmd |> Cmd.batch) + mkProgramT (init >> convert) (fun msg model -> update msg model |> convert) createVm /// Uses the specified ILoggerFactory for logging. let withLogger loggerFactory program = - { program with LoggerFactory = loggerFactory } + { program with + LoggerFactory = loggerFactory } /// Calls the specified function for unhandled exceptions in the Elmish @@ -339,36 +350,40 @@ module WpfProgram = /// /// Note that exceptions passed to onError are also logged to the logger /// specified using WpfProgram.withLogger. - let withElmishErrorHandler onError program = - { program with ErrorHandler = onError } + let withElmishErrorHandler onError program = { program with ErrorHandler = onError } /// Subscribe to external source of events, overrides existing subscription. /// Return the subscriptions that should be active based on the current model. /// Subscriptions will be started or stopped automatically to match. let withSubscription (subscribe: 'model -> Sub<'msg>) program = - { program with ElmishProgram = program.ElmishProgram |> Program.withSubscription subscribe } + { program with + ElmishProgram = program.ElmishProgram |> Program.withSubscription subscribe } /// Map existing subscription to external source of events. let mapSubscription map program = - { program with ElmishProgram = program.ElmishProgram |> Program.mapSubscription map } + { program with + ElmishProgram = program.ElmishProgram |> Program.mapSubscription map } /// Only logs binding performance for calls taking longer than the specified number of /// milliseconds. The default is 1ms. let withPerformanceLogThreshold threshold program = - { program with PerformanceLogThreshold = threshold } + { program with + PerformanceLogThreshold = threshold } /// Exit criteria and the handler, overrides existing. let withTermination predicate terminate program = - { program with ElmishProgram = program.ElmishProgram |> Program.withTermination predicate terminate } + { program with + ElmishProgram = program.ElmishProgram |> Program.withTermination predicate terminate } /// Map existing criteria and the handler. let mapTermination map program = - { program with ElmishProgram = program.ElmishProgram |> Program.mapTermination map } + { program with + ElmishProgram = program.ElmishProgram |> Program.mapTermination map } [] @@ -378,7 +393,9 @@ module Subscribe = let ofEffect dispose (effect: Effect<'msg>) : Subscribe<'msg> = fun dispatch -> effect dispatch - { new System.IDisposable with member _.Dispose() = dispose () } + + { new System.IDisposable with + member _.Dispose() = dispose () } [] @@ -387,7 +404,7 @@ module Sub = /// with the initial model, but can dispatch messages at any time. [] let fromV3Subscription (idPrefix: string) (v3Subscription: 'model -> Cmd<'msg>) : 'model -> Sub<'msg> = - let mutable memoizedSub : Sub<'msg> voption = ValueNone + let mutable memoizedSub: Sub<'msg> voption = ValueNone fun model -> match memoizedSub with @@ -396,8 +413,8 @@ module Sub = v3Subscription model |> List.map (Subscribe.ofEffect id) |> List.indexed - |> List.map (fun (i, subscribe) -> - [ idPrefix; string i ], subscribe) + |> List.map (fun (i, subscribe) -> [ idPrefix; string i ], subscribe) + memoizedSub <- ValueSome sub sub - | ValueSome sub -> sub + | ValueSome sub -> sub \ No newline at end of file diff --git a/src/Samples/Capabilities.Core/Program.fs b/src/Samples/Capabilities.Core/Program.fs index cbbdb8db..6afc3050 100644 --- a/src/Samples/Capabilities.Core/Program.fs +++ b/src/Samples/Capabilities.Core/Program.fs @@ -10,8 +10,7 @@ open Elmish.WPF open Selection -type Screen = - SelectionScreen +type Screen = SelectionScreen type Model = { VisibleScreen: Screen option @@ -26,6 +25,7 @@ module Program = module VisibleScreen = let get m = m.VisibleScreen let set v m = { m with VisibleScreen = v } + module Selection = open Selection let get m = m.Selection @@ -37,22 +37,24 @@ module Program = { VisibleScreen = None Selection = Selection.init } - let update = function + let update = + function | SetVisibleScreen s -> s |> VisibleScreen.set | SelectionMsg msg -> msg |> Selection.update - let boolToVis = function - | true -> Visibility.Visible + let boolToVis = + function + | true -> Visibility.Visible | false -> Visibility.Collapsed - let bindings () = [ - "Selection" + let bindings () = + [ "Selection" |> Binding.SubModel.required Selection.bindings |> Binding.mapModel Selection.get |> Binding.mapMsg SelectionMsg - "ShowSelection" |> Binding.cmd (SelectionScreen |> Some |> SetVisibleScreen) - "SelectionVisibility" |> Binding.oneWay (VisibleScreen.get >> (=) (Some SelectionScreen) >> boolToVis) - ] + "ShowSelection" |> Binding.cmd (SelectionScreen |> Some |> SetVisibleScreen) + "SelectionVisibility" + |> Binding.oneWay (VisibleScreen.get >> (=) (Some SelectionScreen) >> boolToVis) ] let main window = diff --git a/src/Samples/Capabilities.Core/Selection.fs b/src/Samples/Capabilities.Core/Selection.fs index 22b09cf2..7748ba08 100644 --- a/src/Samples/Capabilities.Core/Selection.fs +++ b/src/Samples/Capabilities.Core/Selection.fs @@ -3,15 +3,15 @@ open Elmish.WPF -type Tree<'a> = - { Data: 'a - Children: Tree<'a> list } +type Tree<'a> = { Data: 'a; Children: Tree<'a> list } module Tree = let create a ma = { Data = a; Children = ma } let createLeaf a = create a [] + module Data = let get m = m.Data + module Children = let get m = m.Children @@ -31,42 +31,45 @@ module Selection = module SelectedIndex = let get m = m.SelectedIndex let set v m = { m with SelectedIndex = v } + module SelectedIndexData = let get m = m.SelectedIndexData + module SelectedValue = let get m = m.SelectedValue let set v m = { m with SelectedValue = v } + module SelectedValueData = let get m = m.SelectedValueData let init = { SelectedIndex = None - SelectedIndexData = ["A"; "B"] + SelectedIndexData = [ "A"; "B" ] SelectedValue = None SelectedValueData = [ Tree.create "A" [ Tree.createLeaf "Aa"; Tree.createLeaf "Ab" ] Tree.create "B" [ Tree.createLeaf "Ba"; Tree.createLeaf "Bb" ] ] } - let update = function + let update = + function | SetSelectedIndex x -> x |> SelectedIndex.set | SetSelectedValue x -> x |> SelectedValue.set - let rec recursiveSelectedValueBindings () = [ - "Data" |> Binding.oneWay Tree.Data.get - "SelectedValueChildren" + let rec recursiveSelectedValueBindings () = + [ "Data" |> Binding.oneWay Tree.Data.get + "SelectedValueChildren" |> Binding.subModelSeq recursiveSelectedValueBindings |> Binding.mapModel (Tree.Children.get >> List.toSeq) - |> Binding.mapMsg snd - ] + |> Binding.mapMsg snd ] - let bindings () = [ - "SelectedIndex" |> Binding.selectedIndex (SelectedIndex.get, SetSelectedIndex) - "DeselectIndex" |> Binding.cmdIf (SelectedIndex.get >> Option.map (fun _ -> SetSelectedIndex None)) - "SelectedIndexData" |> Binding.oneWay SelectedIndexData.get + let bindings () = + [ "SelectedIndex" |> Binding.selectedIndex (SelectedIndex.get, SetSelectedIndex) + "DeselectIndex" + |> Binding.cmdIf (SelectedIndex.get >> Option.map (fun _ -> SetSelectedIndex None)) + "SelectedIndexData" |> Binding.oneWay SelectedIndexData.get - "SelectedValue" |> Binding.twoWayOpt (SelectedValue.get, SetSelectedValue) - "SelectedValueData" + "SelectedValue" |> Binding.twoWayOpt (SelectedValue.get, SetSelectedValue) + "SelectedValueData" |> Binding.subModelSeq recursiveSelectedValueBindings |> Binding.mapModel (SelectedValueData.get >> List.toSeq) - |> Binding.mapMsg snd - ] \ No newline at end of file + |> Binding.mapMsg snd ] \ No newline at end of file diff --git a/src/Samples/Capabilities.Core/Utilities.fs b/src/Samples/Capabilities.Core/Utilities.fs index 1732f194..08a2ad46 100644 --- a/src/Samples/Capabilities.Core/Utilities.fs +++ b/src/Samples/Capabilities.Core/Utilities.fs @@ -3,5 +3,4 @@ module Utilities let flip f b a = f a b -let map get set f a = - a |> get |> f |> flip set a \ No newline at end of file +let map get set f a = a |> get |> f |> flip set a \ No newline at end of file diff --git a/src/Samples/EventBindingsAndBehaviors.Core/Program.fs b/src/Samples/EventBindingsAndBehaviors.Core/Program.fs index 229fd627..7246bf87 100644 --- a/src/Samples/EventBindingsAndBehaviors.Core/Program.fs +++ b/src/Samples/EventBindingsAndBehaviors.Core/Program.fs @@ -41,31 +41,36 @@ let update msg m = | LostFocus1 -> { m with Msg1 = "Not focused" } | LostFocus2 -> { m with Msg2 = "Not focused" } | ToggleVisibility -> - if m.Visibility = Visibility.Visible - then { m with Visibility = Visibility.Hidden; ButtonText = hiddenButtonText } - else { m with Visibility = Visibility.Visible; ButtonText = visibleButtonText } + if m.Visibility = Visibility.Visible then + { m with + Visibility = Visibility.Hidden + ButtonText = hiddenButtonText } + else + { m with + Visibility = Visibility.Visible + ButtonText = visibleButtonText } | NewMousePosition p -> { m with MousePosition = p } let paramToNewMousePositionMsg (p: obj) = let args = p :?> MouseEventArgs - let e = args.OriginalSource :?> UIElement; + let e = args.OriginalSource :?> UIElement let point = args.GetPosition e NewMousePosition { X = int point.X; Y = int point.Y } -let bindings () : Binding list = [ - "Msg1" |> Binding.oneWay (fun m -> m.Msg1) - "Msg2" |> Binding.oneWay (fun m -> m.Msg2) - "GotFocus1" |> Binding.cmd GotFocus1 - "GotFocus2" |> Binding.cmd GotFocus2 - "LostFocus1" |> Binding.cmd LostFocus1 - "LostFocus2" |> Binding.cmd LostFocus2 - "ToggleVisibility" |> Binding.cmd ToggleVisibility - "ButtonText" |> Binding.oneWay (fun m -> m.ButtonText) - "TextBoxVisibility" |> Binding.oneWay (fun m -> m.Visibility) - "MouseMoveCommand" |> Binding.cmdParam paramToNewMousePositionMsg - "MousePosition" |> Binding.oneWay (fun m -> sprintf "%dx%d" m.MousePosition.X m.MousePosition.Y) -] +let bindings () : Binding list = + [ "Msg1" |> Binding.oneWay (fun m -> m.Msg1) + "Msg2" |> Binding.oneWay (fun m -> m.Msg2) + "GotFocus1" |> Binding.cmd GotFocus1 + "GotFocus2" |> Binding.cmd GotFocus2 + "LostFocus1" |> Binding.cmd LostFocus1 + "LostFocus2" |> Binding.cmd LostFocus2 + "ToggleVisibility" |> Binding.cmd ToggleVisibility + "ButtonText" |> Binding.oneWay (fun m -> m.ButtonText) + "TextBoxVisibility" |> Binding.oneWay (fun m -> m.Visibility) + "MouseMoveCommand" |> Binding.cmdParam paramToNewMousePositionMsg + "MousePosition" + |> Binding.oneWay (fun m -> sprintf "%dx%d" m.MousePosition.X m.MousePosition.Y) ] let designVm = ViewModel.designInstance (init ()) (bindings ()) @@ -81,4 +86,4 @@ let main window = WpfProgram.mkSimple init update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/FileDialogs.Core/Program.fs b/src/Samples/FileDialogs.Core/Program.fs index 95f5347e..d10545a4 100644 --- a/src/Samples/FileDialogs.Core/Program.fs +++ b/src/Samples/FileDialogs.Core/Program.fs @@ -35,50 +35,69 @@ type Msg = let save text = async { - let dlg = Microsoft.Win32.SaveFileDialog () + let dlg = Microsoft.Win32.SaveFileDialog() dlg.Filter <- "Text file (*.txt)|*.txt|Markdown file (*.md)|*.md" - let result = dlg.ShowDialog () + let result = dlg.ShowDialog() + if result.HasValue && result.Value then do! File.WriteAllTextAsync(dlg.FileName, text) |> Async.AwaitTask return SaveSuccess - else return SaveCanceled + else + return SaveCanceled } let load () = async { - let dlg = Microsoft.Win32.OpenFileDialog () + let dlg = Microsoft.Win32.OpenFileDialog() dlg.Filter <- "Text file (*.txt)|*.txt|Markdown file (*.md)|*.md" dlg.DefaultExt <- "txt" - let result = dlg.ShowDialog () + let result = dlg.ShowDialog() + if result.HasValue && result.Value then let! contents = File.ReadAllTextAsync(dlg.FileName) |> Async.AwaitTask return LoadSuccess contents - else return LoadCanceled + else + return LoadCanceled } let update msg m = match msg with | SetTime t -> { m with CurrentTime = t }, Cmd.none - | SetText s -> { m with Text = s}, Cmd.none + | SetText s -> { m with Text = s }, Cmd.none | RequestSave -> m, Cmd.OfAsync.either save m.Text id SaveFailed | RequestLoad -> m, Cmd.OfAsync.either load () id LoadFailed - | SaveSuccess -> { m with StatusMsg = sprintf "Successfully saved at %O" DateTimeOffset.Now }, Cmd.none - | LoadSuccess s -> { m with Text = s; StatusMsg = sprintf "Successfully loaded at %O" DateTimeOffset.Now }, Cmd.none + | SaveSuccess -> + { m with + StatusMsg = sprintf "Successfully saved at %O" DateTimeOffset.Now }, + Cmd.none + | LoadSuccess s -> + { m with + Text = s + StatusMsg = sprintf "Successfully loaded at %O" DateTimeOffset.Now }, + Cmd.none | SaveCanceled -> { m with StatusMsg = "Saving canceled" }, Cmd.none - | LoadCanceled -> { m with StatusMsg = "Loading canceled" }, Cmd.none - | SaveFailed ex -> { m with StatusMsg = sprintf "Saving failed with exception %s: %s" (ex.GetType().Name) ex.Message }, Cmd.none - | LoadFailed ex -> { m with StatusMsg = sprintf "Loading failed with exception %s: %s" (ex.GetType().Name) ex.Message }, Cmd.none - - -let bindings () : Binding list = [ - "CurrentTime" |> Binding.oneWay (fun m -> m.CurrentTime) - "Text" |> Binding.twoWay ((fun m -> m.Text), SetText) - "StatusMsg" |> Binding.twoWay ((fun m -> m.StatusMsg), SetText) - "Save" |> Binding.cmd RequestSave - "Load" |> Binding.cmd RequestLoad -] + | LoadCanceled -> + { m with + StatusMsg = "Loading canceled" }, + Cmd.none + | SaveFailed ex -> + { m with + StatusMsg = sprintf "Saving failed with exception %s: %s" (ex.GetType().Name) ex.Message }, + Cmd.none + | LoadFailed ex -> + { m with + StatusMsg = sprintf "Loading failed with exception %s: %s" (ex.GetType().Name) ex.Message }, + Cmd.none + + +let bindings () : Binding list = + [ "CurrentTime" |> Binding.oneWay (fun m -> m.CurrentTime) + "Text" |> Binding.twoWay ((fun m -> m.Text), SetText) + "StatusMsg" |> Binding.twoWay ((fun m -> m.StatusMsg), SetText) + "Save" |> Binding.cmd RequestSave + "Load" |> Binding.cmd RequestLoad ] let designVm = ViewModel.designInstance (init () |> fst) (bindings ()) @@ -91,9 +110,7 @@ let subscriptions (model: Model) : Sub = timer.Start() disp - [ - [ nameof timerTickSub ], timerTickSub - ] + [ [ nameof timerTickSub ], timerTickSub ] let main window = @@ -109,4 +126,4 @@ let main window = WpfProgram.mkProgram init update bindings |> WpfProgram.withSubscription subscriptions |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/FileDialogsCmdMsg.Core/Program.fs b/src/Samples/FileDialogsCmdMsg.Core/Program.fs index 8f19a5ae..9af1ea69 100644 --- a/src/Samples/FileDialogsCmdMsg.Core/Program.fs +++ b/src/Samples/FileDialogsCmdMsg.Core/Program.fs @@ -43,15 +43,31 @@ module Core = let update msg m = match msg with | SetTime t -> { m with CurrentTime = t }, [] - | SetText s -> { m with Text = s}, [] - | RequestSave -> m, [Save m.Text] - | RequestLoad -> m, [Load] - | SaveSuccess -> { m with StatusMsg = sprintf "Successfully saved at %O" DateTimeOffset.Now }, [] - | LoadSuccess s -> { m with Text = s; StatusMsg = sprintf "Successfully loaded at %O" DateTimeOffset.Now }, [] + | SetText s -> { m with Text = s }, [] + | RequestSave -> m, [ Save m.Text ] + | RequestLoad -> m, [ Load ] + | SaveSuccess -> + { m with + StatusMsg = sprintf "Successfully saved at %O" DateTimeOffset.Now }, + [] + | LoadSuccess s -> + { m with + Text = s + StatusMsg = sprintf "Successfully loaded at %O" DateTimeOffset.Now }, + [] | SaveCanceled -> { m with StatusMsg = "Saving canceled" }, [] - | LoadCanceled -> { m with StatusMsg = "Loading canceled" }, [] - | SaveFailed ex -> { m with StatusMsg = sprintf "Saving failed with exception %s: %s" (ex.GetType().Name) ex.Message }, [] - | LoadFailed ex -> { m with StatusMsg = sprintf "Loading failed with exception %s: %s" (ex.GetType().Name) ex.Message }, [] + | LoadCanceled -> + { m with + StatusMsg = "Loading canceled" }, + [] + | SaveFailed ex -> + { m with + StatusMsg = sprintf "Saving failed with exception %s: %s" (ex.GetType().Name) ex.Message }, + [] + | LoadFailed ex -> + { m with + StatusMsg = sprintf "Loading failed with exception %s: %s" (ex.GetType().Name) ex.Message }, + [] @@ -61,41 +77,45 @@ module Platform = open Core - let bindings () : Binding list = [ - "CurrentTime" |> Binding.oneWay (fun m -> m.CurrentTime) - "Text" |> Binding.twoWay ((fun m -> m.Text), SetText) - "StatusMsg" |> Binding.twoWay ((fun m -> m.StatusMsg), SetText) - "Save" |> Binding.cmd RequestSave - "Load" |> Binding.cmd RequestLoad - ] + let bindings () : Binding list = + [ "CurrentTime" |> Binding.oneWay (fun m -> m.CurrentTime) + "Text" |> Binding.twoWay ((fun m -> m.Text), SetText) + "StatusMsg" |> Binding.twoWay ((fun m -> m.StatusMsg), SetText) + "Save" |> Binding.cmd RequestSave + "Load" |> Binding.cmd RequestLoad ] let save text = async { - let dlg = Microsoft.Win32.SaveFileDialog () + let dlg = Microsoft.Win32.SaveFileDialog() dlg.Filter <- "Text file (*.txt)|*.txt|Markdown file (*.md)|*.md" - let result = dlg.ShowDialog () + let result = dlg.ShowDialog() + if result.HasValue && result.Value then do! File.WriteAllTextAsync(dlg.FileName, text) |> Async.AwaitTask return SaveSuccess - else return SaveCanceled + else + return SaveCanceled } let load () = async { - let dlg = Microsoft.Win32.OpenFileDialog () + let dlg = Microsoft.Win32.OpenFileDialog() dlg.Filter <- "Text file (*.txt)|*.txt|Markdown file (*.md)|*.md" dlg.DefaultExt <- "txt" - let result = dlg.ShowDialog () + let result = dlg.ShowDialog() + if result.HasValue && result.Value then let! contents = File.ReadAllTextAsync(dlg.FileName) |> Async.AwaitTask return LoadSuccess contents - else return LoadCanceled + else + return LoadCanceled } - let toCmd = function + let toCmd = + function | Save text -> Cmd.OfAsync.either save text id SaveFailed | Load -> Cmd.OfAsync.either load () id LoadFailed @@ -108,15 +128,13 @@ open Platform let designVm = ViewModel.designInstance (init () |> fst) (bindings ()) let subscriptions (_model: Model) : Sub = - let timerTickSub (dispatch: Msg -> unit): IDisposable = + let timerTickSub (dispatch: Msg -> unit) : IDisposable = let timer = new Timers.Timer(1000.) let disp = timer.Elapsed.Subscribe(fun _ -> dispatch (SetTime DateTimeOffset.Now)) timer.Start() disp - [ - [ nameof timerTickSub ], timerTickSub - ] + [ [ nameof timerTickSub ], timerTickSub ] let main window = let logger = @@ -130,4 +148,4 @@ let main window = WpfProgram.mkProgramWithCmdMsg init update bindings toCmd |> WpfProgram.withSubscription subscriptions |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/Multiselect.Core/Program.fs b/src/Samples/Multiselect.Core/Program.fs index 4aa7581d..16dcfea5 100644 --- a/src/Samples/Multiselect.Core/Program.fs +++ b/src/Samples/Multiselect.Core/Program.fs @@ -10,11 +10,15 @@ type Entity = Name: string IsSelected: bool } -type Model = - { Entities: Entity list } +type Model = { Entities: Entity list } let init () = - { Entities = [0 .. 10] |> List.map (fun i -> { Id = i; Name = sprintf "Entity %i" i; IsSelected = i < 5 }) } + { Entities = + [ 0..10 ] + |> List.map (fun i -> + { Id = i + Name = sprintf "Entity %i" i + IsSelected = i < 5 }) } type Msg = | SetIsSelected of int * bool @@ -22,24 +26,38 @@ type Msg = let update msg m = match msg with - | SetIsSelected (entityId, isSelected) -> { m with Entities = m.Entities |> List.map (fun e -> if e.Id = entityId then { e with IsSelected = isSelected } else e) } - | DeselectAll -> { m with Entities = m.Entities |> List.map (fun e -> { e with IsSelected = false }) } - -let bindings () : Binding list = [ - "SelectRandom" |> Binding.cmd - (fun m -> m.Entities.Item(Random().Next(m.Entities.Length)).Id |> (fun id -> SetIsSelected (id, true))) - - "Deselect" |> Binding.cmd DeselectAll - - "Entities" |> Binding.subModelSeq - ( fun m -> m.Entities - , fun e -> e.Id - , fun () -> [ - "Name" |> Binding.oneWay (fun (_, e) -> e.Name) - "IsSelected" |> Binding.twoWay ((fun (_, e) -> e.IsSelected), (fun isSelected (_, e) -> SetIsSelected (e.Id, isSelected))) - "SelectedLabel" |> Binding.oneWay (fun (_, e) -> if e.IsSelected then " - SELECTED" else "") - ] ) -] + | SetIsSelected(entityId, isSelected) -> + { m with + Entities = + m.Entities + |> List.map (fun e -> + if e.Id = entityId then + { e with IsSelected = isSelected } + else + e) } + | DeselectAll -> + { m with + Entities = m.Entities |> List.map (fun e -> { e with IsSelected = false }) } + +let bindings () : Binding list = + [ "SelectRandom" + |> Binding.cmd (fun m -> + m.Entities.Item(Random().Next(m.Entities.Length)).Id + |> (fun id -> SetIsSelected(id, true))) + + "Deselect" |> Binding.cmd DeselectAll + + "Entities" + |> Binding.subModelSeq ( + fun m -> m.Entities + , fun e -> e.Id + , fun () -> + [ "Name" |> Binding.oneWay (fun (_, e) -> e.Name) + "IsSelected" + |> Binding.twoWay ((fun (_, e) -> e.IsSelected), (fun isSelected (_, e) -> SetIsSelected(e.Id, isSelected))) + "SelectedLabel" + |> Binding.oneWay (fun (_, e) -> if e.IsSelected then " - SELECTED" else "") ] + ) ] let designVm = ViewModel.designInstance (init ()) (bindings ()) diff --git a/src/Samples/NewWindow.Core/App.fs b/src/Samples/NewWindow.Core/App.fs index 2a2c5c65..5824bf41 100644 --- a/src/Samples/NewWindow.Core/App.fs +++ b/src/Samples/NewWindow.Core/App.fs @@ -27,46 +27,54 @@ module App = let get m = m.Window1 let set v m = { m with Window1 = v } let map = map get set + module Window2 = let get m = m.Window2 let set v m = { m with Window2 = v } let map = map get set - let mapOutMsg = function + + let mapOutMsg = + function | Window2OutMsg.Close -> Window2Close + let mapInOutMsg = InOut.cata Window2Msg mapOutMsg let init = { Window1 = WindowState.Closed Window2 = None } - let update = function + let update = + function | Window1Show -> "" |> WindowState.toVisible |> Window1.map - | Window1Hide -> "" |> WindowState.toHidden |> Window1.map + | Window1Hide -> "" |> WindowState.toHidden |> Window1.map | Window1Close -> WindowState.Closed |> Window1.set | Window1SetInput s -> s |> WindowState.set |> Window1.map | Window2Show -> Window2.init |> Some |> Window2.set | Window2Close -> None |> Window2.set | Window2Msg msg -> msg |> Window2.update |> Option.map |> Window2.map - let bindings (createWindow1: unit -> #Window) (createWindow2: unit -> #Window) () = [ - "Window1Show" |> Binding.cmd Window1Show - "Window1Hide" |> Binding.cmd Window1Hide - "Window1Close" |> Binding.cmd Window1Close - "Window2Show" |> Binding.cmd Window2Show - "Window1" |> Binding.subModelWin( - (fun m -> m.Window1), - snd, - id, - Window1.bindings >> Bindings.mapMsg Window1SetInput, - createWindow1) - "Window2" |> Binding.subModelWin( - Window2.get >> WindowState.ofOption, - snd, - Window2.mapInOutMsg, - Window2.bindings, - createWindow2, - isModal = true) - ] + let bindings (createWindow1: unit -> #Window) (createWindow2: unit -> #Window) () = + [ "Window1Show" |> Binding.cmd Window1Show + "Window1Hide" |> Binding.cmd Window1Hide + "Window1Close" |> Binding.cmd Window1Close + "Window2Show" |> Binding.cmd Window2Show + "Window1" + |> Binding.subModelWin ( + (fun m -> m.Window1), + snd, + id, + Window1.bindings >> Bindings.mapMsg Window1SetInput, + createWindow1 + ) + "Window2" + |> Binding.subModelWin ( + Window2.get >> WindowState.ofOption, + snd, + Window2.mapInOutMsg, + Window2.bindings, + createWindow2, + isModal = true + ) ] let private fail _ = failwith "never called" let designVm = ViewModel.designInstance App.init (App.bindings fail fail ()) \ No newline at end of file diff --git a/src/Samples/NewWindow.Core/AutoOpen.fs b/src/Samples/NewWindow.Core/AutoOpen.fs index e1054f12..8cd23a27 100644 --- a/src/Samples/NewWindow.Core/AutoOpen.fs +++ b/src/Samples/NewWindow.Core/AutoOpen.fs @@ -4,15 +4,16 @@ module AutoOpen let flip f b a = f a b -let map get set f a = - a |> get |> f |> flip set a +let map get set f a = a |> get |> f |> flip set a [] module Bool = open System.Windows - let toVisibilityCollapsed = function - | true -> Visibility.Visible + + let toVisibilityCollapsed = + function + | true -> Visibility.Visible | false -> Visibility.Collapsed @@ -27,6 +28,7 @@ module InOutModule = [] module InOut = - let cata f g = function - | InOut.In msg -> msg |> f - | InOut.Out msg -> msg |> g + let cata f g = + function + | InOut.In msg -> msg |> f + | InOut.Out msg -> msg |> g \ No newline at end of file diff --git a/src/Samples/NewWindow.Core/Program.fs b/src/Samples/NewWindow.Core/Program.fs index 949342f2..132302d9 100644 --- a/src/Samples/NewWindow.Core/Program.fs +++ b/src/Samples/NewWindow.Core/Program.fs @@ -19,7 +19,9 @@ let main mainWindow (createWindow1: Func<#Window>) (createWindow2: Func<#Window> .MinimumLevel.Override("Elmish.WPF.Performance", Events.LogEventLevel.Verbose) .WriteTo.Console() .CreateLogger() + let createWindow1 () = createWindow1.Invoke() + let createWindow2 () = let window = createWindow2.Invoke() window.Owner <- mainWindow @@ -27,6 +29,7 @@ let main mainWindow (createWindow1: Func<#Window>) (createWindow2: Func<#Window> let init () = App.init let bindings = App.bindings createWindow1 createWindow2 + WpfProgram.mkSimple init App.update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) |> WpfProgram.startElmishLoop mainWindow \ No newline at end of file diff --git a/src/Samples/NewWindow.Core/Window1.fs b/src/Samples/NewWindow.Core/Window1.fs index 9637b7b1..2b49c918 100644 --- a/src/Samples/NewWindow.Core/Window1.fs +++ b/src/Samples/NewWindow.Core/Window1.fs @@ -6,8 +6,6 @@ open Elmish.WPF module Window1 = let init = "" - let bindings () = [ - "Input" |> Binding.twoWay (id, id) - ] + let bindings () = [ "Input" |> Binding.twoWay (id, id) ] let designVm = ViewModel.designInstance Window1.init (Window1.bindings ()) \ No newline at end of file diff --git a/src/Samples/NewWindow.Core/Window2.fs b/src/Samples/NewWindow.Core/Window2.fs index dff422f6..66dcc16e 100644 --- a/src/Samples/NewWindow.Core/Window2.fs +++ b/src/Samples/NewWindow.Core/Window2.fs @@ -22,17 +22,18 @@ type Window2Msg = | Close [] -type Window2OutMsg = - | Close +type Window2OutMsg = | Close module Window2 = module Input = let get m = m.Input let set v m = { m with Input = v } + module IsChecked = let get m = m.IsChecked let set v m = { m with IsChecked = v } + module ConfirmState = let set v m = { m with ConfirmState = v } @@ -41,12 +42,13 @@ module Window2 = IsChecked = false ConfirmState = None } - let update = function + let update = + function | SetInput s -> s |> Input.set | SetChecked b -> b |> IsChecked.set | Submit -> ConfirmState.Submit |> Some |> ConfirmState.set | Cancel -> ConfirmState.Cancel |> Some |> ConfirmState.set - | Close -> ConfirmState.Close |> Some |> ConfirmState.set + | Close -> ConfirmState.Close |> Some |> ConfirmState.set let private confirmStateVisibilityBinding confirmState = fun m -> m.ConfirmState = Some confirmState @@ -54,9 +56,10 @@ module Window2 = |> Binding.oneWay let private confirmStateToMsg confirmState msg m = - if m.ConfirmState = Some confirmState - then InOut.Out Window2OutMsg.Close - else InOut.In msg + if m.ConfirmState = Some confirmState then + InOut.Out Window2OutMsg.Close + else + InOut.In msg let bindings () = let inBindings = @@ -64,12 +67,14 @@ module Window2 = "IsChecked" |> Binding.twoWay (IsChecked.get, SetChecked) "SubmitMsgVisibility" |> confirmStateVisibilityBinding ConfirmState.Submit "CancelMsgVisibility" |> confirmStateVisibilityBinding ConfirmState.Cancel - "CloseMsgVisibility" |> confirmStateVisibilityBinding ConfirmState.Close ] + "CloseMsgVisibility" |> confirmStateVisibilityBinding ConfirmState.Close ] |> Bindings.mapMsg InOut.In + let inOutBindings = [ "Submit" |> Binding.cmd (confirmStateToMsg ConfirmState.Submit Submit) "Cancel" |> Binding.cmd (confirmStateToMsg ConfirmState.Cancel Cancel) - "Close" |> Binding.cmd (confirmStateToMsg ConfirmState.Close Close) ] + "Close" |> Binding.cmd (confirmStateToMsg ConfirmState.Close Close) ] + inBindings @ inOutBindings let designVm = ViewModel.designInstance Window2.init (Window2.bindings ()) \ No newline at end of file diff --git a/src/Samples/OneWaySeq.Core/Program.fs b/src/Samples/OneWaySeq.Core/Program.fs index eba678a1..56f1bbf5 100644 --- a/src/Samples/OneWaySeq.Core/Program.fs +++ b/src/Samples/OneWaySeq.Core/Program.fs @@ -19,15 +19,18 @@ type Msg = let update msg m = match msg with - | AddOneWaySeqNumber -> { m with OneWaySeqNumbers = m.OneWaySeqNumbers.Head + 1 :: m.OneWaySeqNumbers } - | AddOneWayNumber -> { m with OneWayNumbers = m.OneWayNumbers.Head + 1 :: m.OneWayNumbers } - -let bindings () : Binding list = [ - "OneWaySeqNumbers" |> Binding.oneWaySeq((fun m -> m.OneWaySeqNumbers), (=), id) - "OneWayNumbers" |> Binding.oneWay (fun m -> m.OneWayNumbers) - "AddOneWaySeqNumber" |> Binding.cmd AddOneWaySeqNumber - "AddOneWayNumber" |> Binding.cmd AddOneWayNumber -] + | AddOneWaySeqNumber -> + { m with + OneWaySeqNumbers = m.OneWaySeqNumbers.Head + 1 :: m.OneWaySeqNumbers } + | AddOneWayNumber -> + { m with + OneWayNumbers = m.OneWayNumbers.Head + 1 :: m.OneWayNumbers } + +let bindings () : Binding list = + [ "OneWaySeqNumbers" |> Binding.oneWaySeq ((fun m -> m.OneWaySeqNumbers), (=), id) + "OneWayNumbers" |> Binding.oneWay (fun m -> m.OneWayNumbers) + "AddOneWaySeqNumber" |> Binding.cmd AddOneWaySeqNumber + "AddOneWayNumber" |> Binding.cmd AddOneWayNumber ] let designVm = ViewModel.designInstance (init ()) (bindings ()) @@ -43,4 +46,4 @@ let main window = WpfProgram.mkSimple init update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/SingleCounter.Core/Program.fs b/src/Samples/SingleCounter.Core/Program.fs index 3033ae91..cbc01fa5 100644 --- a/src/Samples/SingleCounter.Core/Program.fs +++ b/src/Samples/SingleCounter.Core/Program.fs @@ -4,9 +4,7 @@ open Serilog open Serilog.Extensions.Logging open Elmish.WPF -type Model = - { Count: int - StepSize: int } +type Model = { Count: int; StepSize: int } type Msg = | Increment @@ -14,9 +12,7 @@ type Msg = | SetStepSize of int | Reset -let init = - { Count = 0 - StepSize = 1 } +let init = { Count = 0; StepSize = 1 } let canReset = (<>) init @@ -27,15 +23,12 @@ let update msg m = | SetStepSize x -> { m with StepSize = x } | Reset -> init -let bindings () : Binding list = [ - "CounterValue" |> Binding.oneWay (fun m -> m.Count) - "Increment" |> Binding.cmd Increment - "Decrement" |> Binding.cmd Decrement - "StepSize" |> Binding.twoWay( - (fun m -> float m.StepSize), - int >> SetStepSize) - "Reset" |> Binding.cmdIf(Reset, canReset) -] +let bindings () : Binding list = + [ "CounterValue" |> Binding.oneWay (fun m -> m.Count) + "Increment" |> Binding.cmd Increment + "Decrement" |> Binding.cmd Decrement + "StepSize" |> Binding.twoWay ((fun m -> float m.StepSize), int >> SetStepSize) + "Reset" |> Binding.cmdIf (Reset, canReset) ] let designVm = ViewModel.designInstance init (bindings ()) @@ -51,4 +44,4 @@ let main window = WpfProgram.mkSimple (fun () -> init) update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/Sticky.Core/Program.fs b/src/Samples/Sticky.Core/Program.fs index 5bed469e..dbebbcdc 100644 --- a/src/Samples/Sticky.Core/Program.fs +++ b/src/Samples/Sticky.Core/Program.fs @@ -4,9 +4,7 @@ open Serilog open Serilog.Extensions.Logging open Elmish.WPF -type Model = - { Count: int - StepSize: int } +type Model = { Count: int; StepSize: int } type Msg = | Increment @@ -14,9 +12,7 @@ type Msg = | SetStepSize of int | Reset -let init = - { Count = 0 - StepSize = 1 } +let init = { Count = 0; StepSize = 1 } let canReset = (<>) init @@ -27,18 +23,15 @@ let update msg m = | SetStepSize x -> { m with StepSize = x } | Reset -> init -let bindings () : Binding list = [ - "CounterValue" +let bindings () : Binding list = + [ "CounterValue" |> Binding.oneWay id |> Binding.addSticky (fun v -> v % 2 = 0) |> Binding.mapModel (fun m -> m.Count) - "Increment" |> Binding.cmd Increment - "Decrement" |> Binding.cmd Decrement - "StepSize" |> Binding.twoWay( - (fun m -> float m.StepSize), - int >> SetStepSize) - "Reset" |> Binding.cmdIf(Reset, canReset) -] + "Increment" |> Binding.cmd Increment + "Decrement" |> Binding.cmd Decrement + "StepSize" |> Binding.twoWay ((fun m -> float m.StepSize), int >> SetStepSize) + "Reset" |> Binding.cmdIf (Reset, canReset) ] let designVm = ViewModel.designInstance init (bindings ()) @@ -54,4 +47,4 @@ let main window = WpfProgram.mkSimple (fun () -> init) update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/SubModel.Core/Program.fs b/src/Samples/SubModel.Core/Program.fs index 0529da51..e130be39 100644 --- a/src/Samples/SubModel.Core/Program.fs +++ b/src/Samples/SubModel.Core/Program.fs @@ -8,9 +8,7 @@ open Elmish.WPF module Counter = - type Model = - { Count: int - StepSize: int } + type Model = { Count: int; StepSize: int } type Msg = | Increment @@ -18,9 +16,7 @@ module Counter = | SetStepSize of int | Reset - let init = - { Count = 0 - StepSize = 1 } + let init = { Count = 0; StepSize = 1 } let canReset = (<>) init @@ -31,15 +27,12 @@ module Counter = | SetStepSize x -> { m with StepSize = x } | Reset -> init - let bindings () : Binding list = [ - "CounterValue" |> Binding.oneWay (fun m -> m.Count) - "Increment" |> Binding.cmd Increment - "Decrement" |> Binding.cmd Decrement - "StepSize" |> Binding.twoWay( - (fun m -> float m.StepSize), - int >> SetStepSize) - "Reset" |> Binding.cmdIf(Reset, canReset) - ] + let bindings () : Binding list = + [ "CounterValue" |> Binding.oneWay (fun m -> m.Count) + "Increment" |> Binding.cmd Increment + "Decrement" |> Binding.cmd Decrement + "StepSize" |> Binding.twoWay ((fun m -> float m.StepSize), int >> SetStepSize) + "Reset" |> Binding.cmdIf (Reset, canReset) ] module Clock = @@ -70,13 +63,12 @@ module Clock = | Tick t -> { m with Time = t } | SetTimeType t -> { m with TimeType = t } - let bindings () : Binding list = [ - "Time" |> Binding.oneWay getTime - "IsLocal" |> Binding.oneWay (fun m -> m.TimeType = Local) - "SetLocal" |> Binding.cmd (SetTimeType Local) - "IsUtc" |> Binding.oneWay (fun m -> m.TimeType = Utc) - "SetUtc" |> Binding.cmd (SetTimeType Utc) - ] + let bindings () : Binding list = + [ "Time" |> Binding.oneWay getTime + "IsLocal" |> Binding.oneWay (fun m -> m.TimeType = Local) + "SetLocal" |> Binding.cmd (SetTimeType Local) + "IsUtc" |> Binding.oneWay (fun m -> m.TimeType = Utc) + "SetUtc" |> Binding.cmd (SetTimeType Utc) ] module CounterWithClock = @@ -95,19 +87,22 @@ module CounterWithClock = let update msg m = match msg with - | CounterMsg msg -> { m with Counter = Counter.update msg m.Counter } - | ClockMsg msg -> { m with Clock = Clock.update msg m.Clock } - - let bindings () : Binding list = [ - "Counter" + | CounterMsg msg -> + { m with + Counter = Counter.update msg m.Counter } + | ClockMsg msg -> + { m with + Clock = Clock.update msg m.Clock } + + let bindings () : Binding list = + [ "Counter" |> Binding.SubModel.required Counter.bindings |> Binding.mapModel (fun m -> m.Counter) |> Binding.mapMsg CounterMsg - "Clock" + "Clock" |> Binding.SubModel.required Clock.bindings |> Binding.mapModel (fun m -> m.Clock) - |> Binding.mapMsg ClockMsg - ] + |> Binding.mapMsg ClockMsg ] module App = @@ -127,21 +122,22 @@ module App = let update msg m = match msg with | ClockCounter1Msg msg -> - { m with ClockCounter1 = CounterWithClock.update msg m.ClockCounter1 } + { m with + ClockCounter1 = CounterWithClock.update msg m.ClockCounter1 } | ClockCounter2Msg msg -> - { m with ClockCounter2 = CounterWithClock.update msg m.ClockCounter2 } + { m with + ClockCounter2 = CounterWithClock.update msg m.ClockCounter2 } - let bindings () : Binding list = [ - "ClockCounter1" + let bindings () : Binding list = + [ "ClockCounter1" |> Binding.SubModel.required CounterWithClock.bindings |> Binding.mapModel (fun m -> m.ClockCounter1) |> Binding.mapMsg ClockCounter1Msg - "ClockCounter2" + "ClockCounter2" |> Binding.SubModel.required CounterWithClock.bindings |> Binding.mapModel (fun m -> m.ClockCounter2) - |> Binding.mapMsg ClockCounter2Msg - ] + |> Binding.mapMsg ClockCounter2Msg ] let counterDesignVm = ViewModel.designInstance Counter.init (Counter.bindings ()) @@ -153,20 +149,17 @@ let mainDesignVm = ViewModel.designInstance (App.init ()) (App.bindings ()) let subscriptions (model: App.Model) : Sub = let timerTickSub dispatch = let timer = new System.Timers.Timer(1000.) - let disp = timer.Elapsed.Subscribe(fun _ -> - let clockMsg = - DateTimeOffset.Now - |> Clock.Tick - |> CounterWithClock.ClockMsg - dispatch <| App.ClockCounter1Msg clockMsg - dispatch <| App.ClockCounter2Msg clockMsg - ) + + let disp = + timer.Elapsed.Subscribe(fun _ -> + let clockMsg = DateTimeOffset.Now |> Clock.Tick |> CounterWithClock.ClockMsg + dispatch <| App.ClockCounter1Msg clockMsg + dispatch <| App.ClockCounter2Msg clockMsg) + timer.Start() disp - [ - [ nameof timerTickSub ], timerTickSub - ] + [ [ nameof timerTickSub ], timerTickSub ] let main window = @@ -181,4 +174,4 @@ let main window = WpfProgram.mkSimple App.init App.update App.bindings |> WpfProgram.withSubscription subscriptions |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/SubModelOpt.Core/Program.fs b/src/Samples/SubModelOpt.Core/Program.fs index 3a8dfe50..27c5060d 100644 --- a/src/Samples/SubModelOpt.Core/Program.fs +++ b/src/Samples/SubModelOpt.Core/Program.fs @@ -7,53 +7,45 @@ open Elmish.WPF module Form1 = - type Model = - { Text: string } + type Model = { Text: string } type Msg = | SetText of string | Submit - let init = - { Text = "" } + let init = { Text = "" } let update msg m = match msg with | SetText s -> { m with Text = s } - | Submit -> m // handled by parent + | Submit -> m // handled by parent - let bindings () : Binding list = [ - "Text" |> Binding.twoWay ((fun m -> m.Text), SetText) - "Submit" |> Binding.cmd Submit - ] + let bindings () : Binding list = + [ "Text" |> Binding.twoWay ((fun m -> m.Text), SetText) + "Submit" |> Binding.cmd Submit ] module Form2 = - type Model = - { Text1: string - Text2: string } + type Model = { Text1: string; Text2: string } type Msg = | SetText1 of string | SetText2 of string | Submit - let init = - { Text1 = "" - Text2 = "" } + let init = { Text1 = ""; Text2 = "" } let update msg m = match msg with | SetText1 s -> { m with Text1 = s } | SetText2 s -> { m with Text2 = s } - | Submit -> m // handled by parent + | Submit -> m // handled by parent - let bindings () : Binding list = [ - "Text1" |> Binding.twoWay ((fun m -> m.Text1), SetText1) - "Text2" |> Binding.twoWay ((fun m -> m.Text2), SetText2) - "Submit" |> Binding.cmd Submit - ] + let bindings () : Binding list = + [ "Text1" |> Binding.twoWay ((fun m -> m.Text1), SetText1) + "Text2" |> Binding.twoWay ((fun m -> m.Text2), SetText2) + "Submit" |> Binding.cmd Submit ] module App = @@ -62,11 +54,9 @@ module App = | Form1 of Form1.Model | Form2 of Form2.Model - type Model = - { Dialog: Dialog option } + type Model = { Dialog: Dialog option } - let init () = - { Dialog = None } + let init () = { Dialog = None } type Msg = | ShowForm1 @@ -76,42 +66,61 @@ module App = let update msg m = match msg with - | ShowForm1 -> { m with Dialog = Some <| Form1 Form1.init } - | ShowForm2 -> { m with Dialog = Some <| Form2 Form2.init } + | ShowForm1 -> + { m with + Dialog = Some <| Form1 Form1.init } + | ShowForm2 -> + { m with + Dialog = Some <| Form2 Form2.init } | Form1Msg Form1.Submit -> { m with Dialog = None } | Form1Msg msg' -> - match m.Dialog with - | Some (Form1 m') -> { m with Dialog = Form1.update msg' m' |> Form1 |> Some } - | _ -> m + match m.Dialog with + | Some(Form1 m') -> + { m with + Dialog = Form1.update msg' m' |> Form1 |> Some } + | _ -> m | Form2Msg Form2.Submit -> { m with Dialog = None } | Form2Msg msg' -> - match m.Dialog with - | Some (Form2 m') -> { m with Dialog = Form2.update msg' m' |> Form2 |> Some } - | _ -> m + match m.Dialog with + | Some(Form2 m') -> + { m with + Dialog = Form2.update msg' m' |> Form2 |> Some } + | _ -> m - let bindings () : Binding list = [ - "ShowForm1" |> Binding.cmd ShowForm1 + let bindings () : Binding list = + [ "ShowForm1" |> Binding.cmd ShowForm1 - "ShowForm2" |> Binding.cmd ShowForm2 + "ShowForm2" |> Binding.cmd ShowForm2 - "DialogVisible" |> Binding.oneWay (fun m -> m.Dialog.IsSome) + "DialogVisible" |> Binding.oneWay (fun m -> m.Dialog.IsSome) - "Form1Visible" |> Binding.oneWay - (fun m -> match m.Dialog with Some (Form1 _) -> true | _ -> false) + "Form1Visible" + |> Binding.oneWay (fun m -> + match m.Dialog with + | Some(Form1 _) -> true + | _ -> false) - "Form2Visible" |> Binding.oneWay - (fun m -> match m.Dialog with Some (Form2 _) -> true | _ -> false) + "Form2Visible" + |> Binding.oneWay (fun m -> + match m.Dialog with + | Some(Form2 _) -> true + | _ -> false) - "Form1" + "Form1" |> Binding.SubModel.opt Form1.bindings - |> Binding.mapModel (fun m -> match m.Dialog with Some (Form1 m') -> Some m' | _ -> None) + |> Binding.mapModel (fun m -> + match m.Dialog with + | Some(Form1 m') -> Some m' + | _ -> None) |> Binding.mapMsg Form1Msg - "Form2" + "Form2" |> Binding.SubModel.opt Form2.bindings - |> Binding.mapModel (fun m -> match m.Dialog with Some (Form2 m') -> Some m' | _ -> None) - |> Binding.mapMsg Form2Msg - ] + |> Binding.mapModel (fun m -> + match m.Dialog with + | Some(Form2 m') -> Some m' + | _ -> None) + |> Binding.mapMsg Form2Msg ] let form1DesignVm = ViewModel.designInstance Form1.init (Form1.bindings ()) @@ -131,4 +140,4 @@ let main window = WpfProgram.mkSimple App.init App.update App.bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/SubModelSelectedItem.Core/Program.fs b/src/Samples/SubModelSelectedItem.Core/Program.fs index c8f970af..bbb271ab 100644 --- a/src/Samples/SubModelSelectedItem.Core/Program.fs +++ b/src/Samples/SubModelSelectedItem.Core/Program.fs @@ -5,41 +5,40 @@ open Serilog open Serilog.Extensions.Logging open Elmish.WPF -type Entity = - { Id: int - Name: string } +type Entity = { Id: int; Name: string } type Model = { Entities: Entity list Selected: int option } let init () = - { Entities = [0 .. 10] |> List.map (fun i -> { Id = i; Name = sprintf "Entity %i" i}) + { Entities = [ 0..10 ] |> List.map (fun i -> { Id = i; Name = sprintf "Entity %i" i }) Selected = Some 4 } -type Msg = - | Select of int option +type Msg = Select of int option let update msg m = match msg with | Select entityId -> { m with Selected = entityId } -let bindings () : Binding list = [ - "SelectRandom" |> Binding.cmd - (fun m -> m.Entities.Item(Random().Next(m.Entities.Length)).Id |> Some |> Select) +let bindings () : Binding list = + [ "SelectRandom" + |> Binding.cmd (fun m -> m.Entities.Item(Random().Next(m.Entities.Length)).Id |> Some |> Select) - "Deselect" |> Binding.cmd(Select None) + "Deselect" |> Binding.cmd (Select None) - "Entities" |> Binding.subModelSeq( - (fun m -> m.Entities), - (fun e -> e.Id), - (fun () -> [ - "Name" |> Binding.oneWay (fun (_, e) -> e.Name) - "SelectedLabel" |> Binding.oneWay (fun (m, e) -> if m.Selected = Some e.Id then " - SELECTED" else "") - ])) + "Entities" + |> Binding.subModelSeq ( + (fun m -> m.Entities), + (fun e -> e.Id), + (fun () -> + [ "Name" |> Binding.oneWay (fun (_, e) -> e.Name) + "SelectedLabel" + |> Binding.oneWay (fun (m, e) -> if m.Selected = Some e.Id then " - SELECTED" else "") ]) + ) - "SelectedEntity" |> Binding.subModelSelectedItem("Entities", (fun m -> m.Selected), Select) -] + "SelectedEntity" + |> Binding.subModelSelectedItem ("Entities", (fun m -> m.Selected), Select) ] let designVm = ViewModel.designInstance (init ()) (bindings ()) @@ -54,4 +53,4 @@ let main window = WpfProgram.mkSimple init update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/SubModelSeq.Core/Program.fs b/src/Samples/SubModelSeq.Core/Program.fs index 1f0a6f5c..5216226d 100644 --- a/src/Samples/SubModelSeq.Core/Program.fs +++ b/src/Samples/SubModelSeq.Core/Program.fs @@ -25,25 +25,21 @@ module FuncOption = let inputIfNone f a = a |> f |> Option.defaultValue a - let map (f: 'b -> 'c) (mb: 'a -> 'b option) = - mb >> Option.map f + let map (f: 'b -> 'c) (mb: 'a -> 'b option) = mb >> Option.map f - let bind (f: 'b -> 'a -> 'c) (mb: 'a -> 'b option) a = - mb a |> Option.bind (fun b -> Some(f b a)) + let bind (f: 'b -> 'a -> 'c) (mb: 'a -> 'b option) a = mb a |> Option.bind (fun b -> Some(f b a)) -let map get set f a = - a |> get |> f |> Func.flip set a +let map get set f a = a |> get |> f |> Func.flip set a module List = let swap i j = - List.permute - (function - | a when a = i -> j - | a when a = j -> i - | a -> a) + List.permute (function + | a when a = i -> j + | a when a = j -> i + | a -> a) let swapWithNext i = swap i (i + 1) let swapWithPrev i = swap i (i - 1) @@ -54,28 +50,27 @@ module List = let rec mapFirstRec reverseFront back = match back with | [] -> - (* + (* * Conceptually, the correct value to return is * reverseFront |> List.rev * but this is the same as * input * so returning that instead. *) - input + input | a :: ma -> - if p a then - (reverseFront |> List.rev) @ (f a :: ma) - else - mapFirstRec (a :: reverseFront) ma + if p a then + (reverseFront |> List.rev) @ (f a :: ma) + else + mapFirstRec (a :: reverseFront) ma + mapFirstRec [] input [] module Identifiable = - type Identifiable<'a> = - { Id: Guid - Value: 'a } + type Identifiable<'a> = { Id: Guid; Value: 'a } module Identifiable = @@ -88,9 +83,7 @@ module Identifiable = [] module Counter = - type Counter = - { Count: int - StepSize: int } + type Counter = { Count: int; StepSize: int } type CounterMsg = | Increment @@ -100,9 +93,7 @@ module Counter = module Counter = - let init = - { Count = 0 - StepSize = 1 } + let init = { Count = 0; StepSize = 1 } let canReset = (<>) init @@ -113,15 +104,12 @@ module Counter = | SetStepSize x -> { m with StepSize = x } | Reset -> init - let bindings () : Binding list = [ - "CounterValue" |> Binding.oneWay (fun m -> m.Count) - "Increment" |> Binding.cmd Increment - "Decrement" |> Binding.cmd Decrement - "StepSize" |> Binding.twoWay( - (fun m -> float m.StepSize), - int >> SetStepSize) - "Reset" |> Binding.cmdIf(Reset, canReset) - ] + let bindings () : Binding list = + [ "CounterValue" |> Binding.oneWay (fun m -> m.Count) + "Increment" |> Binding.cmd Increment + "Decrement" |> Binding.cmd Decrement + "StepSize" |> Binding.twoWay ((fun m -> float m.StepSize), int >> SetStepSize) + "Reset" |> Binding.cmdIf (Reset, canReset) ] [] @@ -137,9 +125,7 @@ module RoseTree = module RoseTree = - let create data children = - { Data = data - Children = children } + let create data children = { Data = data; Children = children } let createLeaf a = create a [] let getData t = t.Data @@ -154,9 +140,11 @@ module RoseTree = let addChildData a = a |> createLeaf |> addSubtree let update p (f: 'msg -> RoseTree<'model> -> RoseTree<'model>) = - let rec updateRec = function - | BranchMsg (a, msg) -> msg |> updateRec |> List.mapFirst (p a) |> mapChildren + let rec updateRec = + function + | BranchMsg(a, msg) -> msg |> updateRec |> List.mapFirst (p a) |> mapChildren | LeafMsg msg -> msg |> f + updateRec @@ -192,20 +180,16 @@ module App = let mapDummyRoot f = f |> map getDummyRoot setDummyRoot let createNewIdentifiableCounter () = - { Id = Guid.NewGuid () + { Id = Guid.NewGuid() Value = Counter.init } - let createNewLeaf () = - createNewIdentifiableCounter () - |> RoseTree.createLeaf + let createNewLeaf () = createNewIdentifiableCounter () |> RoseTree.createLeaf let init () = let dummyRootData = createNewIdentifiableCounter () // Placeholder data to satisfy type system. User never sees this. + { SomeGlobalState = false - DummyRoot = - createNewLeaf () - |> List.singleton - |> RoseTree.create dummyRootData } + DummyRoot = createNewLeaf () |> List.singleton |> RoseTree.create dummyRootData } let hasId id t = t.Data.Id = id @@ -216,18 +200,21 @@ module App = |> FuncOption.bind swap |> FuncOption.inputIfNone - let updateSubtree = function + let updateSubtree = + function | CounterMsg msg -> msg |> Counter.update |> Identifiable.map |> RoseTree.mapData | AddChild -> createNewLeaf () |> List.cons |> RoseTree.mapChildren | Remove cId -> cId |> hasId >> not |> List.filter |> RoseTree.mapChildren | MoveUp cId -> cId |> swapCounters List.swapWithPrev |> RoseTree.mapChildren | MoveDown cId -> cId |> swapCounters List.swapWithNext |> RoseTree.mapChildren - let update = function + let update = + function | ToggleGlobalState -> mapSomeGlobalState not | SubtreeMsg msg -> msg |> RoseTree.update hasId updateSubtree |> mapDummyRoot - let mapOutMsg = function + let mapOutMsg = + function | OutRemove -> Remove | OutMoveUp -> MoveUp | OutMoveDown -> MoveDown @@ -237,53 +224,51 @@ module Bindings = open App - type SelfWithParent<'a> = - { Self: 'a - Parent: 'a } + type SelfWithParent<'a> = { Self: 'a; Parent: 'a } let moveUpMsg (_, { Parent = p; Self = s }) = match p.Children |> List.tryHead with - | Some c when c.Data.Id <> s.Data.Id -> - OutMoveUp |> Some + | Some c when c.Data.Id <> s.Data.Id -> OutMoveUp |> Some | _ -> None let moveDownMsg (_, { Parent = p; Self = s }) = match p.Children |> List.tryLast with - | Some c when c.Data.Id <> s.Data.Id -> - OutMoveDown |> Some + | Some c when c.Data.Id <> s.Data.Id -> OutMoveDown |> Some | _ -> None - let rec subtreeBindings () : Binding>>, InOutMsg, SubtreeOutMsg>> list = + let rec subtreeBindings + () + : Binding>>, InOutMsg, SubtreeOutMsg>> list = let counterBindings = Counter.bindings () |> Bindings.mapModel (fun (_, { Self = s }) -> s.Data.Value) |> Bindings.mapMsg (CounterMsg >> LeafMsg) let inMsgBindings = - [ "CounterIdText" |> Binding.oneWay(fun (_, { Self = s }) -> s.Data.Id) - "AddChild" |> Binding.cmd(AddChild |> LeafMsg) - "GlobalState" |> Binding.oneWay(fun (m, _) -> m.SomeGlobalState) + [ "CounterIdText" |> Binding.oneWay (fun (_, { Self = s }) -> s.Data.Id) + "AddChild" |> Binding.cmd (AddChild |> LeafMsg) + "GlobalState" |> Binding.oneWay (fun (m, _) -> m.SomeGlobalState) "ChildCounters" - |> Binding.subModelSeq (subtreeBindings, (fun (_, { Self = c }) -> c.Data.Id)) - |> Binding.mapModel (fun (m, { Self = p }) -> p.Children |> Seq.map (fun c -> m, { Self = c; Parent = p })) - |> Binding.mapMsg (fun (cId, inOutMsg) -> - match inOutMsg with - | InMsg msg -> (cId, msg) |> BranchMsg - | OutMsg msg -> cId |> mapOutMsg msg |> LeafMsg) - ] @ counterBindings + |> Binding.subModelSeq (subtreeBindings, (fun (_, { Self = c }) -> c.Data.Id)) + |> Binding.mapModel (fun (m, { Self = p }) -> p.Children |> Seq.map (fun c -> m, { Self = c; Parent = p })) + |> Binding.mapMsg (fun (cId, inOutMsg) -> + match inOutMsg with + | InMsg msg -> (cId, msg) |> BranchMsg + | OutMsg msg -> cId |> mapOutMsg msg |> LeafMsg) ] + @ counterBindings |> Bindings.mapMsg InMsg let outMsgBindings = [ "Remove" |> Binding.cmd OutRemove "MoveUp" |> Binding.cmdIf moveUpMsg - "MoveDown" |> Binding.cmdIf moveDownMsg - ] |> Bindings.mapMsg OutMsg + "MoveDown" |> Binding.cmdIf moveDownMsg ] + |> Bindings.mapMsg OutMsg outMsgBindings @ inMsgBindings - let rootBindings () : Binding list = [ - "Counters" + let rootBindings () : Binding list = + [ "Counters" |> Binding.subModelSeq (subtreeBindings, (fun (_, { Self = c }) -> c.Data.Id)) |> Binding.mapModel (fun m -> m.DummyRoot.Children |> Seq.map (fun c -> m, { Self = c; Parent = m.DummyRoot })) |> Binding.mapMsg (fun (cId, inOutMsg) -> @@ -292,10 +277,9 @@ module Bindings = | OutMsg msg -> cId |> mapOutMsg msg |> LeafMsg |> SubtreeMsg) - "ToggleGlobalState" |> Binding.cmd ToggleGlobalState + "ToggleGlobalState" |> Binding.cmd ToggleGlobalState - "AddCounter" |> Binding.cmd (AddChild |> LeafMsg |> SubtreeMsg) - ] + "AddCounter" |> Binding.cmd (AddChild |> LeafMsg |> SubtreeMsg) ] let counterDesignVm = ViewModel.designInstance Counter.init (Counter.bindings ()) let mainDesignVm = ViewModel.designInstance (App.init ()) (Bindings.rootBindings ()) @@ -311,4 +295,4 @@ let main window = WpfProgram.mkSimple App.init App.update Bindings.rootBindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/SubModelStatic.Core/Program.fs b/src/Samples/SubModelStatic.Core/Program.fs index 70f29573..7d6dec40 100644 --- a/src/Samples/SubModelStatic.Core/Program.fs +++ b/src/Samples/SubModelStatic.Core/Program.fs @@ -1,4 +1,5 @@ namespace Elmish.WPF.Samples.SubModelStatic + #nowarn "44" open System @@ -9,9 +10,7 @@ open Elmish.WPF module Counter = - type Model = - { Count: int - StepSize: int } + type Model = { Count: int; StepSize: int } type Msg = | Increment @@ -19,9 +18,7 @@ module Counter = | SetStepSize of int | Reset - let init = - { Count = 0 - StepSize = 1 } + let init = { Count = 0; StepSize = 1 } let canReset = (<>) init @@ -32,18 +29,25 @@ module Counter = | SetStepSize x -> { m with StepSize = x } | Reset -> init -type [] CounterViewModel (args) = +[] +type CounterViewModel(args) = inherit ViewModelBase(args) new() = CounterViewModel(Counter.init |> ViewModelArgs.simple) member _.StepSize - with get() = base.Get() (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel (fun m -> m.StepSize)) - and set(v) = base.Set(v) (Binding.OneWayToSourceT.id >> Binding.mapMsg Counter.Msg.SetStepSize) - member _.CounterValue = base.Get() (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel (fun m -> m.Count)) - member _.Increment = base.Get() (Binding.CmdT.setAlways Counter.Increment) - member _.Decrement = base.Get() (Binding.CmdT.setAlways Counter.Decrement) - member _.Reset = base.Get() (Binding.CmdT.set Counter.canReset Counter.Reset) + with get () = + base.Get + () + (Binding.OneWayT.id + >> Binding.addLazy (=) + >> Binding.mapModel (fun m -> m.StepSize)) + and set (v) = base.Set (v) (Binding.OneWayToSourceT.id >> Binding.mapMsg Counter.Msg.SetStepSize) + + member _.CounterValue = base.Get () (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel (fun m -> m.Count)) + member _.Increment = base.Get () (Binding.CmdT.setAlways Counter.Increment) + member _.Decrement = base.Get () (Binding.CmdT.setAlways Counter.Decrement) + member _.Reset = base.Get () (Binding.CmdT.set Counter.canReset Counter.Reset) module Clock = @@ -74,16 +78,31 @@ module Clock = | Tick t -> { m with Time = t } | SetTimeType t -> { m with TimeType = t } -type [] ClockViewModel (args) = +[] +type ClockViewModel(args) = inherit ViewModelBase(args) - + new() = ClockViewModel(Clock.init () |> ViewModelArgs.simple) - member _.Time = base.Get() (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel Clock.getTime) - member _.IsLocal = base.Get() (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel (fun m -> m.TimeType = Clock.Local)) - member _.SetLocal = base.Get() (Binding.CmdT.setAlways (Clock.SetTimeType Clock.Local)) - member _.IsUtc = base.Get() (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel (fun m -> m.TimeType = Clock.Utc)) - member _.SetUtc = base.Get() (Binding.CmdT.setAlways (Clock.SetTimeType Clock.Utc)) + member _.Time = base.Get () (Binding.OneWayT.id >> Binding.addLazy (=) >> Binding.mapModel Clock.getTime) + + member _.IsLocal = + base.Get + () + (Binding.OneWayT.id + >> Binding.addLazy (=) + >> Binding.mapModel (fun m -> m.TimeType = Clock.Local)) + + member _.SetLocal = base.Get () (Binding.CmdT.setAlways (Clock.SetTimeType Clock.Local)) + + member _.IsUtc = + base.Get + () + (Binding.OneWayT.id + >> Binding.addLazy (=) + >> Binding.mapModel (fun m -> m.TimeType = Clock.Utc)) + + member _.SetUtc = base.Get () (Binding.CmdT.setAlways (Clock.SetTimeType Clock.Utc)) module CounterWithClock = @@ -95,6 +114,7 @@ module CounterWithClock = module ModelM = module Counter = let get m = m.Counter + module Clock = let get m = m.Clock @@ -108,16 +128,32 @@ module CounterWithClock = let update msg m = match msg with - | CounterMsg msg -> { m with Counter = Counter.update msg m.Counter } - | ClockMsg msg -> { m with Clock = Clock.update msg m.Clock } - -type [] CounterWithClockViewModel (args) = + | CounterMsg msg -> + { m with + Counter = Counter.update msg m.Counter } + | ClockMsg msg -> + { m with + Clock = Clock.update msg m.Clock } + +[] +type CounterWithClockViewModel(args) = inherit ViewModelBase(args) - + new() = CounterWithClockViewModel(CounterWithClock.init () |> ViewModelArgs.simple) - member _.Counter = base.Get() (Binding.SubModelT.req CounterViewModel >> Binding.mapModel CounterWithClock.ModelM.Counter.get >> Binding.mapMsg CounterWithClock.CounterMsg) - member _.Clock = base.Get() (Binding.SubModelT.req ClockViewModel >> Binding.mapModel CounterWithClock.ModelM.Clock.get >> Binding.mapMsg CounterWithClock.ClockMsg) + member _.Counter = + base.Get + () + (Binding.SubModelT.req CounterViewModel + >> Binding.mapModel CounterWithClock.ModelM.Counter.get + >> Binding.mapMsg CounterWithClock.CounterMsg) + + member _.Clock = + base.Get + () + (Binding.SubModelT.req ClockViewModel + >> Binding.mapModel CounterWithClock.ModelM.Clock.get + >> Binding.mapMsg CounterWithClock.ClockMsg) module App2 = @@ -129,6 +165,7 @@ module App2 = module ModelM = module ClockCounter1 = let get m = m.ClockCounter1 + module ClockCounter2 = let get m = m.ClockCounter2 @@ -143,30 +180,42 @@ module App2 = let update msg m = match msg with | ClockCounter1Msg msg -> - { m with ClockCounter1 = CounterWithClock.update msg m.ClockCounter1 } + { m with + ClockCounter1 = CounterWithClock.update msg m.ClockCounter1 } | ClockCounter2Msg msg -> - { m with ClockCounter2 = CounterWithClock.update msg m.ClockCounter2 } + { m with + ClockCounter2 = CounterWithClock.update msg m.ClockCounter2 } -type [] AppViewModel (args) = +[] +type AppViewModel(args) = inherit ViewModelBase(args) - + new() = AppViewModel(App2.init () |> ViewModelArgs.simple) - member _.ClockCounter1 = base.Get() (Binding.SubModelT.req CounterWithClockViewModel >> Binding.mapModel App2.ModelM.ClockCounter1.get >> Binding.mapMsg App2.ClockCounter1Msg) - member _.ClockCounter2 = base.Get() (Binding.SubModelT.req CounterWithClockViewModel >> Binding.mapModel App2.ModelM.ClockCounter2.get >> Binding.mapMsg App2.ClockCounter2Msg) + member _.ClockCounter1 = + base.Get + () + (Binding.SubModelT.req CounterWithClockViewModel + >> Binding.mapModel App2.ModelM.ClockCounter1.get + >> Binding.mapMsg App2.ClockCounter1Msg) + + member _.ClockCounter2 = + base.Get + () + (Binding.SubModelT.req CounterWithClockViewModel + >> Binding.mapModel App2.ModelM.ClockCounter2.get + >> Binding.mapMsg App2.ClockCounter2Msg) module Program = let timerTick dispatch = let timer = new System.Timers.Timer(1000.) - timer.Elapsed.Add (fun _ -> - let clockMsg = - DateTimeOffset.Now - |> Clock.Tick - |> CounterWithClock.ClockMsg + + timer.Elapsed.Add(fun _ -> + let clockMsg = DateTimeOffset.Now |> Clock.Tick |> CounterWithClock.ClockMsg dispatch <| App2.ClockCounter1Msg clockMsg - dispatch <| App2.ClockCounter2Msg clockMsg - ) + dispatch <| App2.ClockCounter2Msg clockMsg) + timer.Start() @@ -183,4 +232,4 @@ module Program = WpfProgram.mkSimpleT App2.init App2.update AppViewModel |> WpfProgram.withSubscription (Sub.fromV3Subscription "sub" (fun _ -> Cmd.ofEffect timerTick)) |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/Threading.Core/Program.fs b/src/Samples/Threading.Core/Program.fs index 1e34fa94..f31c3af9 100644 --- a/src/Samples/Threading.Core/Program.fs +++ b/src/Samples/Threading.Core/Program.fs @@ -10,16 +10,13 @@ open Elmish.WPF -type Model = - { Pings: int - Message: string } +type Model = { Pings: int; Message: string } type Msg = | IncrementPings | UpdateMessage of string -type Cmd = - | DelayThenIncrementPings +type Cmd = | DelayThenIncrementPings module Program = @@ -32,25 +29,23 @@ module Program = let get m = m.Message let set v m = { m with Message = v } - let init = - { Pings = 0; Message = "" }, [ DelayThenIncrementPings ] + let init = { Pings = 0; Message = "" }, [ DelayThenIncrementPings ] let update msg m = match msg with | IncrementPings -> m |> Pings.map ((+) 1), [ DelayThenIncrementPings ] - | UpdateMessage message -> m |> Message.set message, [ ] + | UpdateMessage message -> m |> Message.set message, [] - let bindings () = [ - "Pings" |> Binding.oneWay Pings.get - "Message" |> Binding.twoWay (Message.get, UpdateMessage) - ] + let bindings () = + [ "Pings" |> Binding.oneWay Pings.get + "Message" |> Binding.twoWay (Message.get, UpdateMessage) ] let toCmd = function | DelayThenIncrementPings -> Elmish.Cmd.OfAsyncImmediate.perform (fun () -> Async.Sleep 1000) () (fun () -> IncrementPings) -let designVm = ViewModel.designInstance { Pings = 2; Message = "Hello" } (Program.bindings ()) +let designVm = ViewModel.designInstance { Pings = 2; Message = "Hello" } (Program.bindings ()) let main window = @@ -70,8 +65,10 @@ let main window = Thread( ThreadStart(fun () -> WpfProgram.startElmishLoop window program - Dispatcher.Run())) + Dispatcher.Run()) + ) + elmishThread.Name <- "ElmishDispatchThread" elmishThread.Start() - elmishThread + elmishThread \ No newline at end of file diff --git a/src/Samples/UiBoundCmdParam.Core/Program.fs b/src/Samples/UiBoundCmdParam.Core/Program.fs index ce87dc6b..62effe84 100644 --- a/src/Samples/UiBoundCmdParam.Core/Program.fs +++ b/src/Samples/UiBoundCmdParam.Core/Program.fs @@ -10,7 +10,7 @@ type Model = EnabledMaxLimit: int } let init () = - { Numbers = [0 .. 10] + { Numbers = [ 0..10 ] EnabledMaxLimit = 5 } type Msg = @@ -22,14 +22,15 @@ let update msg m = | SetLimit x -> { m with EnabledMaxLimit = x } | Command -> m -let bindings () : Binding list = [ - "Numbers" |> Binding.oneWay(fun m -> m.Numbers) - "Limit" |> Binding.twoWay((fun m -> float m.EnabledMaxLimit), int >> SetLimit) - "Command" |> Binding.cmdParamIf( - (fun p m -> Command), - (fun (p: obj) m -> not (isNull p) && p :?> int <= m.EnabledMaxLimit), - true) -] +let bindings () : Binding list = + [ "Numbers" |> Binding.oneWay (fun m -> m.Numbers) + "Limit" |> Binding.twoWay ((fun m -> float m.EnabledMaxLimit), int >> SetLimit) + "Command" + |> Binding.cmdParamIf ( + (fun p m -> Command), + (fun (p: obj) m -> not (isNull p) && p :?> int <= m.EnabledMaxLimit), + true + ) ] let designVm = ViewModel.designInstance (init ()) (bindings ()) @@ -44,4 +45,4 @@ let main window = WpfProgram.mkSimple init update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file diff --git a/src/Samples/Validation.Core/Program.fs b/src/Samples/Validation.Core/Program.fs index 8d3da7cd..b79a85fe 100644 --- a/src/Samples/Validation.Core/Program.fs +++ b/src/Samples/Validation.Core/Program.fs @@ -11,37 +11,35 @@ module Result = module Error = - let toList = function + let toList = + function | Ok _ -> [] | Error e -> [ e ] let requireNotEmpty s = - if String.IsNullOrEmpty s then Error "This field is required" else Ok s + if String.IsNullOrEmpty s then + Error "This field is required" + else + Ok s let parseInt (s: string) = match Int32.TryParse s with | true, i -> Ok i | false, _ -> Error "Please enter a valid integer" -let requireExactly y x = - if x = y then Ok x else Error <| sprintf "Please enter %A" y +let requireExactly y x = if x = y then Ok x else Error <| sprintf "Please enter %A" y -let validateInt42 = - requireNotEmpty - >> Result.bind parseInt - >> Result.bind (requireExactly 42) +let validateInt42 = requireNotEmpty >> Result.bind parseInt >> Result.bind (requireExactly 42) let validatePassword (s: string) = - [ - if s.All(fun c -> Char.IsDigit c |> not) then + [ if s.All(fun c -> Char.IsDigit c |> not) then "Must contain a digit" if s.All(fun c -> Char.IsLower c |> not) then "Must contain a lowercase letter" if s.All(fun c -> Char.IsUpper c |> not) then - "Must contain an uppercase letter" - ] + "Must contain an uppercase letter" ] type Model = @@ -60,10 +58,12 @@ type Msg = | Submit let increaseUpdateCount m = - { m with UpdateCount = m.UpdateCount + 1 } + { m with + UpdateCount = m.UpdateCount + 1 } let update msg m = let m = increaseUpdateCount m + match msg with | NewValue x -> { m with Value = x } | NewPassword x -> { m with Password = x } @@ -75,20 +75,25 @@ let errorOnEven m = else [] -let bindings () : Binding list = [ - "UpdateCount" - |> Binding.oneWay(fun m -> m.UpdateCount) +let bindings () : Binding list = + [ "UpdateCount" + |> Binding.oneWay (fun m -> m.UpdateCount) |> Binding.addValidation errorOnEven - "Value" - |> Binding.twoWay((fun m -> m.Value), NewValue) - |> Binding.addValidation(fun m -> m.Value |> validateInt42 |> Result.Error.toList) - "Password" - |> Binding.twoWay((fun m -> m.Password), NewPassword) - |> Binding.addValidation(fun m -> m.Password |> validatePassword) - "Submit" |> Binding.cmdIf( - (fun _ -> Submit), - (fun m -> (match validateInt42 m.Value with Ok _ -> true | Error _ -> false) && (validatePassword m.Password |> List.isEmpty))) -] + "Value" + |> Binding.twoWay ((fun m -> m.Value), NewValue) + |> Binding.addValidation (fun m -> m.Value |> validateInt42 |> Result.Error.toList) + "Password" + |> Binding.twoWay ((fun m -> m.Password), NewPassword) + |> Binding.addValidation (fun m -> m.Password |> validatePassword) + "Submit" + |> Binding.cmdIf ( + (fun _ -> Submit), + (fun m -> + (match validateInt42 m.Value with + | Ok _ -> true + | Error _ -> false) + && (validatePassword m.Password |> List.isEmpty)) + ) ] let designVm = ViewModel.designInstance (init ()) (bindings ()) @@ -103,4 +108,4 @@ let main window = WpfProgram.mkSimple init update bindings |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + |> WpfProgram.startElmishLoop window \ No newline at end of file