Skip to content

Commit

Permalink
Split helper out from Dynamic View Model
Browse files Browse the repository at this point in the history
  • Loading branch information
@marner2
marner2 committed Oct 12, 2022
1 parent ae977c5 commit 5743879
Showing 1 changed file with 64 additions and 43 deletions.
107 changes: 64 additions & 43 deletions src/Elmish.WPF/DynamicViewModel.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,11 +26,9 @@ 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 [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
( args: ViewModelArgs<'model, 'msg>,
bindings: Binding<'model, 'msg> list)
as this =
inherit DynamicObject()
type internal ViewModelHelper<'model, 'msg>
( args: ViewModelArgs<'model, 'msg>,
getSender: unit -> obj) =

let { initialModel = initialModel
dispatch = dispatch
Expand All @@ -49,12 +47,12 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>

let raisePropertyChanged name =
log.LogTrace("[{BindingNameChain}] PropertyChanged {BindingName}", nameChain, name)
propertyChanged.Trigger(this, PropertyChangedEventArgs name)
propertyChanged.Trigger(getSender (), 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 |])
errorsChanged.Trigger([| getSender (); box <| DataErrorsChangedEventArgs name |])

let getFunctionsForSubModelSelectedItem (selectedItemTargetBindings: IReadOnlyDictionary<string, _>) name =
selectedItemTargetBindings
Expand All @@ -68,23 +66,6 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
| None -> log.LogError("SubModelSelectedItem binding referenced binding {SubModelSeqBindingName} but no binding was found with that name", name)
None

let bindings =
log.LogTrace("[{BindingNameChain}] Initializing bindings", nameChain)
let bindingDict = Dictionary<string, VmBinding<'model, 'msg, obj>>(bindings.Length)
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)
else
option {
let! vmBinding = this.InitializeBindingWithValidation (bindingDict, b)
do bindingDict.Add(b.Name, vmBinding)
return ()
} |> Option.defaultValue ()
bindingDict :> IReadOnlyDictionary<_,_>

member internal _.InitializeBindingWithValidation (selectedItemTargetBindings: IReadOnlyDictionary<string, _>, binding) =
option {
let! vmBinding =
Expand All @@ -98,7 +79,7 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>

member internal _.CurrentModel : 'model = currentModel

member internal _.UpdateModel (newModel: 'model) : unit =
member internal _.UpdateModel (bindings: IReadOnlyDictionary<string, VmBinding<'model, 'msg, obj>>, newModel: 'model) : unit =
let eventsToRaise =
bindings
|> Seq.collect (fun (Kvp (name, binding)) -> Update(loggingArgs, name).Recursive(ValueNone, (fun () -> currentModel), newModel, binding))
Expand All @@ -110,6 +91,55 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
| PropertyChanged name -> raisePropertyChanged name
| CanExecuteChanged cmd -> cmd |> raiseCanExecuteChanged)

interface INotifyPropertyChanged with
[<CLIEvent>]
member _.PropertyChanged = propertyChanged.Publish

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)

type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
( args: ViewModelArgs<'model, 'msg>,
bindings: Binding<'model, 'msg> list)
as this =
inherit DynamicObject()

let helper = ViewModelHelper(args, fun () -> box this)

let { loggingArgs = { log = log; nameChain = nameChain } } = args

let bindings =
log.LogTrace("[{BindingNameChain}] Initializing bindings", nameChain)
let bindingDict = Dictionary<string, VmBinding<'model, 'msg, obj>>(bindings.Length)
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)
else
option {
let! vmBinding = helper.InitializeBindingWithValidation (bindingDict, b)
do bindingDict.Add(b.Name, vmBinding)
return ()
} |> Option.defaultValue ()
bindingDict :> IReadOnlyDictionary<_,_>

override _.TryGetMember (binder, result) =
log.LogTrace("[{BindingNameChain}] TryGetMember {BindingName}", nameChain, binder.Name)
match bindings.TryGetValue binder.Name with
Expand All @@ -118,7 +148,7 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
false
| true, binding ->
try
match Get(nameChain).Recursive(currentModel, binding) with
match Get(nameChain).Recursive(helper.CurrentModel, binding) with
| Ok v ->
result <- v
true
Expand All @@ -140,7 +170,7 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
false
| true, binding ->
try
let success = Set(value).Recursive(currentModel, binding)
let success = Set(value).Recursive(helper.CurrentModel, binding)
if not success then
log.LogError("[{BindingNameChain}] TrySetMember FAILED: Binding {BindingName} is read-only", nameChain, binder.Name)
success
Expand All @@ -152,25 +182,16 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
log.LogTrace("[{BindingNameChain}] GetDynamicMemberNames", nameChain)
bindings.Keys

member _.UpdateModel(newModel: 'model) = helper.UpdateModel(bindings, newModel)

member _.CurrentModel = helper.CurrentModel

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 5743879

Please sign in to comment.