F # TypeProvider Generating Types

Question

I am trying to create a type provider that generates types and does not delete them. I used the GeneratedTypeProvider example and made my own version.

What I'm trying to do is that some type generates (like a fact) that has one constructor for the type and its properties (like Id, timestamp, name). I use the element type as the base type. The design should lead to an immutable fact object.

If I run it in an erasable version, everything will be fine, but I do not get the Fact type. When I make a non-erased version (setting Ty.IsErased <- false types and adding a type to the provided assembly provided by Assembly.AddTypes ([typesTy])), it no longer works.

I found that an extra argument is passed to the arguments to the constructor that I am providing. This is a type of fact. And the structure complains that for Fact there is no constructor. But what I provide is a constructor for Fact, including its properties.

What do I need to do to make this work?

My code is:

type Element(values: obj []) =
    let propertyMap = new Map<int, obj>(values |> Seq.mapi (fun i value -> (i, value)))
    member this.GetValue propertyIndex : obj = 
        match propertyMap.TryFind propertyIndex with
        | Some(value) -> value
        | None        -> box "property not found"

let private typeOf elementType =
    match elementType with
    | "String"   -> typeof<string>
    | "Guid"     -> typeof<System.Guid>
    | "DateTime" -> typeof<System.DateTime>
    | _ -> typeof<string>

let internal makeTypeWith thisAssembly namespaceName group entityName = 

    let entityType = 
        ProvidedTypeDefinition(thisAssembly, namespaceName,
                                entityName,
                                baseType = Some typeof<Element>)
    entityType.AddXmlDocDelayed (fun () -> sprintf "This %s" entityName)

    let properties = [("Id", "Guid"); ("Timestamp", "DateTime"); ("Name", "String")] 
    let fieldsOfProperties =
        properties 
        |> List.iteri (fun index (propertyName, propertyType) ->
            let instanceProp = 
                ProvidedProperty(propertyName = propertyName, 
                                 propertyType = typeOf propertyType, 
                                 GetterCode = (fun args -> <@@ unbox ((%%(args.[0]) : Element).GetValue index) @@>))
            instanceProp.AddXmlDocDelayed(fun () -> sprintf "%s" propertyName)
            entityType.AddMember instanceProp)

    let typeConstructor = 
        ProvidedConstructor(
            parameters = 
                (properties 
                    |> List.mapi (fun index (name, typ) -> ProvidedParameter(parameterName = name, parameterType = typeOf typ))),
            InvokeCode = 
                (fun args ->  
                    let boxedArgs = 
                        args |> List.map (fun arg -> 
                            match arg with
                            | Quotations.Patterns.Var var -> 
                                if var.Type = typeof<int> then 
                                    <@@ (box (%%arg: int)) @@>
                                else if var.Type = typeof<string> then 
                                    <@@ (box (%%arg: string)) @@>
                                else if var.Type = typeof<System.Guid> then 
                                    <@@ (box (%%arg: System.Guid)) @@>
                                else if var.Type = typeof<System.DateTime> then 
                                    <@@ (box (%%arg: System.DateTime)) @@>
                                else 
                                    let argsVals = 
                                        args |> List.map (fun arg -> 
                                            match arg with
                                            | Quotations.Patterns.Var var -> var.Type.ToString()
                                            | _ -> "unknown")
                                        |> List.reduce (fun all arg -> all + ", " + arg)                                                
                                    failwith ("Aha: " + argsVals)
                            | _ -> failwith ("Unknown Expr as parameter"))
                    <@@ Element(%%(Expr.NewArray(typeof<obj>, boxedArgs))) :> obj @@>))

    typeConstructor.AddXmlDocDelayed(fun () -> "This is the constructor")
    entityType.AddMember typeConstructor
    entityType

[<TypeProvider>]
type public DataLayerProvider(cfg:TypeProviderConfig) as this =
    inherit TypeProviderForNamespaces()

    let thisAssembly =  Assembly.GetExecutingAssembly()
    let rootNamespace = "Types"
    let providedAssembly = new ProvidedAssembly(System.IO.Path.ChangeExtension(System.IO.Path.GetTempFileName(), ".dll"))


    let typesTy = makeTypeWith thisAssembly rootNamespace "Some" "Fact"

    do 
        typesTy.IsErased <- false
        providedAssembly.AddTypes([typesTy])

    do System.AppDomain.CurrentDomain.add_AssemblyResolve(fun _ args ->
        let name = System.Reflection.AssemblyName(args.Name)
        let existingAssembly = 
            System.AppDomain.CurrentDomain.GetAssemblies()
            |> Seq.tryFind(fun a -> System.Reflection.AssemblyName.ReferenceMatchesDefinition(name, a.GetName()))
        match existingAssembly with
        | Some a -> a
        | None -> null)

    do this.AddNamespace(rootNamespace, [typesTy])


[<TypeProviderAssembly>]
do ()