F#でWPF --- Elm Architectureを利用したMVVM
下記の記事でMVVMを紹介しましたが、実装が冗長であるという問題がありました。
WPFにおけるMVVM - 何でもプログラミング
今回は下記記事で紹介しました、簡素な記述のできるElm ArchitectureをMVVMに適用します。
Elm --- Model、View、Update - 何でもプログラミング
作成するアプリケーション
いつも通りカウンタのアプリケーションを例に作成します。
Elm Architectureのおさらい
MVVMへ適用
Htmlオブジェクトを作る代わりに、ViewModelを作成する構造にします。またCommandをメッセージに変換します。
フレームワークがDataContextを作成するので、INotifyPropertyChangedやICommandを毎回実装する必要がなくなります。
DynamicObject
動的なDataContextを作成するにあたり、今回はDynamicObjectを利用します。
DynamicObjectのTryGetMemberを利用することにより、Xaml側のBindingの値取得要求に対し、動的に応答することが可能となります。
DataContext --- コンストラクタ引数
Modelの初期値、updateModel、createViewModelを引数とします。
type DataContext<'msg, 'm, 'vm>(initialModel : 'm, updateModel : 'm -> 'msg -> 'm, createViewModel : 'm -> 'vm)
DataContext --- INotifyPropertyChanged実装
let propertyChanged = Event<_, _>() interface INotifyPropertyChanged with [<CLIEvent>] member this.PropertyChanged = propertyChanged.Publish
DataContext --- DynamicObject実装
propertyDictionary、commandDictionaryは後程実装いたします。
inherit DynamicObject() override this.TryGetMember(binder : GetMemberBinder, [<Out>] result : obj byref) = if propertyDictionary.ContainsKey binder.Name then result <- propertyDictionary.Item(binder.Name).GetValue(viewModel) else result <- commandDictionary.Item(binder.Name) true
DataContext --- propertyDictionary
プロパティ名からPropertyInfoを取得する辞書を作成します。
let propertyDictionary = typeof<'vm>.GetProperties() |> Array.map (fun x -> x.Name, x) |> dict
DataContext --- commandDictionary
コマンド名からICommandを取得する辞書を作成します。
executeMessageは後程実装いたします。
let commandDictionary = let createCommand (msg : UnionCaseInfo) = { new ICommand with member this.CanExecute _ = true [<CLIEvent>] member this.CanExecuteChanged = Event<_, _>().Publish member this.Execute parameter = executeMessage msg.Name parameter } FSharpType.GetUnionCases(typeof<'msg>) |> Array.map (fun x -> x.Name, createCommand x) |> dict
DataContext --- executeMessage
let mutable model = initialModel let mutable viewModel = createViewModel model // UnionCase名からUnionCaseを取得する辞書 let messageDictionary = FSharpType.GetUnionCases(typeof<'msg>) |> Array.map (fun x -> x.Name, x) |> dict let executeMessage name value = let args = match value with | null -> [||] | x when FSharpType.IsTuple(x.GetType()) -> FSharpValue.GetTupleFields(x) | x -> [| x |] let msg = FSharpValue.MakeUnion(messageDictionary.Item(name), args) :?> 'msg model <- updateModel model msg let prevViewModel = viewModel viewModel <- createViewModel model // 変更のあるプロパティのPropertyChangedを発行 typeof<'vm>.GetProperties() |> Array.iter (fun x -> if x.GetValue(viewModel) <> x.GetValue(prevViewModel) then propertyChanged.Trigger(this, PropertyChangedEventArgs(x.Name)))
DataContext全コード
open System.ComponentModel open System.Windows.Input open System.Dynamic open System.Runtime.InteropServices open Microsoft.FSharp.Reflection type DataContext<'msg, 'm, 'vm>(initialModel : 'm, updateModel : 'm -> 'msg -> 'm, createViewModel : 'm -> 'vm) as this = inherit DynamicObject() let propertyChanged = Event<_, _>() let mutable model = initialModel let mutable viewModel = createViewModel model let propertyDictionary = typeof<'vm>.GetProperties() |> Array.map (fun x -> x.Name, x) |> dict let commandDictionary = let messageDictionary = FSharpType.GetUnionCases(typeof<'msg>) |> Array.map (fun x -> x.Name, x) |> dict let executeMessage name value = let args = match value with | null -> [||] | x when FSharpType.IsTuple(x.GetType()) -> FSharpValue.GetTupleFields(x) | x -> [| x |] let msg = FSharpValue.MakeUnion(messageDictionary.Item(name), args) :?> 'msg model <- updateModel model msg let prevViewModel = viewModel viewModel <- createViewModel model typeof<'vm>.GetProperties() |> Array.iter (fun x -> if x.GetValue(viewModel) <> x.GetValue(prevViewModel) then propertyChanged.Trigger(this, PropertyChangedEventArgs(x.Name))) let createCommand (msg:UnionCaseInfo) = { new ICommand with member this.CanExecute _ = true [<CLIEvent>] member this.CanExecuteChanged = Event<_, _>().Publish member this.Execute parameter = executeMessage msg.Name parameter } FSharpType.GetUnionCases(typeof<'msg>) |> Array.map (fun x -> x.Name, createCommand x) |> dict interface INotifyPropertyChanged with [<CLIEvent>] member this.PropertyChanged = propertyChanged.Publish override this.TryGetMember(binder : GetMemberBinder, [<Out>] result : obj byref) = if propertyDictionary.ContainsKey binder.Name then result <- propertyDictionary.Item(binder.Name).GetValue(viewModel) else result <- commandDictionary.Item(binder.Name) true
アプリケーション実装
上記のDataContextを利用すると、下記のような簡素なコードになります。
今回はViewModelが特別必要ではないのでcreateViewModelとしてid(入力をそのまま出力する)を渡しています。
<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" Title="MainWindow" Height="100" Width="215"> <Grid> <Button Content="-" Command="{Binding Decrement}" HorizontalAlignment="Left" Margin="46,23,0,0" VerticalAlignment="Top" Width="25"/> <TextBlock Text="{Binding Count}" HorizontalAlignment="Left" Margin="97,25,0,0" TextWrapping="Wrap" VerticalAlignment="Top"/> <Button Content="+" Command="{Binding Increment}" HorizontalAlignment="Left" Margin="132,23,0,0" VerticalAlignment="Top" Width="25"/> </Grid> </Window>
F#
type Msg = | Increment | Decrement type Model = { Count : int } let updateModel model msg = match msg with | Increment -> { model with Count = model.Count + 1 } | Decrement -> { model with Count = model.Count - 1 } [<STAThread>] [<EntryPoint>] let main argv = let window = Application.LoadComponent(Uri("MainWindow.xaml", UriKind.Relative)) :?> Window window.DataContext <- DataContext({ Count = 0 }, updateModel, id) Application().Run(window) |> ignore 0
ViewModelの入れ子構造
今回の実装ではViewModelの入れ子構造を考慮しておりません。実際の開発ではViewModelの中にViewModelがあることは多々ありますので、次のステップとして考慮すべき事項となります。
（深く考察してないですが、ViewModelのメンバにDataContextをセットで問題ない気がします。）
