Update debug output to increase legibility
This commit is contained in:
7sharp9
Родитель
c9db8f460b
Коммит
7a90a325bb
|
|
@ -17,9 +17,6 @@ open ProviderImplementation.ProvidedTypes
|
|||
|
||||
module Debug =
|
||||
|
||||
/// Converts a sequence of strings to a single string separated with the delimiters
|
||||
let inline private separatedBy delimiter (items: string seq) = String.Join(delimiter, Array.ofSeq items)
|
||||
|
||||
/// Simulates a real instance of TypeProviderConfig and then creates an instance of the last
|
||||
/// type provider added to a namespace by the type provider constructor
|
||||
let generate (resolutionFolder: string) (runtimeAssembly: string) typeProviderForNamespacesConstructor args =
|
||||
|
|
@ -34,21 +31,23 @@ module Debug =
|
|||
let typeProviderForNamespaces = typeProviderForNamespacesConstructor cfg :> TypeProviderForNamespaces
|
||||
|
||||
let providedTypeDefinition = typeProviderForNamespaces.Namespaces |> Seq.last |> snd |> Seq.last
|
||||
|
||||
|
||||
match args with
|
||||
| [||] -> providedTypeDefinition
|
||||
| args ->
|
||||
// I found a prefixed "Debug" to be more useful than combining the name using the static parameters
|
||||
// The type name ends up quite mangled in the dll output if you choose to use that to aid debugging.
|
||||
let typeName = providedTypeDefinition.Name + (args |> Seq.map (fun s -> ",\"" + (if s = null then "" else s.ToString()) + "\"") |> Seq.reduce (+))
|
||||
//let typeName = "Debug" + providedTypeDefinition.Name
|
||||
let typeName =
|
||||
if providedTypeDefinition.IsErased then
|
||||
providedTypeDefinition.Name + (args |> Seq.map (fun s -> ",\"" + (if s = null then "" else s.ToString()) + "\"") |> Seq.reduce (+))
|
||||
else
|
||||
// The type name ends up quite mangled in the dll output if we combine the name using static parameters, so for generated types we don't do that
|
||||
providedTypeDefinition.Name
|
||||
providedTypeDefinition.MakeParametricType(typeName, args)
|
||||
|
||||
/// Returns a string representation of the signature (and optionally also the body) of all the
|
||||
/// types generated by the type provider up to a certain depth and width
|
||||
/// If ignoreOutput is true, this will still visit the full graph, but it will output an empty string to be faster
|
||||
let prettyPrint signatureOnly ignoreOutput maxDepth maxWidth (t: ProvidedTypeDefinition) =
|
||||
|
||||
|
||||
let ns =
|
||||
[ t.Namespace
|
||||
"Microsoft.FSharp.Core"
|
||||
|
|
@ -74,74 +73,70 @@ module Debug =
|
|||
|
||||
let rec toString useFullName (t: Type) =
|
||||
|
||||
if t = null then
|
||||
"<NULL>" // happens in the Freebase provider
|
||||
let hasUnitOfMeasure = t.Name.Contains("[")
|
||||
|
||||
let innerToString (t: Type) =
|
||||
match t with
|
||||
| t when t = typeof<bool> -> "bool"
|
||||
| t when t = typeof<obj> -> "obj"
|
||||
| t when t = typeof<int> -> "int"
|
||||
| t when t = typeof<int64> -> "int64"
|
||||
| t when t = typeof<float> -> "float"
|
||||
| t when t = typeof<float32> -> "float32"
|
||||
| t when t = typeof<decimal> -> "decimal"
|
||||
| t when t = typeof<string> -> "string"
|
||||
| t when t = typeof<Void> -> "()"
|
||||
| t when t = typeof<unit> -> "()"
|
||||
| t when t.IsArray -> (t.GetElementType() |> toString useFullName) + "[]"
|
||||
| :? ProvidedTypeDefinition as t ->
|
||||
add t
|
||||
t.Name.Split(',').[0]
|
||||
| t when t.IsGenericType ->
|
||||
let args =
|
||||
if useFullName then
|
||||
t.GetGenericArguments()
|
||||
|> Seq.map (if hasUnitOfMeasure then (fun t -> t.Name) else toString useFullName)
|
||||
else
|
||||
t.GetGenericArguments()
|
||||
|> Seq.map (fun _ -> "_")
|
||||
if FSharpType.IsTuple t then
|
||||
String.concat " * " args
|
||||
elif t.Name.StartsWith "FSharpFunc`" then
|
||||
"(" + (String.concat " -> " args) + ")"
|
||||
else
|
||||
let args = String.concat "," args
|
||||
let name, reverse =
|
||||
match t with
|
||||
| t when hasUnitOfMeasure -> toString useFullName t.UnderlyingSystemType, false
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int seq>.GetGenericTypeDefinition().Name -> "seq", true
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int list>.GetGenericTypeDefinition().Name -> "list", true
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int option>.GetGenericTypeDefinition().Name -> "option", true
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int ref>.GetGenericTypeDefinition().Name -> "ref", true
|
||||
| t when t.Name = "FSharpAsync`1" -> "async", true
|
||||
| t when ns.Contains t.Namespace -> t.Name, false
|
||||
| t -> (if useFullName then fullName t else t.Name), false
|
||||
let name = name.Split('`').[0]
|
||||
if reverse then
|
||||
args + " " + name
|
||||
else
|
||||
name + "<" + args + ">"
|
||||
| t when ns.Contains t.Namespace -> t.Name
|
||||
| t when t.IsGenericParameter -> t.Name
|
||||
| t -> if useFullName then fullName t else t.Name
|
||||
|
||||
let rec warnIfWrongAssembly (t:Type) =
|
||||
match t with
|
||||
| :? ProvidedTypeDefinition -> ""
|
||||
| t when t.IsGenericType -> defaultArg (t.GetGenericArguments() |> Seq.map warnIfWrongAssembly |> Seq.tryFind (fun s -> s <> "")) ""
|
||||
| t when t.IsArray -> warnIfWrongAssembly <| t.GetElementType()
|
||||
| t -> if not t.IsGenericParameter && t.Assembly = Assembly.GetExecutingAssembly() then " [DESIGNTIME]" else ""
|
||||
|
||||
if ignoreOutput then
|
||||
""
|
||||
elif hasUnitOfMeasure || t.IsGenericParameter || t.DeclaringType = null then
|
||||
innerToString t + (warnIfWrongAssembly t)
|
||||
else
|
||||
|
||||
let hasUnitOfMeasure = t.Name.Contains("[")
|
||||
|
||||
let innerToString (t: Type) =
|
||||
match t with
|
||||
| t when t = typeof<bool> -> "bool"
|
||||
| t when t = typeof<obj> -> "obj"
|
||||
| t when t = typeof<int> -> "int"
|
||||
| t when t = typeof<int64> -> "int64"
|
||||
| t when t = typeof<float> -> "float"
|
||||
| t when t = typeof<float32> -> "float32"
|
||||
| t when t = typeof<decimal> -> "decimal"
|
||||
| t when t = typeof<string> -> "string"
|
||||
| t when t = typeof<Void> -> "()"
|
||||
| t when t = typeof<unit> -> "()"
|
||||
| t when t.IsArray -> (t.GetElementType() |> toString useFullName) + "[]"
|
||||
| :? ProvidedTypeDefinition as t ->
|
||||
add t
|
||||
t.Name.Split(',').[0]
|
||||
| t when t.IsGenericType ->
|
||||
let args =
|
||||
if useFullName then
|
||||
t.GetGenericArguments()
|
||||
|> Seq.map (if hasUnitOfMeasure then (fun t -> t.Name) else toString useFullName)
|
||||
else
|
||||
t.GetGenericArguments()
|
||||
|> Seq.map (fun _ -> "_")
|
||||
if FSharpType.IsTuple t then
|
||||
separatedBy " * " args
|
||||
elif t.Name.StartsWith "FSharpFunc`" then
|
||||
"(" + separatedBy " -> " args + ")"
|
||||
else
|
||||
let args = separatedBy "," args
|
||||
let name, reverse =
|
||||
match t with
|
||||
| t when hasUnitOfMeasure -> toString useFullName t.UnderlyingSystemType, false
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int seq>.GetGenericTypeDefinition().Name -> "seq", true
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int list>.GetGenericTypeDefinition().Name -> "list", true
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int option>.GetGenericTypeDefinition().Name -> "option", true
|
||||
| t when t.GetGenericTypeDefinition().Name = typeof<int ref>.GetGenericTypeDefinition().Name -> "ref", true
|
||||
| t when t.Name = "FSharpAsync`1" -> "async", true
|
||||
| t when ns.Contains t.Namespace -> t.Name, false
|
||||
| t -> (if useFullName then fullName t else t.Name), false
|
||||
let name = name.Split('`').[0]
|
||||
if reverse then
|
||||
args + " " + name
|
||||
else
|
||||
name + "<" + args + ">"
|
||||
| t when ns.Contains t.Namespace -> t.Name
|
||||
| t when t.IsGenericParameter -> t.Name
|
||||
| t -> if useFullName then fullName t else t.Name
|
||||
|
||||
let rec warnIfWrongAssembly (t:Type) =
|
||||
match t with
|
||||
| :? ProvidedTypeDefinition -> ""
|
||||
| t when t.IsGenericType -> defaultArg (t.GetGenericArguments() |> Seq.map warnIfWrongAssembly |> Seq.tryFind (fun s -> s <> "")) ""
|
||||
| t when t.IsArray -> warnIfWrongAssembly <| t.GetElementType()
|
||||
| t -> if not t.IsGenericParameter && t.Assembly = Assembly.GetExecutingAssembly() then " [DESIGNTIME]" else ""
|
||||
|
||||
if ignoreOutput then
|
||||
""
|
||||
elif hasUnitOfMeasure || t.IsGenericParameter || t.DeclaringType = null then
|
||||
innerToString t + (warnIfWrongAssembly t)
|
||||
else
|
||||
(toString useFullName t.DeclaringType) + "+" + (innerToString t) + (warnIfWrongAssembly t)
|
||||
(toString useFullName t.DeclaringType) + "+" + (innerToString t) + (warnIfWrongAssembly t)
|
||||
|
||||
let toSignature (parameters: ParameterInfo[]) =
|
||||
if parameters.Length = 0 then
|
||||
|
|
@ -149,7 +144,7 @@ module Debug =
|
|||
else
|
||||
parameters
|
||||
|> Seq.map (fun p -> p.Name + ":" + (toString true p.ParameterType))
|
||||
|> separatedBy " -> "
|
||||
|> String.concat " -> "
|
||||
|
||||
let printExpr expr =
|
||||
|
||||
|
|
@ -171,7 +166,7 @@ module Debug =
|
|||
let inline getAttrs attrName m =
|
||||
( ^a : (member GetCustomAttributesData : unit -> IList<CustomAttributeData>) m)
|
||||
|> Seq.filter (fun attr -> attr.Constructor.DeclaringType.Name = attrName)
|
||||
|
||||
|
||||
let inline hasAttr attrName m =
|
||||
not (Seq.isEmpty (getAttrs attrName m))
|
||||
|
||||
|
|
@ -406,18 +401,17 @@ module Debug =
|
|||
if not ignoreOutput then
|
||||
sb.AppendLine() |> ignore
|
||||
|
||||
let printCustomAttributes (cads:CustomAttributeData seq) indent=
|
||||
let printCustomAttributes (cads:CustomAttributeData seq) indent =
|
||||
//print custom attributes
|
||||
let prefix =
|
||||
if indent then "\n [<"
|
||||
else "\n[<"
|
||||
let prefix = sprintf "\n%s[<" (String.replicate indent " ")
|
||||
for ca in cads do
|
||||
print ( prefix + ca.Constructor.DeclaringType.Name.Replace("Attribute", "") + ">]\n")
|
||||
|
||||
let printMember (memberInfo: MemberInfo) =
|
||||
|
||||
let printMember indent (memberInfo: MemberInfo)=
|
||||
let currentIndent = indent + 4
|
||||
let currentIndentString = String.replicate currentIndent " "
|
||||
let print str =
|
||||
print " "
|
||||
print currentIndentString
|
||||
print str
|
||||
println()
|
||||
|
||||
|
|
@ -455,14 +449,21 @@ module Debug =
|
|||
if ignoreOutput then
|
||||
""
|
||||
else
|
||||
sprintf "\n%O\n" x
|
||||
sprintf "\"%O\"" x
|
||||
|
||||
let getName (m:MemberInfo) =
|
||||
if memberInfo.Name.Contains(" ") then
|
||||
"``" + m.Name + "``"
|
||||
else
|
||||
m.Name
|
||||
|
||||
match memberInfo with
|
||||
|
||||
| :? ProvidedConstructor as cons ->
|
||||
if not ignoreOutput then
|
||||
|
||||
//print custom attributes
|
||||
printCustomAttributes (cons.GetCustomAttributesData()) false
|
||||
printCustomAttributes (cons.GetCustomAttributesData()) currentIndent
|
||||
|
||||
print <| "new : " +
|
||||
(toSignature <| cons.GetParameters()) + " -> " +
|
||||
|
|
@ -475,17 +476,15 @@ module Debug =
|
|||
if signatureOnly then ""
|
||||
else field.GetRawConstantValue() |> printObj
|
||||
if not ignoreOutput then
|
||||
print <| "val " + field.Name + ": " +
|
||||
(toString true field.FieldType) +
|
||||
value
|
||||
print <| "val " + (getName field) + ": " + (toString true field.FieldType) + " = " + value
|
||||
|
||||
| :? ProvidedProperty as prop ->
|
||||
| :? ProvidedProperty as prop ->
|
||||
if not ignoreOutput then
|
||||
//print custom attributes
|
||||
printCustomAttributes (prop.GetCustomAttributesData()) true
|
||||
printCustomAttributes (prop.GetCustomAttributesData()) currentIndent
|
||||
|
||||
print <| (if prop.IsStatic then "static " else "") + "member " +
|
||||
prop.Name + ": " + (toString true prop.PropertyType) +
|
||||
(getName prop) + ": " + (toString true prop.PropertyType) +
|
||||
" with " + (if prop.CanRead && prop.CanWrite then "get, set" else if prop.CanRead then "get" else "set")
|
||||
if not signatureOnly then
|
||||
if prop.CanRead then
|
||||
|
|
@ -493,18 +492,51 @@ module Debug =
|
|||
if prop.CanWrite then
|
||||
getMethodBody (prop.GetSetMethod() :?> ProvidedMethod) |> printExpr
|
||||
|
||||
| :? ProvidedMethod as m ->
|
||||
| :? ProvidedMethod as m ->
|
||||
if m.Attributes &&& MethodAttributes.SpecialName <> MethodAttributes.SpecialName then
|
||||
if not ignoreOutput then
|
||||
//print custom attributes
|
||||
printCustomAttributes (m.GetCustomAttributesData()) true
|
||||
printCustomAttributes (m.GetCustomAttributesData()) currentIndent
|
||||
|
||||
print <| (if m.IsStatic then "static " else "") + "member " +
|
||||
m.Name + ": " + (toSignature <| m.GetParameters()) +
|
||||
(getName m) + ": " + (toSignature <| m.GetParameters()) +
|
||||
" -> " + (toString true m.ReturnType)
|
||||
if not signatureOnly then
|
||||
m |> getMethodBody |> printExpr
|
||||
|
||||
| _ -> ()
|
||||
|
||||
let rec printType indent (t:ProvidedTypeDefinition) =
|
||||
let currentIndent = String.replicate indent " "
|
||||
let print str =
|
||||
print currentIndent
|
||||
print str
|
||||
|
||||
//print custom attributes
|
||||
printCustomAttributes (t.GetCustomAttributesData()) indent
|
||||
|
||||
match t with
|
||||
| t when FSharpType.IsRecord t-> "record "
|
||||
| t when FSharpType.IsModule t -> "module "
|
||||
| t when t.IsValueType -> "struct "
|
||||
| t when t.IsClass && t.IsSealed && t.IsAbstract -> "static class "
|
||||
| t when t.IsClass && t.IsAbstract -> "abstract class "
|
||||
| t when t.IsClass -> "class "
|
||||
| _ -> ""
|
||||
|> print
|
||||
print (toString true t)
|
||||
if t.BaseType <> typeof<obj> then
|
||||
print " : "
|
||||
print (toString true t.BaseType)
|
||||
println()
|
||||
t.GetMembers()
|
||||
|> Seq.sortBy (fun m -> m.Name)
|
||||
|> Seq.iter (printMember indent)
|
||||
println()
|
||||
|
||||
t.GetNestedTypes()
|
||||
|> Array.choose(function :? ProvidedTypeDefinition as ptd -> Some ptd | _ -> None)
|
||||
|> Array.iter (printType (indent + 4) )
|
||||
|
||||
add t
|
||||
|
||||
|
|
@ -518,27 +550,7 @@ module Debug =
|
|||
|> Seq.sortBy (fun m -> m.Name)
|
||||
|> Seq.truncate maxWidth
|
||||
for t in pendingForThisDepth do
|
||||
//print custom attributes
|
||||
printCustomAttributes (t.GetCustomAttributesData()) false
|
||||
|
||||
match t with
|
||||
| t when FSharpType.IsRecord t-> "record "
|
||||
| t when FSharpType.IsModule t -> "module "
|
||||
| t when t.IsValueType -> "struct "
|
||||
| t when t.IsClass && t.IsSealed && t.IsAbstract -> "static class "
|
||||
| t when t.IsClass && t.IsAbstract -> "abstract class "
|
||||
| t when t.IsClass -> "class "
|
||||
| _ -> ""
|
||||
|> print
|
||||
print (toString true t)
|
||||
if t.BaseType <> typeof<obj> then
|
||||
print " : "
|
||||
print (toString true t.BaseType)
|
||||
println()
|
||||
t.GetMembers()
|
||||
|> Seq.sortBy (fun m -> m.Name)
|
||||
|> Seq.iter printMember
|
||||
println()
|
||||
printType 0 t
|
||||
currentDepth := !currentDepth + 1
|
||||
|
||||
sb.ToString()
|
||||
sb.ToString()
|
||||
Загрузка…
Ссылка в новой задаче