F# --- TypeProvider --- DependencyProperty自動実装

下記記事にてTypeProviderを作成する方法を記述しました。
F# --- TypeProvider --- クイックスタート - 何でもプログラミング

今回は応用としてDependencyPropertyを自動実装するTypeProviderを作成してみます。

結果としてあまり実用的ではないものであるため、TypeProviderの実装方法の参考に利用してください。

作成するTypeProvider

パラメータは、ベースクラス名とプロパティ定義の二つの文字列になります。

プロパティ定義はスペース区切りで型と名前を記述します。

Typeを直接渡す方法がわからなかったため、文字列でのやり取りをしています。

もしTypeを渡す方法がわかりましたら追記いたします。

type MyControlBase = DependencyProperty.Base<"System.Windows.Controls.UserControl", 
                                             "System.Int32  Value1 
                                              System.Double Value2">


パラメータを受け取るTypeProviderの実装

今回は実際の型が必要なので、生成型のTypeProviderを作成します。

ProvidedTypeDefinitionのIsErasedをfalseに設定します。

let asm = Assembly.GetExecutingAssembly()
let ns = "DependencyProperty"
let defType = ProvidedTypeDefinition(asm, ns, "Base", None, IsErased = false)

do  defType.DefineStaticParameters(
        [ ProvidedStaticParameter("baseClass",  typeof<string>) 
            ProvidedStaticParameter("properties", typeof<string>) ],
        (fun typeName args -> // 型定義))

    this.AddNamespace(ns, [ defType ])


型の作成

こちらもIsErasedをfalseに設定します。

また型をdllに出力する必要があるため、ProvidedAssemblyで一時dllを指定します。(一つの型につき一つのdllを利用するため、利用する際はGetTempPath等を利用してください。)

文字列からの型検索は、現状5つのdllから行うようになっています。(この型検索は力技なので、よりよい方法が見つかれば追記いたします。)

let findType name = 
    [ typeof<System.Object>.Assembly                 // mscorlib
      typeof<System.Windows.Input.ICommand>.Assembly // System
      typeof<System.Windows.Point>.Assembly          // WindowsBase
      typeof<System.Windows.Media.Color>.Assembly    // PresentationCore
      typeof<FrameworkElement>.Assembly ]            // PresentationFramework
    |> Seq.map (fun x -> x.GetType(name))
    |> Seq.tryFind ((<>) null)
    |> function | Some x -> x
                | None   -> failwith (name + " doesn't exist")

let baseClass = findType (args.[0] :?> string)

let t = ProvidedTypeDefinition(asm, ns, typeName, Some baseClass, IsErased = false)
ProvidedAssembly("c:/src/temp.dll").AddTypes([ t ])


DependencyPropertyの定義

ProvidedFieldのIsStaticが読み取り専用のため、SetFieldAttributesでstaticに設定しています。

let properties =
    args.[1] :?> string
    |> fun x -> x.Split(Array.empty<char>, StringSplitOptions.RemoveEmptyEntries)
    |> Array.chunkBySize 2
    |> Array.map (fun x -> findType x.[0], x.[1])

let fields =
    properties
    |> Array.map (fun (_, name) -> 
        let field = ProvidedField(name + "Property", typeof<DependencyProperty>)
        field.SetFieldAttributes(FieldAttributes.Public ||| FieldAttributes.Static ||| FieldAttributes.InitOnly)               
        field)
t.AddMembers(fields |> Array.toList)


コンストラクタ定義

staticコンストラクタでDependencyPropertyを初期化します。

Expr.Sequentialを利用して逐次処理を表現します。

let staticCtor = ProvidedConstructor([], IsTypeInitializer = true)
staticCtor.InvokeCode <- fun _ -> 
    Array.zip properties fields
    |> Array.map (fun ((ty, name), field) -> Expr.FieldSet(field, <@@ DependencyProperty.Register(name, ty, t) @@>))
    |> Array.fold (fun s x -> Expr.Sequential(s, x)) <@@ () @@>
t.AddMember(staticCtor)

let ctor = ProvidedConstructor([], InvokeCode = fun _ -> <@@ () @@>)
t.AddMember(ctor);


プロパティ定義

Typeクラスでの型変換はExpr.Coerceを用います。

Array.zip properties fields
|> Array.iter (fun ((ty, name), field) -> 
    let property = ProvidedProperty(name, ty)
    property.GetterCode <- fun args ->
        Expr.Coerce(
            Expr.Call(
                Expr.Coerce(args.[0], typeof<DependencyObject>),
                typeof<DependencyObject>.GetMethod("GetValue"),
                [ Expr.FieldGet(field) ]),
            ty)
    property.SetterCode <- fun args ->
        Expr.Call(
            Expr.Coerce(args.[0], typeof<DependencyObject>),
            typeof<DependencyObject>.GetMethod("SetValue", [| typeof<DependencyProperty>; typeof<obj> |]),
            [ Expr.FieldGet(field); args.[1] ])
    t.AddMember(property) )


コード全体

namespace DependencyPropertyTypeProvider

open System
open System.Windows
open System.Reflection
open Microsoft.FSharp.Core.CompilerServices
open Microsoft.FSharp.Quotations
open ProviderImplementation.ProvidedTypes

[<TypeProvider>]
type DependencyPropertyTypeProvider() as this =
    inherit TypeProviderForNamespaces()
    let asm = Assembly.GetExecutingAssembly()
    let ns = "DependencyProperty"
    let defType = ProvidedTypeDefinition(asm, ns, "Base", None, IsErased = false)

    do  defType.DefineStaticParameters(
            [ ProvidedStaticParameter("baseClass",  typeof<string>) 
              ProvidedStaticParameter("properties", typeof<string>) ],
            (fun typeName args ->

                let findType name = 
                    [ typeof<System.Object>.Assembly                 // mscorlib
                      typeof<System.Windows.Input.ICommand>.Assembly // System
                      typeof<System.Windows.Point>.Assembly          // WindowsBase
                      typeof<System.Windows.Media.Color>.Assembly    // PresentationCore
                      typeof<FrameworkElement>.Assembly ]            // PresentationFramework
                    |> Seq.map (fun x -> x.GetType(name))
                    |> Seq.tryFind ((<>) null)
                    |> function | Some x -> x
                                | None   -> failwith (name + " doesn't exist")

                let baseClass = findType (args.[0] :?> string)

                let t = ProvidedTypeDefinition(asm, ns, typeName, Some baseClass, IsErased = false)
                ProvidedAssembly("c:/src/temp.dll").AddTypes([ t ])

                let properties =
                    args.[1] :?> string
                    |> fun x -> x.Split(Array.empty<char>, StringSplitOptions.RemoveEmptyEntries)
                    |> Array.chunkBySize 2
                    |> Array.map (fun x -> findType x.[0], x.[1])

                let fields =
                    properties
                    |> Array.map (fun (_, name) -> 
                        let field = ProvidedField(name + "Property", typeof<DependencyProperty>)
                        field.SetFieldAttributes(FieldAttributes.Public ||| FieldAttributes.Static ||| FieldAttributes.InitOnly)               
                        field)
                t.AddMembers(fields |> Array.toList)

                let staticCtor = ProvidedConstructor([], IsTypeInitializer = true)
                staticCtor.InvokeCode <- fun _ -> 
                    Array.zip properties fields
                    |> Array.map (fun ((ty, name), field) -> Expr.FieldSet(field, <@@ DependencyProperty.Register(name, ty, t) @@>))
                    |> Array.fold (fun s x -> Expr.Sequential(s, x)) <@@ () @@>
                t.AddMember(staticCtor)

                let ctor = ProvidedConstructor([], InvokeCode = fun _ -> <@@ () @@>)
                t.AddMember(ctor);

                Array.zip properties fields
                |> Array.iter (fun ((ty, name), field) -> 
                    let property = ProvidedProperty(name, ty)
                    property.GetterCode <- fun args ->
                        Expr.Coerce(
                            Expr.Call(
                                Expr.Coerce(args.[0], typeof<DependencyObject>),
                                typeof<DependencyObject>.GetMethod("GetValue"),
                                [ Expr.FieldGet(field) ]),
                            ty)
                    property.SetterCode <- fun args ->
                        Expr.Call(
                            Expr.Coerce(args.[0], typeof<DependencyObject>),
                            typeof<DependencyObject>.GetMethod("SetValue", [| typeof<DependencyProperty>; typeof<obj> |]),
                            [ Expr.FieldGet(field); args.[1] ])
                    t.AddMember(property) )

                t))

        this.AddNamespace(ns, [ defType ])

[<assembly:TypeProviderAssembly>]
do ()






F# --- TypeProvider --- クイックスタート

F#にはコンパイル時に型を生成するTypeProviderという仕組みがあります。
(実際にはインテリセンスを働かせるため、コンパイル時以外に逐次生成されています。)

今回は独自のTypeProviderを作成していきます。

作成するTypeProvider

指定した次数のベクトル型を作成するTypeProviderを実装していきます。

type Vector2 = Vectors.Vector<2>
let v = Vector2(1.0, 1.0)
let x = v.X1
let y = v.X2


dllプロジェクト作成

TypeProviderはdllとして作成しますので、F#のLibraryプロジェクトを作成します。

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

ProvidedTypes.fs

ProvidedTypes.fsを利用することにより、一から実装する必要がなくなります。

GitHubにて"FSharp.TypeProviders.StarterPack"として公開されていますので、そこからsrcの中のProvidedTypes.fsをコピーしてきます。
GitHub - fsprojects/FSharp.TypeProviders.StarterPack: The ProvidedTypes SDK for creating F# type providers

またNuGetでも取得することも可能です。

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

TypeProviderの定義

クラスにはTypeProvider属性を付与し、dllにはTypeProviderAssembly属性を付与します。

[<TypeProvider>]
type VectorTypeProvider() as this =
    inherit TypeProviderForNamespaces()
    // 実装

[<assembly:TypeProviderAssembly>]
do ()


パラメータを受け取るTypeProviderの実装

intを受け取るVectors.Vectorを定義しています。

ProvidedStaticParameterを増やせば、渡せるパラメータも増やせます。

let asm = Assembly.GetExecutingAssembly()
let ns = "Vectors"
let vectorType = ProvidedTypeDefinition(asm, ns, "Vector", None)

do  vectorType.DefineStaticParameters(
        [ ProvidedStaticParameter("dimensions", typeof<int>) ],
        (fun typeName args -> // 実装 ))
        
    this.AddNamespace(ns, [ vectorType ])


型の作成

double[]と定義しているのは、Vectorの要素の値を保存する場所を確保するためです。

TypeProviderには消去型と生成型の2パターンあり、今回は消去型を利用しています。

消去型では実際に新しい型が生成されるわけではなく、指定した型(ここでのdouble[])とオペレータが作成されます。(外側からは、あたかも新しい型ができたように見えます。しかしリフレクションなどでは期待した挙動とは異なります。)

let t = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<double[]>)


コンストラクタ作成

ProvidedParameterで引数を定義し、ProvidedConstructorのInvokeCodeにコンストラクタの挙動を定義します。

InvokeCodeには入力からExprを生成する関数を設定します。ここではコンストラクタのパラメータからdouble配列を作成しています。

let dimensions = args.[0] :?> int

let ctorParameters = 
    [ 1..dimensions ]
    |> List.map (fun x -> ProvidedParameter(sprintf "X%d" x, typeof<double>))
let ctor = 
    ProvidedConstructor(ctorParameters,
        InvokeCode = (fun args -> Quotations.Expr.NewArray(typeof<double>, args)))
t.AddMember(ctor)


プロパティ作成

double配列から値を取り出すプロパティを定義します。

挙動はGetterCodeに記述します。<@@ @@>で囲まれた区間はExprとして解釈されます。

%%をExprの先頭につけると値の様に扱うことができます。

ちなみに<@ @>や%はExpr<_>に用いることができます。

[ 1..dimensions ]
|> List.map (fun x -> 
    let property = ProvidedProperty(sprintf "X%d" x, typeof<double>)
    property.GetterCode <- (fun args -> <@@ (%%args.[0] : double[]).[x - 1] @@>)
    property)
|> List.iter t.AddMember


コード全体

namespace VectorTypeProvider

open Microsoft.FSharp.Core.CompilerServices
open ProviderImplementation.ProvidedTypes
open System.Reflection

[<TypeProvider>]
type VectorTypeProvider() as this =
    inherit TypeProviderForNamespaces()
    let asm = Assembly.GetExecutingAssembly()
    let ns = "Vectors"
    let vectorType = ProvidedTypeDefinition(asm, ns, "Vector", None)

    do  vectorType.DefineStaticParameters(
            [ ProvidedStaticParameter("dimensions", typeof<int>) ],
            (fun typeName args ->
                let dimensions = args.[0] :?> int
                let t = ProvidedTypeDefinition(asm, ns, typeName, Some typeof<double[]>)

                let ctorParameters = 
                    [ 1..dimensions ]
                    |> List.map (fun x -> ProvidedParameter(sprintf "X%d" x, typeof<double>))
                let ctor = 
                    ProvidedConstructor(ctorParameters,
                        InvokeCode = (fun args -> Quotations.Expr.NewArray(typeof<double>, args)))
                t.AddMember(ctor)

                [ 1..dimensions ]
                |> List.map (fun x -> 
                    let property = ProvidedProperty(sprintf "X%d" x, typeof<double>)
                    property.GetterCode <- (fun args -> <@@ (%%args.[0] : double[]).[x - 1] @@>)
                    property)
                |> List.iter t.AddMember

                t))
        
        this.AddNamespace(ns, [ vectorType ])

[<assembly:TypeProviderAssembly>]
do ()


利用側

このTypeProviderを利用するクラスはdllを参照に追加します。

しかし実行の際にはこのdllは必要ありません。





F#でWPF --- 可変個のコントロール --- 独自の条件で生成するコントロールを変更

下記記事にて、型でコントロールを分岐する実装をしました。
F#でWPF --- 可変個のコントロール --- 型で生成するコントロールを変更 - 何でもプログラミング

今回はユーザーが独自に定義した条件で分岐するよう実装します。

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

F#の判別共用体はXAMLのx:Typeで認識されないため、型による分岐ができません。

そこで今回は、判別共用体をバインドして図形を描画するアプリケーションを作成してみます。

type Shape =
    | Circle of Size : double
    | Square of Size : double

window.DataContext <- { Shapes = 
    [ Square(10.0); Circle(20.0); Square(30.0) ] }

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

DataTemplateSelector

独自の条件で分岐するにはDataTemplateSelectorを利用します。

SelectTemplateを実装し、ItemTemplateSelectorに設定します。

type MyDataTemplateSelector() =
    inherit DataTemplateSelector()
    override this.SelectTemplate(item, container) = // DataTemplate
<ItemsControl ItemsSource="{Binding Items}">
    <ItemsControl.ItemTemplateSelector>
        <local:MyDataTemplateSelector />
    </ItemsControl.ItemTemplateSelector>
    <ItemsControl.Resources>
        <DataTemplate x:Key="template1">
            <!-- Control -->
        </DataTemplate>
        <DataTemplate x:Key="template2">
            <!-- Control -->
        </DataTemplate>
    </ItemsControl.Resources>
</ItemsControl>


アプリケーションコード

XAML

<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
        xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
        xmlns:local="clr-namespace:DataTemplateSelectors;assembly=ShapeDataTemplateSelector"
        Title="MainWindow" Height="100" Width="140">
    <Grid>
        <ItemsControl ItemsSource="{Binding Shapes}">
            <ItemsControl.ItemTemplateSelector>
                <local:ShapeDataTemplateSelector />
            </ItemsControl.ItemTemplateSelector>
            <ItemsControl.ItemsPanel>
                <ItemsPanelTemplate>
                    <StackPanel Orientation="Horizontal" />
                </ItemsPanelTemplate>
            </ItemsControl.ItemsPanel>
            <ItemsControl.Resources>
                <DataTemplate x:Key="circleTemplate">
                    <Ellipse Width="{Binding Size}" Height="{Binding Size}" Fill="Orange" Margin="10" />
                </DataTemplate>
                <DataTemplate x:Key="squareTemplate">
                    <Rectangle Width="{Binding Size}" Height="{Binding Size}" Fill="Orange" Margin="10" />
                </DataTemplate>
            </ItemsControl.Resources>
        </ItemsControl>
    </Grid>
</Window>

DataTemplateSelectors.fs

namespace DataTemplateSelectors

open System.Windows
open System.Windows.Controls

type Shape =
    | Circle of Size : double
    | Square of Size : double

type ShapeDataTemplateSelector() =
    inherit DataTemplateSelector()
    override this.SelectTemplate(item, container) = 
        let templateName = 
            match item with
            | :? Shape as shape -> 
                match shape with
                | Circle _ -> "circleTemplate"
                | Square _ -> "squareTemplate" 
            | _ -> ""
        (container :?> FrameworkElement).FindResource(templateName) :?> DataTemplate

Program.fs

open System
open System.Windows
open DataTemplateSelectors

type ViewModel = { Shapes : Shape list }

[<STAThread>]
[<EntryPoint>]
let main argv = 
    let window = Application.LoadComponent(Uri("MainWindow.xaml", UriKind.Relative)) :?> Window
    window.DataContext <- { Shapes = 
        [ Square(10.0)
          Circle(20.0)
          Square(30.0) ] }
    Application().Run(window) |> ignore
    0


判別共用体のプロパティ

今回はCircleやRectangleのSizeをバインドして利用しました。

これは判別共用体のパラメータがプロパティとして現状解釈されているためであり、今後仕様が変わってバインディングに利用できなくなるかもしれません。





F#でWPF --- 好きな図形のコントロール作成 --- Geometry利用

下記記事にて好きな図形のコントロールを作成しました。
F#でWPF --- 好きな図形のコントロール作成 - 何でもプログラミング

その際、独自のヒットテストを実装しようとすると、ロジックを一から実装しなければなりませんでした。

今回はGeometryクラスを用いてヒットテストの実装を楽にしてみます。

描画する図形

前記事と同じ図形を描画します。
f:id:any-programming:20170221002105p:plain

CustomShape

Geometryを定義し、描画の際はDrawGeometryを利用し、ヒットテストの際はStrokeContains(もしくはFillContains)を利用します。

HitTestDisabledDrawingVisualは前記事を参照してください。

type CustomShape() =
    inherit FrameworkElement()
    let visual = HitTestDisabledDrawingVisual()
    let lines  = [ LineGeometry(Point(15.0, 15.0), Point(85.0, 85.0))
                   LineGeometry(Point(85.0, 15.0), Point(15.0, 85.0)) ]
    let circle = EllipseGeometry(Point(50.0, 50.0), 50.0, 50.0)
    let pen = Pen(Brushes.Red, 5.0)
    let group = DrawingGroup()    
    do  use g = visual.RenderOpen()
        lines |> List.iter (fun x -> g.DrawGeometry(null, pen, x))
        g.DrawGeometry(null, pen, circle)

    override this.VisualChildrenCount = 1

    override this.GetVisualChild _ = visual :> Visual

    override this.HitTestCore(hitTestParameters : PointHitTestParameters) =         
        if lines |> List.exists (fun x -> x.StrokeContains(pen, hitTestParameters.HitPoint)) ||
           circle.StrokeContains(pen, hitTestParameters.HitPoint) then
            PointHitTestResult(this, hitTestParameters.HitPoint) :> HitTestResult
        else
            null :> HitTestResult


動的に描画内容を変更

前記事と同じく、DrawingGroupクラスを間に介入させることにより、動的に図形を変更することが可能です。

let group = DrawingGroup()
do  use g = visual.RenderOpen()
    g.DrawDrawing(group)

...
use g = group.Open()
g.DrawGeometry(geometry)






F#でWPF --- 好きな図形のコントロール作成

下記記事ではXAML上でPathを使って好きな図形を描きました。
XAMLで好きな形を描く - 何でもプログラミング

今回はコード側でコントロールを作成してみます。

作成する図形

Pathの時と同様の図形のコントロールを作成します。
f:id:any-programming:20170221002105p:plain

DrawingVisual

Frameworkを継承し、内部でDrawingVisualを利用しています。

AddLogicalChild、AddVisualChildをすることにより、描画部分がマウスイベントを発行するようになります。

open System.Windows
open System.Windows.Media

type CustomShape() as this =
    inherit FrameworkElement()
    let visual = DrawingVisual()
    do  use g = visual.RenderOpen()
        let pen = Pen(Brushes.Red, 5.0)
        g.DrawLine(pen, Point(15.0, 15.0), Point(85.0, 85.0))
        g.DrawLine(pen, Point(85.0, 15.0), Point(15.0, 85.0))
        g.DrawEllipse(null, pen, Point(50.0, 50.0), 50.0, 50.0)

        this.AddLogicalChild(visual)
        this.AddVisualChild(visual)

    override this.VisualChildrenCount = 1

    override this.GetVisualChild _ = visual :> Visual


図形を動的に変更

依存プロパティ等によって図形を動的に変える場合、その都度RenderOpenしても更新されません。

間にDrawingGroupを挟むことにより可能となります。

コンストラクタ

let visual = DrawingVisual()
let group = DrawingGroup()
do  use g = visual.RenderOpen()
    g.DrawDrawing(group)

図形更新

use g = group.Open() 
// g.Draw...


独自のヒットテスト

HitTestCoreをoverrideすることにより、独自のヒットテストを実行することができます。

有効の場合はPointHitTestResultを、無効の場合はnullを返します。

現在の実装のままではDrawingVisualがHitTestを処理してしまうため、新たにHitTestDisabledDrawingVisualを用意します。

AddLogicalChildとAddVisualChildはこの場合必要ありません。

type HitTestDisabledDrawingVisual() =
    inherit DrawingVisual()
    override this.HitTestCore(hitTestParameters : PointHitTestParameters) = null :> HitTestResult

type CustomShape() as this =
    inherit FrameworkElement()
    let visual = HitTestDisabledDrawingVisual()

    ...

    // this.AddLogicalChild(visual)
    // this.AddVisualChild(visual)    

    ...

    override this.HitTestCore(hitTestParameters : PointHitTestParameters) = 
        PointHitTestResult(this, hitTestParameters.HitPoint) :> HitTestResult






XAMLで好きな形を描く

WPFのShapeの一つにPathというものがあります。

名前だけだとPolylineのような感じがしますが、色々なものが描画できます。

パスマークアップ

HtmlのSVGでも採用されている図形描画用の構文です。

例えば以下の図形を描くには下記のようなコードになります。

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

<Path Data="M15,15 L85,85 M85,15 L15,85 M50,0 A50,50 0 0 0 50,100 A50,50 0 0 0 50,0" Stroke="Red" StrokeThickness="5" />


Dataの中身を詳しく

M15,15 L85,85

(15, 15)へ移動して(85, 85)まで線を引く
f:id:any-programming:20170221002947p:plain
M85,15 L15,85

(85, 15)へ移動して(15, 85)まで線を引く
f:id:any-programming:20170221004052p:plain
M50,0 A50,50 0 0 0 50,100

(50, 0)へ移動して半径50の円弧を(50, 100)まで描く
f:id:any-programming:20170221004146p:plain
A50,50 0 0 0 50,0

現在の位置(50, 100)から半径50の円弧を(50, 0)まで描く
f:id:any-programming:20170221002105p:plain


マウスイベント

マウスイベントも描画されたところのみ発行されるようになっています。

その他の図形

H 横線
V 縦線
Q, T 2次ベジエ曲線
C, S 3次ベジエ曲線






F#でWPF --- 階層構造表示

今回はTreeViewを利用して階層構造のデータを表示してみます。

HierarchicalDataTemplate

基本的にはDataTemplateにItemsSourceが加わったのものです。

ItemsSourceに子供の要素を保持しているプロパティをバインドします。

DataTemplateに関しては下記記事を参照してください。
F#でWPF --- 可変個のコントロール --- 型で生成するコントロールを変更 - 何でもプログラミング

<TreeView ItemsSource="{Binding Items}" Margin="10,10,10,35">
    <TreeView.Resources>
        <HierarchicalDataTemplate DataType="{x:Type MyClass}" ItemsSource="{Binding Children}">
            <!-- Control -->
        </HierarchicalDataTemplate>
    </TreeView.Resources>
</TreeView>


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

フォルダダイアログで選択したフォルダ内のファイル構造を表示するアプリケーションです。

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

File、Folder

DataTemplateで型で分岐させるため、ファイル及びフォルダの情報を持つクラスを定義します。

また階層構造を作成する関数も定義します。

namespace FileTree

[<AbstractClass>]
type FileOrFolder(name : string) =
    member this.Name = name

type File(name : string) =
    inherit FileOrFolder(name)

type Folder(name : string, children : FileOrFolder list) =
    inherit FileOrFolder(name)
    member this.Children = children

[<CompilationRepresentation (CompilationRepresentationFlags.ModuleSuffix)>]
module Folder =
    open System.IO
    let rec create path =
        let name = Path.GetFileName(path)
        let files = 
            Directory.EnumerateFiles(path) 
            |> Seq.map (Path.GetFileName >> File)
            |> Seq.cast<FileOrFolder>
        let folders = 
            Directory.EnumerateDirectories(path) 
            |> Seq.map create
            |> Seq.cast<FileOrFolder>
        Folder(name, files |> Seq.append folders |> Seq.toList)


アプリケーションコード

DataTemplateの時と同様に、Resourcesの中にHierarchicalDataTemplateを定義します。

ファイルとフォルダのアイコンは、Material Design Iconsのものを利用しています。

XAML内のFolderDialogActionは下記記事を参照してください。
F#でWPF --- フォルダダイアログCommand - 何でもプログラミング

F#内のDataContextクラスは下記記事を参照してください。
F#でWPF --- Elm Architectureを利用したMVVM - 何でもプログラミング


XAML

<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
        xmlns:i="clr-namespace:System.Windows.Interactivity;assembly=System.Windows.Interactivity" 
        xmlns:local="clr-namespace:FileTree;assembly=FileTree"
        xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
        Title="MainWindow" Height="200" Width="200">
    <Grid>
        <TreeView ItemsSource="{Binding FileOrFolders}" Margin="10,10,10,35">
            <TreeView.Resources>
                <HierarchicalDataTemplate DataType="{x:Type local:Folder}" ItemsSource="{Binding Children}">
                    <StackPanel Orientation="Horizontal">
                        <Viewbox Width="16" Height="16">
                            <Path Data="M20,18H4V8H20M20,6H12L10,4H4C2.89,4 2,4.89 2,6V18A2,2 0 0,0 4,20H20A2,2 0 0,0 22,18V8C22,6.89 21.1,6 20,6Z" Fill="Black" />
                        </Viewbox>
                        <TextBlock Text="{Binding Name}" Margin="5,0,0,0" />
                    </StackPanel>
                </HierarchicalDataTemplate>
                <DataTemplate DataType="{x:Type local:File}">
                    <StackPanel Orientation="Horizontal">
                        <Viewbox Width="16" Height="16">
                            <Path Data="M13,9H18.5L13,3.5V9M6,2H14L20,8V20A2,2 0 0,1 18,22H6C4.89,22 4,21.1 4,20V4C4,2.89 4.89,2 6,2M11,4H6V20H11L18,20V11H11V4Z" Fill="Black" />
                        </Viewbox>
                        <TextBlock Text="{Binding Name}" Margin="5,0,0,0" />
                    </StackPanel>
                </DataTemplate>
            </TreeView.Resources>
        </TreeView>
        <Button Content="フォルダを開く" HorizontalAlignment="Right" Margin="0,0,10,10" VerticalAlignment="Bottom" Width="75">
            <i:Interaction.Triggers>
                <i:EventTrigger EventName="Click">
                    <local:FolderDialogAction Command="{Binding OpenFolder}" />
                </i:EventTrigger>
            </i:Interaction.Triggers>
        </Button>
    </Grid>
</Window>

F#

open System
open System.Windows
open FileTree

type Msg = OpenFolder of string

type Model = { FileOrFolders : FileOrFolder list }

let initialModel = { FileOrFolders = [] }

let updateModel model msg =
    match msg with
    | OpenFolder x ->
        { model with FileOrFolders = [ Folder.create x ] }

[<STAThread>]
[<EntryPoint>]
let main argv = 
    let window = Application.LoadComponent(Uri("MainWindow.xaml", UriKind.Relative)) :?> Window
    window.DataContext <- DataContext(initialModel, updateModel, id)
    Application().Run(window) |> ignore       
    0