From 0277a225f58d8ea8aa0f6c94951e6832ff6aeb24 Mon Sep 17 00:00:00 2001 From: YannicK Trudeau Date: Thu, 6 Jun 2024 14:34:41 -0400 Subject: [PATCH 1/2] elmish bindings to staticVM --- src/Samples/SubModelOpt.Core/Program.fs | 249 +++++++++++++++--------- 1 file changed, 156 insertions(+), 93 deletions(-) diff --git a/src/Samples/SubModelOpt.Core/Program.fs b/src/Samples/SubModelOpt.Core/Program.fs index 3a8dfe50..a7dd6a88 100644 --- a/src/Samples/SubModelOpt.Core/Program.fs +++ b/src/Samples/SubModelOpt.Core/Program.fs @@ -1,4 +1,5 @@ -module Elmish.WPF.Samples.SubModelOpt.Program +namespace Program + open Serilog open Serilog.Extensions.Logging @@ -7,128 +8,190 @@ open Elmish.WPF module Form1 = - type Model = - { Text: string } + type Model = { Text: string } + + type Msg = + | SetText of string + | Submit + + let init = { Text = "" } + + let update msg m = + match msg with + | SetText s -> { m with Text = s } + | Submit -> m // handled by parent + + +[] +type Form1_ViewModel(args) = + inherit ViewModelBase(args) + + let text_Binding = + Binding.TwoWayT.id + >> Binding.mapModel (fun (m: Form1.Model) -> m.Text) + >> Binding.mapMsg Form1.SetText - type Msg = - | SetText of string - | Submit - let init = - { Text = "" } + member _.Text + with get() = base.Get() (text_Binding) + and set(v) = base.Set(v) (text_Binding) - let update msg m = - match msg with - | SetText s -> { m with Text = s } - | Submit -> m // handled by parent + member _.Submit = base.Get () (Binding.CmdT.setAlways Form1.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 update msg m = + match msg with + | SetText1 s -> { m with Text1 = s } + | SetText2 s -> { m with Text2 = s } + | Submit -> m // handled by parent + + +[] +type Form2_ViewModel(args) = + inherit ViewModelBase(args) + + let text1_Binding = + Binding.TwoWayT.id + >> Binding.mapModel (fun (m: Form2.Model) -> m.Text1) + >> Binding.mapMsg Form2.SetText1 + + let text2_Binding = + Binding.TwoWayT.id + >> Binding.mapModel (fun (m: Form2.Model) -> m.Text2) + >> Binding.mapMsg Form2.SetText2 - type Msg = - | SetText1 of string - | SetText2 of string - | Submit - let init = - { Text1 = "" - Text2 = "" } + member _.Text1 + with get () = base.Get () (text1_Binding) + and set (v) = base.Set (v) (text1_Binding) - let update msg m = - match msg with - | SetText1 s -> { m with Text1 = s } - | SetText2 s -> { m with Text2 = s } - | Submit -> m // handled by parent + member _.Text2 + with get () = base.Get () (text2_Binding) + and set (v) = base.Set (v) (text2_Binding) + + member _.Submit = base.Get () (Binding.CmdT.setAlways Form2.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 = - type Dialog = - | Form1 of Form1.Model - | Form2 of Form2.Model + type Dialog = + | Form1 of Form1.Model + | Form2 of Form2.Model + + type Model = { Dialog: Dialog option } + + let init () = { Dialog = None } + + type Msg = + | ShowForm1 + | ShowForm2 + | Form1Msg of Form1.Msg + | Form2Msg of Form2.Msg + + let update msg m = + match msg with + | 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 + | 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 + + +[] +type App_ViewModel (args) = + inherit ViewModelBase(args) + + // bindings + let form1Visible_Binding = + Binding.OneWayT.id + >> Binding.mapModel (fun (m: App.Model) -> + match m.Dialog with + | Some (App.Dialog.Form1 _) -> true + | _ -> false) + + + let form2Visible_Binding = + Binding.OneWayT.id + >> Binding.mapModel (fun (m: App.Model) -> + match m.Dialog with + | Some (App.Dialog.Form2 _) -> true + | _ -> false) + + + let form1_Binding = + Binding.SubModelT.opt Form1_ViewModel + >> Binding.mapModel (fun (m: App.Model) -> + match m.Dialog with + | Some (App.Dialog.Form1 m') -> ValueSome m' + | _ -> ValueNone) + >> Binding.mapMsg (fun msg -> App.Form1Msg msg) + - type Model = - { Dialog: Dialog option } + let form2_Binding = + Binding.SubModelT.opt Form2_ViewModel + >> Binding.mapModel (fun (m: App.Model) -> + match m.Dialog with + | Some (App.Dialog.Form2 m') -> ValueSome m' + | _ -> ValueNone) + >> Binding.mapMsg (fun msg -> App.Form2Msg msg) - let init () = - { Dialog = None } - type Msg = - | ShowForm1 - | ShowForm2 - | Form1Msg of Form1.Msg - | Form2Msg of Form2.Msg + new() = App_ViewModel(App.init () |> ViewModelArgs.simple) - let update msg m = - match msg with - | 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 - | 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 - let bindings () : Binding list = [ - "ShowForm1" |> Binding.cmd ShowForm1 + // members + member _.ShowForm1 = base.Get () (Binding.CmdT.setAlways App.ShowForm1) - "ShowForm2" |> Binding.cmd ShowForm2 + member _.ShowForm2 = base.Get () (Binding.CmdT.setAlways App.ShowForm2) - "DialogVisible" |> Binding.oneWay (fun m -> m.Dialog.IsSome) + member _.DialogVisible = + base.Get + () + (Binding.OneWayT.id + >> Binding.mapModel (fun m -> m.Dialog.IsSome)) - "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) + member _.Form1Visible = base.Get () (form1Visible_Binding) - "Form1" - |> Binding.SubModel.opt Form1.bindings - |> Binding.mapModel (fun m -> match m.Dialog with Some (Form1 m') -> Some m' | _ -> None) - |> Binding.mapMsg Form1Msg + member _.Form2Visible = base.Get () (form2Visible_Binding) - "Form2" - |> Binding.SubModel.opt Form2.bindings - |> Binding.mapModel (fun m -> match m.Dialog with Some (Form2 m') -> Some m' | _ -> None) - |> Binding.mapMsg Form2Msg - ] + member _.Form1 = base.Get () (form1_Binding) + member _.Form2 = base.Get () (form2_Binding) -let form1DesignVm = ViewModel.designInstance Form1.init (Form1.bindings ()) -let form2DesignVm = ViewModel.designInstance Form2.init (Form2.bindings ()) -let mainDesignVm = ViewModel.designInstance (App.init ()) (App.bindings ()) -let main window = +module Program = + let main window = - let logger = - LoggerConfiguration() - .MinimumLevel.Override("Elmish.WPF.Update", Events.LogEventLevel.Verbose) - .MinimumLevel.Override("Elmish.WPF.Bindings", Events.LogEventLevel.Verbose) - .MinimumLevel.Override("Elmish.WPF.Performance", Events.LogEventLevel.Verbose) - .WriteTo.Console() - .CreateLogger() + let logger = + LoggerConfiguration() + .MinimumLevel.Override("Elmish.WPF.Update", Events.LogEventLevel.Verbose) + .MinimumLevel.Override("Elmish.WPF.Bindings", Events.LogEventLevel.Verbose) + .MinimumLevel.Override("Elmish.WPF.Performance", Events.LogEventLevel.Verbose) + .WriteTo.Console() + .CreateLogger() - WpfProgram.mkSimple App.init App.update App.bindings - |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) - |> WpfProgram.startElmishLoop window + WpfProgram.mkSimpleT App.init App.update App_ViewModel + |> WpfProgram.withLogger (new SerilogLoggerFactory(logger)) + |> WpfProgram.startElmishLoop window \ No newline at end of file From 379637408f00d3816c26e9a2aee8bd426c32f91a Mon Sep 17 00:00:00 2001 From: YannicK Trudeau Date: Thu, 6 Jun 2024 14:43:45 -0400 Subject: [PATCH 2/2] elmishwpf bindings to staticVM --- src/Samples/SubModelOpt.Core/Program.fs | 1 - src/Samples/SubModelOpt/App.xaml.cs | 15 ++-- src/Samples/SubModelOpt/Form1.xaml | 43 +++++++--- src/Samples/SubModelOpt/Form2.xaml | 44 ++++++---- src/Samples/SubModelOpt/MainWindow.xaml | 109 +++++++++++++----------- 5 files changed, 125 insertions(+), 87 deletions(-) diff --git a/src/Samples/SubModelOpt.Core/Program.fs b/src/Samples/SubModelOpt.Core/Program.fs index a7dd6a88..aa26339c 100644 --- a/src/Samples/SubModelOpt.Core/Program.fs +++ b/src/Samples/SubModelOpt.Core/Program.fs @@ -1,6 +1,5 @@ namespace Program - open Serilog open Serilog.Extensions.Logging open Elmish.WPF diff --git a/src/Samples/SubModelOpt/App.xaml.cs b/src/Samples/SubModelOpt/App.xaml.cs index 13dc4d6d..e4ec3118 100644 --- a/src/Samples/SubModelOpt/App.xaml.cs +++ b/src/Samples/SubModelOpt/App.xaml.cs @@ -1,20 +1,19 @@ using System; using System.Windows; -namespace Elmish.WPF.Samples.SubModelOpt +namespace Elmish.WPF.Samples.SubModelOpt; + +public partial class App { - public partial class App : Application - { public App() { - this.Activated += StartElmish; + this.Activated += StartElmish; } private void StartElmish(object sender, EventArgs e) { - this.Activated -= StartElmish; - Program.main(MainWindow); + this.Activated -= StartElmish; + Program.Program.main(MainWindow); } - } -} +} \ No newline at end of file diff --git a/src/Samples/SubModelOpt/Form1.xaml b/src/Samples/SubModelOpt/Form1.xaml index 3ebad21d..2ac5b5a7 100644 --- a/src/Samples/SubModelOpt/Form1.xaml +++ b/src/Samples/SubModelOpt/Form1.xaml @@ -1,15 +1,30 @@ - - - - -