From 77fdba17702205a24600ae4b6bb381826f7a17d9 Mon Sep 17 00:00:00 2001 From: Joshua Marner Date: Tue, 4 Oct 2022 14:07:31 -0500 Subject: [PATCH] Create an immutable helper to offload bindings management --- src/Elmish.WPF/DynamicViewModel.fs | 147 +++++++++++++++++------------ 1 file changed, 87 insertions(+), 60 deletions(-) diff --git a/src/Elmish.WPF/DynamicViewModel.fs b/src/Elmish.WPF/DynamicViewModel.fs index dc887660..b91d0419 100644 --- a/src/Elmish.WPF/DynamicViewModel.fs +++ b/src/Elmish.WPF/DynamicViewModel.fs @@ -26,6 +26,59 @@ module internal Helpers = member this.CompareBindings() : Binding<'model, 'msg> -> Binding<'model, 'msg> -> int = fun a b -> this.Recursive(a.Data) - this.Recursive(b.Data) +type internal ViewModelHelper<'model, 'msg> = + { GetSender: unit -> obj + LoggingArgs: LoggingViewModelArgs + Model: 'model + ValidationErrors: IReadOnlyDictionary + Bindings: IReadOnlyDictionary> + PropertyChanged: Event + ErrorsChanged: DelegateEvent> } + + member x.UpdateModel(newModel: 'model) : ViewModelHelper<'model, 'msg> = + let raisePropertyChanged name = + x.LoggingArgs.log.LogTrace("[{BindingNameChain}] PropertyChanged {BindingName}", x.LoggingArgs.nameChain, name) + x.PropertyChanged.Trigger(x.GetSender (), PropertyChangedEventArgs name) + let raiseCanExecuteChanged (cmd: Command) = + cmd.RaiseCanExecuteChanged () + let raiseErrorsChanged name = + x.LoggingArgs.log.LogTrace("[{BindingNameChain}] ErrorsChanged {BindingName}", x.LoggingArgs.nameChain, name) + x.ErrorsChanged.Trigger([| x.GetSender (); box <| DataErrorsChangedEventArgs name |]) + + let eventsToRaise = + x.Bindings + |> Seq.collect (fun (Kvp (name, binding)) -> Update(x.LoggingArgs, name).Recursive(ValueNone, (fun () -> x.Model), newModel, binding)) + |> Seq.toList + eventsToRaise + |> List.iter (function + | ErrorsChanged name -> raiseErrorsChanged name + | PropertyChanged name -> raisePropertyChanged name + | CanExecuteChanged cmd -> cmd |> raiseCanExecuteChanged) + + { x with Model = newModel } + + interface INotifyPropertyChanged with + [] + member x.PropertyChanged = x.PropertyChanged.Publish + + 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) + |> Option.defaultValue [] + |> (fun x -> upcast x) + type [] internal DynamicViewModel<'model, 'msg> ( args: ViewModelArgs<'model, 'msg>, bindings: Binding<'model, 'msg> list) @@ -41,40 +94,28 @@ type [] internal DynamicViewModel<'model, 'msg> nameChain = nameChain } = loggingArgs - let mutable currentModel = initialModel - - let propertyChanged = Event() - let errorsChanged = DelegateEvent>() - - let raisePropertyChanged name = - log.LogTrace("[{BindingNameChain}] PropertyChanged {BindingName}", nameChain, name) - propertyChanged.Trigger(this, PropertyChangedEventArgs name) - let raiseCanExecuteChanged (cmd: Command) = - cmd.RaiseCanExecuteChanged () - let raiseErrorsChanged name = - log.LogTrace("[{BindingNameChain}] ErrorsChanged {BindingName}", nameChain, name) - errorsChanged.Trigger([| box this; box <| DataErrorsChangedEventArgs name |]) - - let getFunctionsForSubModelSelectedItem initializedBindings (name: string) = - initializedBindings - |> IReadOnlyDictionary.tryFind name - |> function - | Some b -> - match FuncsFromSubModelSeqKeyed().Recursive(b) with - | Some x -> Some x - | None -> log.LogError("SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but it is not a SubModelSeq binding", name) + let (bindings, validationErrors) = + let getFunctionsForSubModelSelectedItem initializedBindings (name: string) = + initializedBindings + |> IReadOnlyDictionary.tryFind name + |> function + | Some b -> + match FuncsFromSubModelSeqKeyed().Recursive(b) 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 - | None -> log.LogError("SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but no binding was found with that name", name) - None - let initializeBinding initializedBindings binding = - Initialize(loggingArgs, binding.Name, getFunctionsForSubModelSelectedItem initializedBindings) - .Recursive(initialModel, dispatch, (fun () -> currentModel), binding.Data) + let initializeBinding initializedBindings binding = + Initialize(loggingArgs, binding.Name, getFunctionsForSubModelSelectedItem initializedBindings) + .Recursive(initialModel, dispatch, (fun () -> this.CurrentModel), binding.Data) - let (bindings, validationErrors) = log.LogTrace("[{BindingNameChain}] Initializing bindings", nameChain) + let bindingDict = Dictionary>(bindings.Length) let validationDict = Dictionary() + let sortedBindings = bindings |> List.sortWith (SubModelSelectedItemLast().CompareBindings()) @@ -92,20 +133,15 @@ type [] internal DynamicViewModel<'model, 'msg> (bindingDict :> IReadOnlyDictionary<_,_>, validationDict :> IReadOnlyDictionary<_,_>) - - member internal _.CurrentModel : 'model = currentModel - - member internal _.UpdateModel (newModel: 'model) : unit = - let eventsToRaise = - bindings - |> Seq.collect (fun (Kvp (name, binding)) -> Update(loggingArgs, name).Recursive(ValueNone, (fun () -> currentModel), newModel, binding)) - |> Seq.toList - currentModel <- newModel - eventsToRaise - |> List.iter (function - | ErrorsChanged name -> raiseErrorsChanged name - | PropertyChanged name -> raisePropertyChanged name - | CanExecuteChanged cmd -> cmd |> raiseCanExecuteChanged) + let mutable helper: ViewModelHelper<'model, 'msg> = { + GetSender = fun () -> this + LoggingArgs = loggingArgs + Model = initialModel + ValidationErrors = validationErrors + Bindings = bindings + PropertyChanged = Event() + ErrorsChanged = DelegateEvent>() + } override _.TryGetMember (binder, result) = log.LogTrace("[{BindingNameChain}] TryGetMember {BindingName}", nameChain, binder.Name) @@ -115,7 +151,7 @@ type [] internal DynamicViewModel<'model, 'msg> false | true, binding -> try - match Get(nameChain).Recursive(currentModel, binding) with + match Get(nameChain).Recursive(helper.Model, binding) with | Ok v -> result <- v true @@ -137,7 +173,7 @@ type [] internal DynamicViewModel<'model, 'msg> false | true, binding -> try - let success = Set(value).Recursive(currentModel, binding) + 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 @@ -149,25 +185,16 @@ type [] internal DynamicViewModel<'model, 'msg> log.LogTrace("[{BindingNameChain}] GetDynamicMemberNames", nameChain) bindings.Keys + member _.UpdateModel(newModel: 'model) = helper <- helper.UpdateModel(newModel) + + member _.CurrentModel = helper.Model interface INotifyPropertyChanged with [] - member _.PropertyChanged = propertyChanged.Publish + member _.PropertyChanged = (helper :> INotifyPropertyChanged).PropertyChanged interface INotifyDataErrorInfo with [] - member _.ErrorsChanged = errorsChanged.Publish - member _.HasErrors = - // WPF calls this too often, so don't log https://github.com/elmish/Elmish.WPF/issues/354 - validationErrors - |> Seq.map (fun (Kvp(_, errors)) -> errors.Value) - |> Seq.filter (not << List.isEmpty) - |> (not << Seq.isEmpty) - member _.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 - log.LogTrace("[{BindingNameChain}] GetErrors {BindingName}", nameChain, name) - validationErrors - |> IReadOnlyDictionary.tryFind name - |> Option.map (fun errors -> errors.Value) - |> Option.defaultValue [] - |> (fun x -> upcast x) \ No newline at end of file + member _.ErrorsChanged = (helper :> INotifyDataErrorInfo).ErrorsChanged + member _.HasErrors = (helper :> INotifyDataErrorInfo).HasErrors + member _.GetErrors name = (helper :> INotifyDataErrorInfo).GetErrors name