TypeProvider blog post

Part1.fs

module Mavnn.Blog.TypeProvider

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

[<TypeProvider>]
type MavnnProvider (config : TypeProviderConfig) as this =
    inherit TypeProviderForNamespaces ()

[<assembly:TypeProviderAssembly>]
do ()

Part10.fs

let nodeType = ProvidedTypeDefinition(asm, ns, node.Id.Name, Some typeof<nodeInstance>)
let ctor = ProvidedConstructor(
            [
                ProvidedParameter("Name", typeof<string>)
                ProvidedParameter("UniqueId", typeof<Guid>)
                ProvidedParameter("Config", typeof<string>)
            ],
            InvokeCode = fun [name;unique;config] -> <@@ NodeInstance.create (GetNode id) (%%name:string) (%%unique:Guid) (%%config:string) @@>)

Part11.fs

// Check out the excellent article at F# for Fun and Profit
// on using single case Discriminated Unions for data modelling
// http://fsharpforfunandprofit.com/posts/designing-with-types-single-case-dus/

type InputPort = | InputPort of Port
type OutputPort = | OutputPort of Port

Part12.fs

let addInputPort (inputs : ProvidedTypeDefinition) (port : Port) =
    let port = ProvidedProperty(
                    port.Id.Name, 
                    typeof<InputPort>, 
                    GetterCode = fun args -> 
                        let id = port.Id.UniqueId.ToString()
                        <@@ GetPort id @@>)
    inputs.AddMember(port)

let addOutputPort (outputs : ProvidedTypeDefinition) (port : Port) =
    let port = ProvidedProperty(
                    port.Id.Name, 
                    typeof<OutputPort>, 
                    GetterCode = fun args -> 
                        let id = port.Id.UniqueId.ToString()
                        <@@ GetPort id @@>)
    outputs.AddMember(port)

let addPorts inputs outputs (portList : seq<Port>) =
    portList
    |> Seq.iter (fun port -> 
                    match port.Type with
                    | "input" -> addInputPort inputs port
                    | "output" -> addOutputPort outputs port
                    | _ -> failwithf "Unknown port type for port %s/%s" port.Id.Name (port.Id.UniqueId.ToString()))

let createNodeType id (node : Node) =
    let nodeType = ProvidedTypeDefinition(asm, ns, node.Id.Name, Some typeof<nodeInstance>)
    let ctor = ProvidedConstructor(
                [
                    ProvidedParameter("Name", typeof<string>)
                    ProvidedParameter("UniqueId", typeof<Guid>)
                    ProvidedParameter("Config", typeof<string>)
                ],
                InvokeCode = fun [name;unique;config] -> <@@ NodeInstance.create (GetNode id) (%%name:string) (%%unique:Guid) (%%config:string) @@>)
    nodeType.AddMember(ctor)

    let outputs = ProvidedTypeDefinition("Outputs", Some typeof<obj>)
    let outputCtor = ProvidedConstructor([], InvokeCode = fun args -> <@@ obj() @@>)
    outputs.AddMember(outputCtor)
    outputs.HideObjectMethods <- true

    let inputs = ProvidedTypeDefinition("Inputs", Some typeof<obj>)
    let inputCtor = ProvidedConstructor([], InvokeCode = fun args -> <@@ obj() @@>)
    inputs.AddMember(inputCtor)
    inputs.HideObjectMethods <- true
    addPorts inputs outputs node.Ports

    // Add the inputs and outputs types of nested types under the Node type
    nodeType.AddMembers([inputs;outputs])

    // Now add some instance properties to expose them on a node instance.
    let outputPorts = ProvidedProperty("OutputPorts", outputs, [],
                        GetterCode = fun args -> <@@ obj() @@>)
    let inputPorts = ProvidedProperty("InputPorts", inputs, [],
                        GetterCode = fun args -> <@@ obj() @@>)

    nodeType.AddMembers([inputPorts;outputPorts])

    nodeType

Part13.fs

let private nodes = JsonConvert.DeserializeObject<seq<Node>>(IO.File.ReadAllText(@"c:\Temp\Graph.json"))
                    |> Seq.map (fun n -> n.Id.UniqueId.ToString(), n)
                    |> Map.ofSeq

let GetNode id =
    nodes.[id]

let private ports =
    nodes
    |> Map.toSeq
    |> Seq.map (fun (_, node) -> node.Ports)
    |> Seq.concat
    |> Seq.map (fun p -> p.Id.UniqueId.ToString(), p)
    |> Map.ofSeq

let GetPort id =
    ports.[id]

Part2.fs

module Mavnn.Blog.TypeProvider

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

[<TypeProvider>]
type MavnnProvider (config : TypeProviderConfig) as this =
    inherit TypeProviderForNamespaces ()

    let ns = "Mavnn.Blog.TypeProvider.Provided"
    let asm = Assembly.GetExecutingAssembly()

    let createTypes () =
        let myType = ProvidedTypeDefinition(asm, ns, "MyType", Some typeof<obj>)
        let myProp = ProvidedProperty("MyProperty", typeof<string>, IsStatic = true, 
                                        GetterCode = (fun args -> <@@ "Hello world" @@>))
        myType.AddMember(myProp)
        [myType]

    do
        this.AddNamespace(ns, createTypes())

[<assembly:TypeProviderAssembly>]
do ()

Part3.fsx

// Your path may vary...
#r @"../../Mavnn.Blog.TypeProvider/Mavnn.Blog.TypeProvider/bin/Debug/Mavnn.Blog.TypeProvider.dll"

open Mavnn.Blog.TypeProvider.Provided

// Type `MyType.MyProperty` on next line down.

Part4.fs

    let createTypes () =
        let myType = ProvidedTypeDefinition(asm, ns, "MyType", Some typeof<obj>)
        let myProp = ProvidedProperty("MyProperty", typeof<string>, IsStatic = true, 
                                        GetterCode = fun args -> <@@ "Hello world" @@>)
        myType.AddMember(myProp)

        let ctor = ProvidedConstructor([], InvokeCode = fun args -> <@@ "My internal state" :> obj @@>)
        myType.AddMember(ctor)

        let ctor2 = ProvidedConstructor(
                        [ProvidedParameter("InnerState", typeof<string>)],
                        InvokeCode = fun args -> <@@ (%%(args.[0]):string) :> obj @@>)
        myType.AddMember(ctor2)

        let innerState = ProvidedProperty("InnerState", typeof<string>,
                            GetterCode = fun args -> <@@ (%%(args.[0]) :> obj) :?> string @@>)
        myType.AddMember(innerState)

        [myType]
        
    do
        this.AddNamespace(ns, createTypes())

Part5.fsx

// Your path may vary...
#r @"../../Mavnn.Blog.TypeProvider/Mavnn.Blog.TypeProvider/bin/Debug/Mavnn.Blog.TypeProvider.dll"

open Mavnn.Blog.TypeProvider.Provided

let thing = MyType()
let thingInnerState = thing.InnerState

let thing2 = MyType("Some other text")
let thing2InnerState = thing2.InnerState

// val thing : Mavnn.Blog.TypeProvider.Provided.MyType = "My internal state"
// val thingInnerState : string = "My internal state"
// val thing2 : Mavnn.Blog.TypeProvider.Provided.MyType = "Some other text"
// val thing2InnerState : string = "Some other text"

Part6.json

[
   {
      "Id":{
         "Name":"Simple",
         "UniqueId":"0ab82262-0ad3-47d3-a026-615b84352822"
      },
      "Ports":[
         {
            "Id":{
               "Name":"Input",
               "UniqueId":"4b69408e-82d2-4c36-ab78-0d2327268622"
            },
            "Type":"input"
         },
         {
            "Id":{
               "Name":"Output",
               "UniqueId":"92ae5a96-6900-4d77-832f-d272329f8a90"
            },
            "Type":"output"
         }
      ]
   },
   {
      "Id":{
         "Name":"Join",
         "UniqueId":"162c0981-4370-4db3-8e3f-149f13c001da"
      },
      "Ports":[
         {
            "Id":{
               "Name":"Input1",
               "UniqueId":"c0fea7ff-456e-4d4e-b5a4-9539ca134344"
            },
            "Type":"input"
         },
         {
            "Id":{
               "Name":"Input2",
               "UniqueId":"4e93c3b1-11bc-422a-91b8-e53204368714"
            },
            "Type":"input"
         },
         {
            "Id":{
               "Name":"Output",
               "UniqueId":"fb54728b-9602-4220-ba08-ad160d92d5a4"
            },
            "Type":"output"
         }
      ]
   },
   {
      "Id":{
         "Name":"Split",
         "UniqueId":"c3e44941-9182-41c3-921c-863a82097ba8"
      },
      "Ports":[
         {
            "Id":{
               "Name":"Input",
               "UniqueId":"0ec2537c-3346-4503-9f5a-d0bb49e9e431"
            },
            "Type":"input"
         },
         {
            "Id":{
               "Name":"Output1",
               "UniqueId":"77b5a50c-3d11-4a67-b14d-52d6246e78c5"
            },
            "Type":"output"
         },
         {
            "Id":{
               "Name":"Output2",
               "UniqueId":"d4d1e928-5347-4d51-be54-8650bdfe9bac"
            },
            "Type":"output"
         }
      ]
   }
]

Part7.fs

type Id () =
    member val UniqueId = Guid() with get, set
    member val Name = "" with get, set

type Port () =
    member val Id = Id() with get, set
    member val Type = "" with get, set

type Node () =
    member val Id = Id() with get, set
    member val Ports = Collections.Generic.List<Port>() with get, set

Part8.fs

let nodes =
    JsonConvert.DeserializeObject<seq<Node>>(IO.File.ReadAllText(@"c:\Temp\Graph.json"))

Part9.fs

type nodeInstance =
    {
        Node : Node
        InstanceId : Id
        Config : string
    }

module private NodeInstance =
    let create node name guid config =
        { Node = node; InstanceId = Id(Name = name, UniqueId = guid); Config = config }