我正在尝试创建一个类型提供程序,它可以生成类型并且不会删除它们。我使用了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 ()