読者です 読者をやめる 読者になる 読者になる

F#でWPF --- Elm Architectureを利用したMVVM

Elm F# MVVM WPF

下記の記事でMVVMを紹介しましたが、実装が冗長であるという問題がありました。
WPFにおけるMVVM - 何でもプログラミング

今回は下記記事で紹介しました、簡素な記述のできるElm ArchitectureをMVVMに適用します。
Elm --- Model、View、Update - 何でもプログラミング

作成するアプリケーション

いつも通りカウンタのアプリケーションを例に作成します。
f:id:any-programming:20170124004155p:plain

Elm Architectureのおさらい

f:id:any-programming:20170125012341p:plain

MVVMへ適用

Htmlオブジェクトを作る代わりに、ViewModelを作成する構造にします。またCommandをメッセージに変換します。

フレームワークがDataContextを作成するので、INotifyPropertyChangedやICommandを毎回実装する必要がなくなります。
f:id:any-programming:20170125013322p:plain

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 = if value = null then [||] 
                               else [| value |]
    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 = if value = null then [||] 
                                       else [| value |]
            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(入力をそのまま出力する)を渡しています。

Xaml

<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をセットで問題ない気がします。)