SodiumでFunctional Reactive Programming (F#) --- WPF連携

下記記事ではコンソールアプリケーションにてSodiumを実装しました。
SodiumでFunctional Reactive Programming (F#) --- 導入 - 何でもプログラミング

今回はSodimuをWPFのMVVMに対応させたバージョンを実装します。

全体構造

CommandをStreamに、CellをPropertyChangeに変換するDataContextを実装します。

コンストラクタ引数

inputからoutputへ変換をする関数を渡します。

type DataContext<'input, 'output>(f : 'input -> 'output)

INotifyPropertyChangedの実装

let propertyChanged = Event<_, _>()
interface INotifyPropertyChanged with
    [<CLIEvent>]
    member this.PropertyChanged = propertyChanged.Publish

DynamicObjectの実装

今回はBinding用プロパティの動的作成にDynamicObjectを利用します。

InputDictionaryとOutputDictionaryは後程実装します。

inherit DynamicObject()
override this.TryGetMember(binder : GetMemberBinder, [<Out>] result : obj byref) = 
    if inputDictionary.ContainsKey binder.Name then
        result <- inputDictionary.Item(binder.Name)
    else 
        result <- outputDictionary.Item(binder.Name)
    true

input、inputDictionaryの作成

動的にGeneric関数を呼び出すためにcall関数を作成しています。

inputレコードは全てStreamクラスであることを想定しています。

inputの方情報からStreamSinkを作成し、そのStreamSinkのsendを呼ぶCommandを実装しています。

let call name t args =
    this.GetType().GetMethod(name).MakeGenericMethod([| t |]).Invoke(this, args)

let inputObjects = 
    FSharpType.GetRecordFields(typeof<'input>)
    |> Array.map (fun x -> x.Name, x.PropertyType.GetGenericArguments().[0])
    |> Array.map (fun (name, t) -> 
        let sink = (call "CreateSink" t [||])
        name, sink, (call "CreateCommand" t [| sink |]))

let inputDictionary =
    inputObjects
    |> Array.map (fun (name, _, command) -> name, command)
    |> dict

let input = 
    FSharpValue.MakeRecord(
        typeof<'input>,
        inputObjects |> Array.map (fun (_, sink, _) -> sink))
    :?> 'input

static member CreateSink<'a>() = Stream.sink<'a>()

static member CreateCommand<'a>(sink : StreamSink<'a>) =
    { new ICommand with
        member this.CanExecute _ = true
        [<CLIEvent>]
        member this.CanExecuteChanged = Event<_, _>().Publish 
        member this.Execute parameter = 
            let p = match parameter with
                    | null -> () :> obj
                    | x -> x
            Stream.send (p :?> 'a) sink }

outputDictionaryの作成

inputからoutputを作成し、各々のCellをlistenします。

outputレコードは全てCellクラスであることを想定しています。

let output = f input

let outputDictionary = System.Collections.Generic.Dictionary<string, obj>()

do  FSharpType.GetRecordFields(typeof<'output>)
    |> Array.map (fun x -> x.Name, x.PropertyType.GetGenericArguments().[0], x.GetValue(output))
    |> Array.iter (fun (name, t, cell) -> call "Listen" t [| cell; name |] |> ignore)

member this.Listen<'a>(cell : Cell<'a>, name : string) = 
    cell |>
    Cell.listen (fun x -> 
        outputDictionary.[name] <- x
        propertyChanged.Trigger(this, PropertyChangedEventArgs(name))) 

DataContextコード全体

open Sodium
open System.Dynamic
open System.ComponentModel
open System.Runtime.InteropServices
open Microsoft.FSharp.Reflection
open Microsoft.FSharp.Quotations.Patterns
open System.Windows.Input

type DataContext<'input, 'output>(f : 'input -> 'output) as this =
    inherit DynamicObject()
    let propertyChanged = Event<_, _>()

    let call name t args =
        this.GetType().GetMethod(name).MakeGenericMethod([| t |]).Invoke(this, args)

    let inputObjects = 
        FSharpType.GetRecordFields(typeof<'input>)
        |> Array.map (fun x -> x.Name, x.PropertyType.GetGenericArguments().[0])
        |> Array.map (fun (name, t) -> 
            let sink = (call "CreateSink" t [||])
            name, sink, (call "CreateCommand" t [| sink |]))

    let inputDictionary =
        inputObjects
        |> Array.map (fun (name, _, command) -> name, command)
        |> dict

    let input = 
        FSharpValue.MakeRecord(
            typeof<'input>,
            inputObjects |> Array.map (fun (_, sink, _) -> sink))
        :?> 'input

    let output = f input

    let outputDictionary = System.Collections.Generic.Dictionary<string, obj>()

    do  FSharpType.GetRecordFields(typeof<'output>)
        |> Array.map (fun x -> x.Name, x.PropertyType.GetGenericArguments().[0], x.GetValue(output))
        |> Array.iter (fun (name, t, cell) -> call "Listen" t [| cell; name |] |> ignore)

    static member CreateSink<'a>() = Stream.sink<'a>()

    static member CreateCommand<'a>(sink : StreamSink<'a>) =
        { new ICommand with
            member this.CanExecute _ = true
            [<CLIEvent>]
            member this.CanExecuteChanged = Event<_, _>().Publish 
            member this.Execute parameter = 
                let p = match parameter with
                        | null -> () :> obj
                        | x -> x
                Stream.send (p :?> 'a) sink }

    member this.Listen<'a>(cell : Cell<'a>, name : string) = 
        cell |>
        Cell.listen (fun x -> 
            outputDictionary.[name] <- x
            propertyChanged.Trigger(this, PropertyChangedEventArgs(name))) 

    override this.TryGetMember(binder : GetMemberBinder, [<Out>] result : obj byref) = 
        if inputDictionary.ContainsKey binder.Name then
            result <- inputDictionary.Item(binder.Name)
        else 
            result <- outputDictionary.Item(binder.Name)
        true

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

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

ボタンを押すとHelloがWorldに変わるアプリケーションになります。

アプリケーション実装

先ほど実装したDataContextを利用します。

F#でWPFを利用する方法は下記記事を参照してください。
F#でWPF --- ウィンドウ表示 - 何でもプログラミング

Xaml

<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
        Title="MainWindow" Height="100" Width="170">
    <Grid>
        <Button Command="{Binding SetWorld}" HorizontalAlignment="Left" Margin="15,23,0,0" VerticalAlignment="Top" Width="39" Height="20"/>
        <TextBlock Text="{Binding Text}" HorizontalAlignment="Left" Margin="80,25,0,0" TextWrapping="Wrap" VerticalAlignment="Top"/>
    </Grid>
</Window>

F#

open System
open System.Windows

type Input = { SetWorld : unit Stream }

type Output = { Text : string Cell }

let createOutput input = 
    let text = 
        input.SetWorld
        |> Stream.mapTo "World"
        |> Stream.hold "Hello"
    { Text = text }

[<STAThread>]
[<EntryPoint>]
let main argv = 
    let window = Application.LoadComponent(Uri("MainWindow.xaml", UriKind.Relative)) :?> Window

    window.DataContext <- DataContext(createOutput)

    Application().Run(window) |> ignore    

    0

入れ子のDataContext

今回の実装ではDataContextが入れ子になるケースを考慮していません。大きなアプリケーションで利用する際は入れ子構造を考慮したDataContextクラスを作成する必要があります。