Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Extract a ViewModelHelper that will be useful with static view models #523

Merged
merged 1 commit into from
Oct 29, 2022
Merged

Extract a ViewModelHelper that will be useful with static view models #523

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
158 changes: 100 additions & 58 deletions src/Elmish.WPF/DynamicViewModel.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,75 @@ module internal IViewModel =
let currentModel (vm: #IViewModel<'model, 'msg>) = vm.CurrentModel
let updateModel (vm: #IViewModel<'model, 'msg>, m: 'model) = vm.UpdateModel(m)

type internal ViewModelHelper<'model, 'msg> =
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Would a better name be ViewModelState?

{ GetSender: unit -> obj
LoggingArgs: LoggingViewModelArgs
Model: 'model
Bindings: IReadOnlyDictionary<string, VmBinding<'model, 'msg, obj>>
ValidationErrors: IReadOnlyDictionary<string, string list ref>
PropertyChanged: Event<PropertyChangedEventHandler, PropertyChangedEventArgs>
ErrorsChanged: DelegateEvent<EventHandler<DataErrorsChangedEventArgs>> }

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)

module internal ViewModelHelper =

let create getSender args bindings validationErrors ={
GetSender = getSender
LoggingArgs = args.loggingArgs
Model = args.initialModel
ValidationErrors = validationErrors
Bindings = bindings
PropertyChanged = Event<PropertyChangedEventHandler, PropertyChangedEventArgs>()
ErrorsChanged = DelegateEvent<EventHandler<DataErrorsChangedEventArgs>>()
}

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 }
marner2 marked this conversation as resolved.
Show resolved Hide resolved

type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
( args: ViewModelArgs<'model, 'msg>,
bindings: Binding<'model, 'msg> list)
Expand All @@ -49,40 +118,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 |> IViewModel.currentModel), binding.Data)

let (bindings, validationErrors) =
log.LogTrace("[{BindingNameChain}] Initializing bindings", nameChain)

let bindingDict = Dictionary<string, VmBinding<'model, 'msg, obj>>(bindings.Length)
marner2 marked this conversation as resolved.
Show resolved Hide resolved
let validationDict = Dictionary<string, string list ref>()

let sortedBindings =
bindings
|> List.sortWith (SubModelSelectedItemLast().CompareBindings())
Expand All @@ -100,21 +157,18 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>
(bindingDict :> IReadOnlyDictionary<_,_>,
validationDict :> IReadOnlyDictionary<_,_>)


let mutable helper =
ViewModelHelper.create
(fun () -> this)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why is this a function?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it was originally to avoid using references to this in the initialization section, but I'm not sure anymore.

args
bindings
validationErrors

interface IViewModel<'model, 'msg> with
member _.CurrentModel : 'model = currentModel
member _.CurrentModel : 'model = helper.Model

member _.UpdateModel (newModel: 'model) : unit =
let eventsToRaise =
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)
helper <- ViewModelHelper.updateModel newModel helper

override _.TryGetMember (binder, result) =
log.LogTrace("[{BindingNameChain}] TryGetMember {BindingName}", nameChain, binder.Name)
Expand All @@ -124,7 +178,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 @@ -146,7 +200,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 @@ -161,22 +215,10 @@ type [<AllowNullLiteral>] internal DynamicViewModel<'model, 'msg>

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