F#TypeProvider生成类型

时间:2013-11-16 15:42:50

标签: f# type-providers

我正在尝试创建一个类型提供程序,它可以生成类型并且不会删除它们。我使用了GeneratedTypeProvider示例并创建了自己的版本。

我试图完成的是生成某些类型(例如Fact),该类型具有一个类型及其属性的构造函数(例如Id,时间戳,名称)。我使用Element类型作为basetype。构造应该导致一个不可变的Fact-object。

如果我在一个已删除的变体中运行它一切都很好,但我没有得到Fact类型。当我创建非擦除版本(设置typesTy.IsErased< - false并将类型添加到提供的程序集提供的Assembly.AddTypes([typesTy]))时,它不再起作用。

我发现是一个额外的参数传递给我提供的构造函数的参数。这是事实类型。并且构造抱怨没有Fact的构造函数。但我提供的是Fact的建设者,包括它的属性。

我需要做些什么才能让它发挥作用?

到目前为止我的代码:

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 ()

0 个答案:

没有答案