Skip to content

Commit

Permalink
Create an immutable helper to offload bindings management
Browse files Browse the repository at this point in the history
  • Loading branch information
@marner2
marner2 committed Oct 15, 2022
1 parent e08fe80 commit 77fdba1
Showing 1 changed file with 87 additions and 60 deletions.
147 changes: 87 additions & 60 deletions src/Elmish.WPF/DynamicViewModel.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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<string, string list ref>
Bindings: IReadOnlyDictionary<string, VmBinding<'model, 'msg, obj>>
PropertyChanged: Event<PropertyChangedEventHandler, PropertyChangedEventArgs>
ErrorsChanged: DelegateEvent<EventHandler<DataErrorsChangedEventArgs>> }

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
[<CLIEvent>]
member x.PropertyChanged = x.PropertyChanged.Publish

interface INotifyDataErrorInfo with
[<CLIEvent>]
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 "<null>" // 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 [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
( args: ViewModelArgs<'model, 'msg>,
bindings: Binding<'model, 'msg> list)
Expand All @@ -41,40 +94,28 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
nameChain = nameChain
} = loggingArgs

let mutable currentModel = initialModel

let propertyChanged = Event<PropertyChangedEventHandler, PropertyChangedEventArgs>()
let errorsChanged = DelegateEvent<EventHandler<DataErrorsChangedEventArgs>>()

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<string, VmBinding<'model, 'msg, obj>>(bindings.Length)
let validationDict = Dictionary<string, string list ref>()

let sortedBindings =
bindings
|> List.sortWith (SubModelSelectedItemLast().CompareBindings())
Expand All @@ -92,20 +133,15 @@ type [<AllowNullLiteral>] 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<PropertyChangedEventHandler, PropertyChangedEventArgs>()
ErrorsChanged = DelegateEvent<EventHandler<DataErrorsChangedEventArgs>>()
}

override _.TryGetMember (binder, result) =
log.LogTrace("[{BindingNameChain}] TryGetMember {BindingName}", nameChain, binder.Name)
Expand All @@ -115,7 +151,7 @@ type [<AllowNullLiteral>] 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
Expand All @@ -137,7 +173,7 @@ type [<AllowNullLiteral>] 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
Expand All @@ -149,25 +185,16 @@ type [<AllowNullLiteral>] 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
[<CLIEvent>]
member _.PropertyChanged = propertyChanged.Publish
member _.PropertyChanged = (helper :> INotifyPropertyChanged).PropertyChanged

interface INotifyDataErrorInfo with
[<CLIEvent>]
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 "<null>" // 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)
member _.ErrorsChanged = (helper :> INotifyDataErrorInfo).ErrorsChanged
member _.HasErrors = (helper :> INotifyDataErrorInfo).HasErrors
member _.GetErrors name = (helper :> INotifyDataErrorInfo).GetErrors name

0 comments on commit 77fdba1

Please sign in to comment.