From 1e41dff6ba924fb6eb3cffd565ce37fd70f0fb26 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 | 164 ++++++++++++++++++----------- 1 file changed, 102 insertions(+), 62 deletions(-) diff --git a/src/Elmish.WPF/DynamicViewModel.fs b/src/Elmish.WPF/DynamicViewModel.fs index 48c100ff..bef03c9a 100644 --- a/src/Elmish.WPF/DynamicViewModel.fs +++ b/src/Elmish.WPF/DynamicViewModel.fs @@ -26,6 +26,75 @@ 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 + Bindings: IReadOnlyDictionary> + ValidationErrors: IReadOnlyDictionary + PropertyChanged: Event + ErrorsChanged: DelegateEvent> } + + 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) + +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 updateModel newModel helper = + 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 () + let raiseErrorsChanged name = + log.LogTrace("[{BindingNameChain}] ErrorsChanged {BindingName}", nameChain, name) + helper.ErrorsChanged.Trigger([| helper.GetSender (); box <| DataErrorsChangedEventArgs name |]) + + let eventsToRaise = + helper.Bindings + |> Seq.collect (fun (Kvp (name, binding)) -> Update(helper.LoggingArgs, name).Recursive(helper.Model, newModel, binding)) + |> Seq.toList + eventsToRaise + |> List.iter (function + | ErrorsChanged name -> raiseErrorsChanged name + | PropertyChanged name -> raisePropertyChanged name + | CanExecuteChanged cmd -> cmd |> raiseCanExecuteChanged) + + { helper with Model = newModel } + type [] internal DynamicViewModel<'model, 'msg> ( args: ViewModelArgs<'model, 'msg>, bindings: Binding<'model, 'msg> list) @@ -41,40 +110,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,30 +149,22 @@ type [] internal DynamicViewModel<'model, 'msg> (bindingDict :> IReadOnlyDictionary<_,_>, validationDict :> IReadOnlyDictionary<_,_>) - - member internal _.CurrentModel : 'model = currentModel - - member internal _.UpdateModel (newModel: 'model) : unit = - let eventsToRaise = + let mutable helper = + ViewModelHelper.create + (fun () -> this) + args bindings - |> Seq.collect (fun (Kvp (name, binding)) -> Update(loggingArgs, name).Recursive(currentModel, newModel, binding)) - |> Seq.toList - currentModel <- newModel - eventsToRaise - |> List.iter (function - | ErrorsChanged name -> raiseErrorsChanged name - | PropertyChanged name -> raisePropertyChanged name - | CanExecuteChanged cmd -> cmd |> raiseCanExecuteChanged) + validationErrors override _.TryGetMember (binder, result) = log.LogTrace("[{BindingNameChain}] TryGetMember {BindingName}", nameChain, binder.Name) - match bindings.TryGetValue binder.Name with + match helper.Bindings.TryGetValue binder.Name with | false, _ -> log.LogError("[{BindingNameChain}] TryGetMember FAILED: Property {BindingName} doesn't exist", nameChain, binder.Name) false | true, binding -> try - match Get(nameChain).Recursive(currentModel, binding) with + match Get(nameChain).Recursive(helper.Model, binding) with | Ok v -> result <- v true @@ -131,13 +180,13 @@ type [] internal DynamicViewModel<'model, 'msg> override _.TrySetMember (binder, value) = log.LogTrace("[{BindingNameChain}] TrySetMember {BindingName}", nameChain, binder.Name) - match bindings.TryGetValue binder.Name with + match helper.Bindings.TryGetValue binder.Name with | false, _ -> log.LogError("[{BindingNameChain}] TrySetMember FAILED: Property {BindingName} doesn't exist", nameChain, binder.Name) 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 @@ -147,27 +196,18 @@ type [] internal DynamicViewModel<'model, 'msg> override _.GetDynamicMemberNames () = log.LogTrace("[{BindingNameChain}] GetDynamicMemberNames", nameChain) - bindings.Keys + helper.Bindings.Keys + + member _.UpdateModel(newModel: 'model) = helper <- ViewModelHelper.updateModel newModel helper + 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