F#でWPF --- Elm Architectureで実装されたUserControl
あるアプリケーションを作成した後に、それをコントロール化して更に大きなアプリケーションを作成したい時があります。
今回は、下記記事で作成したカウンタアプリケーションをコントロール化してみたいと思います。
F#でWPF --- Elm Architectureを利用したMVVM - 何でもプログラミング
アプリケーションコード
Counterコントロールは、表示する値の"Value"と、値が変更されたときのコマンド"ValueChanged"からなります。
IncrementなのかDecrementなのかは、ユーザーは気にする必要はありません。
F#側は送られてきた値を保持して、Valueに通知しているだけです。
以降は、これを実現するCounterを作っていきます。
Xaml
<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:local="clr-namespace:WPFApplication;assembly=WPFApplication" Title="MainWindow" Height="100" Width="200"> <Grid> <local:Counter Value="{Binding Value}" ValueChanged="{Binding SetValue}" Margin="10" Height="23" /> </Grid> </Window>
F#
type Model = { Value : int } let initialModel = { Value = 0 } type Msg = SetValue of int let update model msg = match msg with | SetValue x -> { Value = x }
Counter(Xaml)
Xamlは下記のように定義しました。
UserControlのContentに代入するため、外枠はGridで定義してあります。
また、コントロールとしてMainWindow.xamlに貼り付けた際にデザイナーでエラーが発生しないよう、ビルドアクションを埋め込みリソースにしておきます。
<Grid xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:d="http://schemas.microsoft.com/expression/blend/2008" mc:Ignorable="d" d:DesignHeight="23" d:DesignWidth="200"> <Grid.ColumnDefinitions> <ColumnDefinition Width="23"/> <ColumnDefinition Width="*"/> <ColumnDefinition Width="23"/> </Grid.ColumnDefinitions> <Button Command="{Binding Decrement}" Content="◀" Grid.Column="0" /> <TextBox Text="{Binding Count}" Grid.Column="1" IsReadOnly="True" TextAlignment="Center" VerticalContentAlignment="Center" /> <Button Command="{Binding Increment}" Content="▶" Grid.Column="2" /> </Grid>
Counter(F#)
最終的なCounterクラスは下記のようになります。
以降、順を追って説明していきます。
type CounterModel = { Count : int } let initialCounterModel = { Count = 0 } type CounterMsg = | Increment | Decrement | SetCount of int type Counter() as this = inherit UserControl() static let value = DependencyProperty<Counter, int>() static let valueChanged = DependencyProperty<Counter, ICommand>() let update model msg = match msg with | Increment -> model, Post.Command(valueChanged.Get(this), model.Count + 1) | Decrement -> model, Post.Command(valueChanged.Get(this), model.Count - 1) | SetCount x -> { Count = x }, Post.None do this.Start("Counter.xaml", DataContext(initialCounterModel, update, id), (value, SetCount)) static member val ValueProperty = value.Register() member this.Value with get() = value.Get(this) and set(x) = value.Set(this, x) static member val ValueChangedProperty = valueChanged.Register() member this.ValueChanged with get() = valueChanged.Get(this) and set(x) = valueChanged.Set(this, x)
まずはDependencyPropertyを作成します。
コード内のDependencyProperty<_, _>クラスは下記記事を参照してください。
DependencyProperty定義の記述量削減(F#) - 何でもプログラミング
static let value = DependencyProperty<Counter, int>() static let valueChanged = DependencyProperty<Counter, ICommand>() static member val ValueProperty = value.Register() member this.Value with get() = value.Get(this) and set(x) = value.Set(this, x) static member val ValueChangedProperty = valueChanged.Register() member this.ValueChanged with get() = valueChanged.Get(this) and set(x) = valueChanged.Set(this, x)
続いてロジック部分を実装します。
アプリケーションの時と異なり、UIからのコマンド内でアプリケーション側のコマンドを呼びだしています。(Increment、Decrement)
またアプリケーション側からValue変更通知があった時にCountを更新しています。(SetCount)(Value変更通知とSetCountの接続は後ほど行います。)
アプリケーション側のコマンドを呼び出すために、DataContextクラスをPostを受け取るように変更しました。
type CounterModel = { Count : int } let initialCounterModel = { Count = 0 } type CounterMsg = | Increment | Decrement | SetCount of int let update model msg = match msg with | Increment -> model, Post.Command(valueChanged.Get(this), model.Count + 1) | Decrement -> model, Post.Command(valueChanged.Get(this), model.Count - 1) | SetCount x -> { Count = x }, Post.None
type Post = | None | Command of ICommand * obj type DataContext<'msg, 'm, 'vm>(initialModel : 'm, updateModel : 'm -> 'msg -> 'm * Post, 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 let updated = updateModel model msg model <- fst updated 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))) // View更新後の処理(Commandの呼び出し) match snd updated with | None -> () | Command(command, parameter) -> if command <> null then command.Execute(parameter) 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 // Post処理がない時用のコンストラクタ new(initialModel, updateModel : 'm -> 'msg -> 'm, createViewModel) = DataContext(initialModel, (fun x y -> updateModel x y, Post.None), createViewModel) 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
最後に、Xamlを読み込んでDataContextをセットし、それをUserControlのContentにセットして、さらにDependencyPropertyとMsgの接続を行う関数を定義します。
対象のMsgを呼び出すところは、もう少しスマートに記述できるかもしれません。
type UserControl with member this.Start(xamlPath : string, dataContext : DataContext<'msg, 'm, 'vm>, [<ParamArray>] maps : (DependencyProperty<'owner, 'value> * ('value -> 'msg))[]) = let grid = loadEmbeddedXaml<Grid> xamlPath grid.DataContext <- dataContext this.Content <- grid maps |> Array.iter (fun (property, msg) -> property.Changed(this :?> 'owner).Add(fun x -> dataContext.TryGetMember(SimpleGetMemberBinder(caseName (msg x))) |> snd :?> ICommand |> (fun c -> c.Execute(x))))
let loadEmbeddedXaml<'a> fileName = Assembly.GetExecutingAssembly().GetManifestResourceStream(fileName) |> XamlReader.Load :?> 'a let caseName (x : obj) = FSharpValue.GetUnionFields(x, x.GetType()) |> fst |> (fun x -> x.Name) type SimpleGetMemberBinder(name) = inherit GetMemberBinder(name, false) override this.FallbackGetMember(target, errorSuggestion) = raise (NotImplementedException())