From 5f8b33a01d985aa7eedcd801c56fbd4509de9cb5 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Tue, 9 Mar 2021 21:51:39 -0600 Subject: [PATCH 1/8] first pass of xml doc generation for generated signature files --- src/fsharp/NicePrint.fs | 231 +++++++++++++++++++++++----------------- 1 file changed, 132 insertions(+), 99 deletions(-) diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index b8f49aa4553..5f5922399d8 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -27,6 +27,7 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Core.Printf +let debug = true [] module internal PrintUtilities = let bracketIfL x lyt = if x then bracketL lyt else lyt @@ -120,6 +121,23 @@ module internal PrintUtilities = let tcref = attrib.TyconRef squareAngleL (layoutTyconRefImpl true denv tcref) + /// layout the xml docs immediately before another block + let layoutXmlDoc (_denv: DisplayEnv) (xml: XmlDoc) restL = + let xmlDocL = + if xml.IsEmpty + then + if debug then Diagnostics.dprintfn "layoutXmlDoc: empty xmlDoc" + emptyL + else + if debug then Diagnostics.dprintfn "layoutXmlDoc: writing lines %A" xml.UnprocessedLines + xml.UnprocessedLines + |> List.ofArray + /// note here that we don't add a space after the triple-slash, because + /// the implicit spacing hasn't been trimmed here. + |> List.map (fun line -> ("///" + line) |> tagText |> wordL) + |> spaceListL + xmlDocL @@ restL + module private PrintIL = let fullySplitILTypeRef (tref: ILTypeRef) = @@ -943,80 +961,83 @@ module private PrintTastMemberOrVals = let mkNameL niceMethodTypars tagFunction name = let nameL = DemangleOperatorNameAsLayout (tagFunction >> mkNav v.DefinitionRange) name - let nameL = + let nameL = if denv.showMemberContainers then layoutTyconRef denv v.MemberApparentEntity ^^ SepL.dot ^^ nameL - else + else nameL let nameL = if denv.showTyparBinding then layoutTyparDecls denv nameL true niceMethodTypars else nameL let nameL = layoutAccessibility denv v.Accessibility nameL nameL - match membInfo.MemberFlags.MemberKind with - | SynMemberKind.Member -> - let prettyTyparInst, niceMethodTypars,tauL = prettyLayoutOfMemberType denv v typarInst argInfos rty - let resL = - if short then tauL - else - let nameL = mkNameL niceMethodTypars tagMember v.LogicalName - stat --- (nameL ^^ WordL.colon ^^ tauL) - prettyTyparInst, resL - - | SynMemberKind.ClassConstructor - | SynMemberKind.Constructor -> - let prettyTyparInst, _, tauL = prettyLayoutOfMemberType denv v typarInst argInfos rty - let resL = - if short then tauL - else - let newL = layoutAccessibility denv v.Accessibility WordL.keywordNew - stat ++ newL ^^ wordL (tagPunctuation ":") ^^ tauL - prettyTyparInst, resL - - | SynMemberKind.PropertyGetSet -> - emptyTyparInst, stat - - | SynMemberKind.PropertyGet -> - if isNil argInfos then - // use error recovery because intellisense on an incomplete file will show this - errorR(Error(FSComp.SR.tastInvalidFormForPropertyGetter(), v.Id.idRange)) - let nameL = mkNameL [] tagProperty v.CoreDisplayName - let resL = - if short then nameL --- (WordL.keywordWith ^^ WordL.keywordGet) - else stat --- nameL --- (WordL.keywordWith ^^ WordL.keywordGet) - emptyTyparInst, resL - else - let argInfos = - match argInfos with - | [[(ty, _)]] when isUnitTy denv.g ty -> [] - | _ -> argInfos + let prettyTyparInst, memberL = + match membInfo.MemberFlags.MemberKind with + | SynMemberKind.Member -> let prettyTyparInst, niceMethodTypars,tauL = prettyLayoutOfMemberType denv v typarInst argInfos rty - let resL = - if short then - if isNil argInfos then tauL - else tauL --- (WordL.keywordWith ^^ WordL.keywordGet) + let resL = + if short then tauL else - let nameL = mkNameL niceMethodTypars tagProperty v.CoreDisplayName - stat --- (nameL ^^ WordL.colon ^^ (if isNil argInfos then tauL else tauL --- (WordL.keywordWith ^^ WordL.keywordGet))) + let nameL = mkNameL niceMethodTypars tagMember v.LogicalName + stat --- (nameL ^^ WordL.colon ^^ tauL) prettyTyparInst, resL - | SynMemberKind.PropertySet -> - if argInfos.Length <> 1 || isNil argInfos.Head then - // use error recovery because intellisense on an incomplete file will show this - errorR(Error(FSComp.SR.tastInvalidFormForPropertySetter(), v.Id.idRange)) - let nameL = mkNameL [] tagProperty v.CoreDisplayName - let resL = stat --- nameL --- (WordL.keywordWith ^^ WordL.keywordSet) - emptyTyparInst, resL - else - let argInfos, valueInfo = List.frontAndBack argInfos.Head - let prettyTyparInst, niceMethodTypars, tauL = prettyLayoutOfMemberType denv v typarInst (if isNil argInfos then [] else [argInfos]) (fst valueInfo) + | SynMemberKind.ClassConstructor + | SynMemberKind.Constructor -> + let prettyTyparInst, _, tauL = prettyLayoutOfMemberType denv v typarInst argInfos rty let resL = - if short then - (tauL --- (WordL.keywordWith ^^ WordL.keywordSet)) + if short then tauL else - let nameL = mkNameL niceMethodTypars tagProperty v.CoreDisplayName - stat --- (nameL ^^ wordL (tagPunctuation ":") ^^ (tauL --- (WordL.keywordWith ^^ WordL.keywordSet))) + let newL = layoutAccessibility denv v.Accessibility WordL.keywordNew + stat ++ newL ^^ wordL (tagPunctuation ":") ^^ tauL prettyTyparInst, resL - + + | SynMemberKind.PropertyGetSet -> + emptyTyparInst, stat + + | SynMemberKind.PropertyGet -> + if isNil argInfos then + // use error recovery because intellisense on an incomplete file will show this + errorR(Error(FSComp.SR.tastInvalidFormForPropertyGetter(), v.Id.idRange)) + let nameL = mkNameL [] tagProperty v.CoreDisplayName + let resL = + if short then nameL --- (WordL.keywordWith ^^ WordL.keywordGet) + else stat --- nameL --- (WordL.keywordWith ^^ WordL.keywordGet) + emptyTyparInst, resL + else + let argInfos = + match argInfos with + | [[(ty, _)]] when isUnitTy denv.g ty -> [] + | _ -> argInfos + let prettyTyparInst, niceMethodTypars,tauL = prettyLayoutOfMemberType denv v typarInst argInfos rty + let resL = + if short then + if isNil argInfos then tauL + else tauL --- (WordL.keywordWith ^^ WordL.keywordGet) + else + let nameL = mkNameL niceMethodTypars tagProperty v.CoreDisplayName + stat --- (nameL ^^ WordL.colon ^^ (if isNil argInfos then tauL else tauL --- (WordL.keywordWith ^^ WordL.keywordGet))) + prettyTyparInst, resL + + | SynMemberKind.PropertySet -> + if argInfos.Length <> 1 || isNil argInfos.Head then + // use error recovery because intellisense on an incomplete file will show this + errorR(Error(FSComp.SR.tastInvalidFormForPropertySetter(), v.Id.idRange)) + let nameL = mkNameL [] tagProperty v.CoreDisplayName + let resL = stat --- nameL --- (WordL.keywordWith ^^ WordL.keywordSet) + emptyTyparInst, resL + else + let argInfos, valueInfo = List.frontAndBack argInfos.Head + let prettyTyparInst, niceMethodTypars, tauL = prettyLayoutOfMemberType denv v typarInst (if isNil argInfos then [] else [argInfos]) (fst valueInfo) + let resL = + if short then + (tauL --- (WordL.keywordWith ^^ WordL.keywordSet)) + else + let nameL = mkNameL niceMethodTypars tagProperty v.CoreDisplayName + stat --- (nameL ^^ wordL (tagPunctuation ":") ^^ (tauL --- (WordL.keywordWith ^^ WordL.keywordSet))) + prettyTyparInst, resL + + prettyTyparInst, layoutXmlDoc denv v.XmlDoc memberL + let prettyLayoutOfMember denv typarInst (v:Val) = prettyLayoutOfMemberShortOption denv typarInst v false let prettyLayoutOfMemberNoInstShort denv v = @@ -1092,14 +1113,16 @@ module private PrintTastMemberOrVals = match denv.generatedValueLayout v with | None -> valAndTypeL | Some rhsL -> (valAndTypeL ++ wordL (tagPunctuation"=")) --- rhsL - match v.LiteralValue with - | Some literalValue -> valAndTypeL ++ layoutOfLiteralValue literalValue - | None -> valAndTypeL + let overallL = + match v.LiteralValue with + | Some literalValue -> valAndTypeL ++ layoutOfLiteralValue literalValue + | None -> valAndTypeL + layoutXmlDoc denv v.XmlDoc overallL let prettyLayoutOfValOrMember denv typarInst (v: Val) = - let prettyTyparInst, vL = + let prettyTyparInst, vL = match v.MemberInfo with - | None -> + | None -> let tps, tau = v.TypeScheme // adjust the type in case this is the 'this' pointer stored in a reference cell @@ -1110,6 +1133,7 @@ module private PrintTastMemberOrVals = prettyTyparInst, resL | Some _ -> prettyLayoutOfMember denv typarInst v + prettyTyparInst, layoutAttribs denv true v.Type TyparKind.Type v.Attribs vL let prettyLayoutOfValOrMemberNoInst denv v = @@ -1194,6 +1218,7 @@ module InfoMemberPrinting = PrintTypes.layoutTyparDecls denv (minfo.LogicalName |> tagMethod |> wordL) true minfo.FormalMethodTypars ) ^^ WordL.colon + let layout = layoutXmlDoc denv minfo.XmlDoc layout let paramDatas = minfo.GetParamDatas(amap, m, minst) let layout = layout ^^ @@ -1354,7 +1379,8 @@ module private TastDefinitionPrinting = |> wordL let lhs = (if addAccess then layoutAccessibility denv fld.Accessibility lhs else lhs) let lhs = if fld.IsMutable then wordL (tagKeyword "mutable") --- lhs else lhs - (lhs ^^ RightL.colon) --- layoutType denv fld.FormalType + let fieldL = (lhs ^^ RightL.colon) --- layoutType denv fld.FormalType + layoutXmlDoc denv fld.XmlDoc fieldL let layoutUnionOrExceptionField denv isGenerated i (fld: RecdField) = if isGenerated i fld then layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 2 fld.FormalType @@ -1377,9 +1403,11 @@ module private TastDefinitionPrinting = let layoutUnionCase denv prefixL (ucase: UnionCase) = let nmL = DemangleOperatorNameAsLayout (tagUnionCase >> mkNav ucase.DefinitionRange) ucase.Id.idText //let nmL = layoutAccessibility denv ucase.Accessibility nmL - match ucase.RecdFields with - | [] -> (prefixL ^^ nmL) - | fields -> (prefixL ^^ nmL ^^ WordL.keywordOf) --- layoutUnionCaseFields denv true fields + let caseL = + match ucase.RecdFields with + | [] -> (prefixL ^^ nmL) + | fields -> (prefixL ^^ nmL ^^ WordL.keywordOf) --- layoutUnionCaseFields denv true fields + layoutXmlDoc denv ucase.XmlDoc caseL let layoutUnionCases denv ucases = let prefixL = WordL.bar // See bug://2964 - always prefix in case preceded by accessibility modifier @@ -1752,7 +1780,8 @@ module private TastDefinitionPrinting = | Some a -> (lhsL ^^ WordL.equals) --- (layoutType { denv with shortTypeNames = false } a) - layoutAttribs denv false ty tycon.TypeOrMeasureKind tycon.Attribs reprL + let attribsL = layoutAttribs denv false ty tycon.TypeOrMeasureKind tycon.Attribs reprL + layoutXmlDoc denv tycon.XmlDoc attribsL // Layout: exception definition let layoutExnDefn denv (exnc: Entity) = @@ -1862,40 +1891,44 @@ module private InferredSigPrinting = let denv = denv.AddOpenPath (List.map fst innerPath) if mspec.IsNamespace then let basic = imdefL denv def - // Check if this namespace contains anything interesting - if isConcreteNamespace def then - // This is a container namespace. We print the header when we get to the first concrete module. - let headerL = - wordL (tagKeyword "namespace") ^^ sepListL SepL.dot (List.map (fst >> tagNamespace >> wordL) innerPath) - headerL @@-- basic - else - // This is a namespace that only contains namespaces. Skip the header - basic + let basicL = + // Check if this namespace contains anything interesting + if isConcreteNamespace def then + // This is a container namespace. We print the header when we get to the first concrete module. + let headerL = + wordL (tagKeyword "namespace") ^^ sepListL SepL.dot (List.map (fst >> tagNamespace >> wordL) innerPath) + headerL @@-- basic + else + // This is a namespace that only contains namespaces. Skip the header + basic + layoutXmlDoc denv mspec.XmlDoc basicL else // This is a module let nmL = layoutAccessibility denv mspec.Accessibility (wordL (tagModule nm)) - let denv = denv.AddAccessibility mspec.Accessibility + let denv = denv.AddAccessibility mspec.Accessibility let basic = imdefL denv def - // Check if its an outer module or a nested module - if (outerPath |> List.forall (fun (_, istype) -> istype = Namespace) ) then - // OK, this is an outer module - if showHeader then - // OK, we're not in F# Interactive - // Check if this is an outer module with no namespace - if isNil outerPath then - // If so print a "module" declaration - (wordL (tagKeyword "module") ^^ nmL) @@ basic - else - // Otherwise this is an outer module contained immediately in a namespace - // We already printed the namespace declaration earlier. So just print the - // module now. - ((wordL (tagKeyword"module") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword "begin")) @@-- basic) @@ WordL.keywordEnd + let basicL = + // Check if its an outer module or a nested module + if (outerPath |> List.forall (fun (_, istype) -> istype = Namespace) ) then + // OK, this is an outer module + if showHeader then + // OK, we're not in F# Interactive + // Check if this is an outer module with no namespace + if isNil outerPath then + // If so print a "module" declaration + (wordL (tagKeyword "module") ^^ nmL) @@ basic + else + // Otherwise this is an outer module contained immediately in a namespace + // We already printed the namespace declaration earlier. So just print the + // module now. + ((wordL (tagKeyword"module") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword "begin")) @@-- basic) @@ WordL.keywordEnd + else + // OK, we're in F# Interactive, presumably the implicit module for each interaction. + basic else - // OK, we're in F# Interactive, presumably the implicit module for each interaction. - basic - else - // OK, this is a nested module - ((wordL (tagKeyword "module") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword"begin")) @@-- basic) @@ WordL.keywordEnd + // OK, this is a nested module + ((wordL (tagKeyword "module") ^^ nmL ^^ WordL.equals ^^ wordL (tagKeyword"begin")) @@-- basic) @@ WordL.keywordEnd + layoutXmlDoc denv mspec.XmlDoc basicL imexprL denv expr //-------------------------------------------------------------------------- From 1ed584ea29b1bd18a8417f298737a3aa44499f05 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Tue, 9 Mar 2021 22:44:03 -0600 Subject: [PATCH 2/8] also layout events, props, etc --- src/fsharp/NicePrint.fs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 5f5922399d8..387014058cc 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1452,13 +1452,15 @@ module private TastDefinitionPrinting = let nameL = eventTag |> wordL let typL = layoutType denv (e.GetDelegateType(amap, m)) - staticL ^^ WordL.keywordMember ^^ nameL ^^ WordL.colon ^^ typL - + let overallL = staticL ^^ WordL.keywordMember ^^ nameL ^^ WordL.colon ^^ typL + layoutXmlDoc denv e.XmlDoc overallL + let private layoutPropInfo denv amap m (p: PropInfo) = match p.ArbitraryValRef with | Some v -> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv v.Deref | None -> + let modifierAndMember = if p.IsStatic then WordL.keywordStatic ^^ WordL.keywordMember @@ -1473,8 +1475,8 @@ module private TastDefinitionPrinting = let nameL = propTag |> wordL let typL = layoutType denv (p.GetPropertyType(amap, m)) // shouldn't happen - - modifierAndMember ^^ nameL ^^ WordL.colon ^^ typL + let overallL = modifierAndMember ^^ nameL ^^ WordL.colon ^^ typL + layoutXmlDoc denv p.XmlDoc overallL let layoutTycon (denv: DisplayEnv) (infoReader: InfoReader) ad m simplified typewordL (tycon: Tycon) = let g = denv.g @@ -1799,7 +1801,8 @@ module private TastDefinitionPrinting = | [] -> emptyL | r -> WordL.keywordOf --- layoutUnionCaseFields denv false r - exnL ^^ reprL + let overallL = exnL ^^ reprL + layoutXmlDoc denv exnc.XmlDoc overallL // Layout: module spec From 29553b98ef71bea1689f186331b71b14809746f0 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Tue, 9 Mar 2021 22:46:03 -0600 Subject: [PATCH 3/8] toggle debug flag off --- src/fsharp/NicePrint.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 387014058cc..82a8bd09cff 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -27,7 +27,7 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Core.Printf -let debug = true +let debug = false [] module internal PrintUtilities = let bracketIfL x lyt = if x then bracketL lyt else lyt From bef2ca6298dcababf0919acffe6baa6c06a30123 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Wed, 31 Mar 2021 17:02:20 -0500 Subject: [PATCH 4/8] emit comments behind a displayEnv flag, and do not emit namespace comments --- src/fsharp/NicePrint.fs | 38 +++++++++++++++++++++---------------- src/fsharp/TypedTreeOps.fs | 2 ++ src/fsharp/TypedTreeOps.fsi | 2 ++ 3 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 82a8bd09cff..69bfc58efdd 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -122,21 +122,24 @@ module internal PrintUtilities = squareAngleL (layoutTyconRefImpl true denv tcref) /// layout the xml docs immediately before another block - let layoutXmlDoc (_denv: DisplayEnv) (xml: XmlDoc) restL = - let xmlDocL = - if xml.IsEmpty - then - if debug then Diagnostics.dprintfn "layoutXmlDoc: empty xmlDoc" - emptyL - else - if debug then Diagnostics.dprintfn "layoutXmlDoc: writing lines %A" xml.UnprocessedLines - xml.UnprocessedLines - |> List.ofArray - /// note here that we don't add a space after the triple-slash, because - /// the implicit spacing hasn't been trimmed here. - |> List.map (fun line -> ("///" + line) |> tagText |> wordL) - |> spaceListL - xmlDocL @@ restL + let layoutXmlDoc (denv: DisplayEnv) (xml: XmlDoc) restL = + if denv.showDocumentation + then + let xmlDocL = + if xml.IsEmpty + then + if debug then Diagnostics.dprintfn "layoutXmlDoc: empty xmlDoc" + emptyL + else + if debug then Diagnostics.dprintfn "layoutXmlDoc: writing lines %A" xml.UnprocessedLines + xml.UnprocessedLines + |> List.ofArray + /// note here that we don't add a space after the triple-slash, because + /// the implicit spacing hasn't been trimmed here. + |> List.map (fun line -> ("///" + line) |> tagText |> wordL) + |> spaceListL + xmlDocL @@ restL + else restL module private PrintIL = @@ -1904,7 +1907,10 @@ module private InferredSigPrinting = else // This is a namespace that only contains namespaces. Skip the header basic - layoutXmlDoc denv mspec.XmlDoc basicL + // NOTE: explicitly not calling `layoutXmlDoc` here, because even though + // `ModuleOrNamespace` has a field for XmlDoc, it is never present at the parser + // level. This should be changed if the parser/spec changes. + basicL else // This is a module let nmL = layoutAccessibility denv mspec.Accessibility (wordL (tagModule nm)) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 027543d537b..1dd93ca40a1 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2764,6 +2764,7 @@ type DisplayEnv = showConstraintTyparAnnotations: bool abbreviateAdditionalConstraints: bool showTyparDefaultConstraints: bool + showDocumentation: bool shrinkOverloads: bool printVerboseSignatures : bool g: TcGlobals @@ -2794,6 +2795,7 @@ type DisplayEnv = showAttributes = false showOverrides = true showConstraintTyparAnnotations = true + showDocumentation = true abbreviateAdditionalConstraints = false showTyparDefaultConstraints = false shortConstraints = false diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index a5776930d98..d1023a82043 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -986,6 +986,8 @@ type DisplayEnv = showConstraintTyparAnnotations:bool abbreviateAdditionalConstraints: bool showTyparDefaultConstraints: bool + /// If set, signatures will be rendered with XML documentation comments for members if they exist + showDocumentation: bool shrinkOverloads: bool printVerboseSignatures: bool g: TcGlobals From d7fb98e5946fa821aa50d6bf540cfc00d8183cd4 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Wed, 31 Mar 2021 21:21:46 -0500 Subject: [PATCH 5/8] initial test --- src/fsharp/service/FSharpCheckerResults.fs | 27 ++++- src/fsharp/service/FSharpCheckerResults.fsi | 3 + tests/FSharp.Test.Utilities/Compiler.fs | 11 ++ tests/FSharp.Test.Utilities/CompilerAssert.fs | 23 ++++ .../Service/SignatureGenerationTests.fs | 107 ++++++++++++++++++ tests/fsharp/FSharpSuite.Tests.fsproj | 1 + 6 files changed, 171 insertions(+), 1 deletion(-) create mode 100644 tests/fsharp/Compiler/Service/SignatureGenerationTests.fs diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 3690154175d..5f0e903ea11 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -1969,7 +1969,32 @@ type FSharpCheckFileResults threadSafeOp (fun () -> None) (fun scope -> let (nenv, _), _ = scope.GetBestDisplayEnvForPos cursorPos Some(FSharpDisplayContext(fun _ -> nenv.DisplayEnv))) - + + member _.GenerateSignatureForFile () = + threadSafeOp (fun () -> None) (fun scope -> + scope.ImplementationFile + |> Option.map (fun implFile -> + let denv = DisplayEnv.Empty scope.TcGlobals + let denv = + { denv with + showImperativeTyparAnnotations=true + showHiddenMembers=true + showObsoleteMembers=true + showAttributes=true } + let denv = + denv.SetOpenPaths + [ FSharpLib.RootPath + FSharpLib.CorePath + FSharpLib.CollectionsPath + FSharpLib.ControlPath + (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ] + let infoReader = InfoReader(scope.TcGlobals, scope.TcImports.GetImportMap()) + let (TImplFile (_, _, mexpr, _, _, _)) = implFile + let layout = NicePrint.layoutInferredSigOfModuleExpr true denv infoReader AccessibleFromSomewhere range0 mexpr + layout |> LayoutRender.showL + ) + ) + member _.ImplementationFile = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" scopeOptX diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 93ab0cfcf05..e029eb91642 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -302,6 +302,9 @@ type public FSharpCheckFileResults = /// Open declarations in the file, including auto open modules. member OpenDeclarations: FSharpOpenDeclaration[] + /// Lays out and returns the formatted signature for the typechecked file + member GenerateSignatureForFile: unit -> string option + /// Internal constructor static member internal MakeEmpty : filename: string * diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 70a0b001238..76b2b3e3539 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -426,6 +426,17 @@ module rec Compiler = | FS fs -> typecheckFSharp fs | _ -> failwith "Typecheck only supports F#" + let typecheckResults (cUnit: CompilationUnit) : FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults = + match cUnit with + | FS fsSource -> + let source = getSource fsSource.Source + let options = fsSource.Options |> Array.ofList + + let name = match fsSource.Name with | None -> "test.fs" | Some n -> n + + CompilerAssert.TypeCheck(options, name, source) + | _ -> failwith "Typecheck only supports F#" + let run (result: TestResult) : TestResult = match result with | Failure f -> failwith (sprintf "Compilation should be successfull in order to run.\n Errors: %A" (f.Diagnostics)) diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index e41689f3bba..da4f477b7d2 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -649,6 +649,29 @@ let main argv = 0""" errors + /// Parses and type checks the given source. Fails if type checker is aborted. + static member ParseAndTypeCheck(options, name, source: string) = + lock gate <| fun () -> + let parseResults, fileAnswer = + checker.ParseAndCheckFileInProject( + name, + 0, + SourceText.ofString source, + { defaultProjectOptions with OtherOptions = Array.append options defaultProjectOptions.OtherOptions}) + |> Async.RunSynchronously + + match fileAnswer with + | FSharpCheckFileAnswer.Aborted _ -> Assert.Fail("Type Checker Aborted"); failwith "Type Checker Aborted" + | FSharpCheckFileAnswer.Succeeded(typeCheckResults) -> parseResults, typeCheckResults + + /// Parses and type checks the given source. Fails if the type checker is aborted or the parser returns any diagnostics. + static member TypeCheck(options, name, source: string) = + let parseResults, checkResults = CompilerAssert.ParseAndTypeCheck(options, name, source) + + Assert.IsEmpty(parseResults.Diagnostics, sprintf "Parse errors: %A" parseResults.Diagnostics) + + checkResults + static member TypeCheckWithErrorsAndOptionsAndAdjust options libAdjust (source: string) expectedTypeErrors = lock gate <| fun () -> let errors = diff --git a/tests/fsharp/Compiler/Service/SignatureGenerationTests.fs b/tests/fsharp/Compiler/Service/SignatureGenerationTests.fs new file mode 100644 index 00000000000..c81123a5018 --- /dev/null +++ b/tests/fsharp/Compiler/Service/SignatureGenerationTests.fs @@ -0,0 +1,107 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests + +open FSharp.Compiler.Diagnostics +open NUnit.Framework +open FSharp.Test.Utilities +open FSharp.Test.Utilities.Utilities +open FSharp.Test.Utilities.Compiler +open FSharp.Tests + +[] +module SignatureGenerationTests = + + let sigText (checkResults: FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults) = + match checkResults.GenerateSignatureForFile() with + | None -> failwith "Unable to generate signature text." + | Some text -> text + + let sigShouldBe (expected: string) src = + let text = + FSharp src + |> withLangVersion50 + |> typecheckResults + |> sigText + + let actual = text.ToString() + let expected2 = expected.Replace("\r\n", "\n") + Assert.shouldBeEquivalentTo expected2 actual + + [] + let ``can generate sigs with comments`` () = + """ +/// namespace comments +namespace Sample + +/// exception comments +exception MyEx of reason: string + +/// module-level docs +module Inner = + /// type-level docs + type Farts + /// primary ctor docs + (name: string) = + /// constructor-level docs + new() = Farts("default name") + /// member-level docs + member x.blah() = [1;2;3] + /// auto-property-level docs + member val Name = name with get, set + + /// module-level binding docs + let module_member = () + + /// record docs + type TestRecord = + { + /// record field docs + RecordField: int + } + /// record member docs + member x.Data = 1 + /// static record member docs + static member Foo = true + + /// union docs + type TestUnion = + /// docs for first case + | FirstCase of thing: int + /// union member + member x.Thing = match x with | FirstCase thing -> thing + """ + |> sigShouldBe """namespace Sample + /// exception comments + exception MyEx of reason: string + /// module-level docs + module Inner = begin + /// type-level docs + type Farts = + /// constructor-level docs + new : unit -> Farts + 1 overload + /// member-level docs + member blah : unit -> int list + /// auto-property-level docs + member Name : string + /// module-level binding docs + val module_member : unit + /// record docs + type TestRecord = + { /// record field docs + RecordField: int } + with + /// record member docs + member Data : int + /// static record member docs + static member Foo : bool + end + /// union docs + type TestUnion = + /// docs for first case + | FirstCase of thing: int + with + /// union member + member Thing : int + end + end""" \ No newline at end of file diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index a6f0066aca0..952372043cf 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -25,6 +25,7 @@ + From 85fbea64b190945ebfa4f677048f0308134e3bb5 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Thu, 1 Apr 2021 09:44:07 -0500 Subject: [PATCH 6/8] update surface area --- tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index f5e05e7cda1..2445007a2d1 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -1396,6 +1396,7 @@ FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FShar FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpImplementationFileContents] ImplementationFile FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpImplementationFileContents] get_ImplementationFile() FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.CodeAnalysis.FSharpSymbolUse]] GetMethodsAsSymbols(Int32, Int32, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String]) +FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[System.String] GenerateSignatureForFile() FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: Microsoft.FSharp.Core.FSharpOption`1[System.String] GetF1Keyword(Int32, Int32, System.String, Microsoft.FSharp.Collections.FSharpList`1[System.String]) FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: System.Collections.Generic.IEnumerable`1[FSharp.Compiler.CodeAnalysis.FSharpSymbolUse] GetAllUsesOfAllSymbolsInFile(Microsoft.FSharp.Core.FSharpOption`1[System.Threading.CancellationToken]) FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults: System.String ToString() From 8d25a1c4a0ca3f9446e631fde0fb753e7b3d2891 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Thu, 1 Apr 2021 16:58:03 -0500 Subject: [PATCH 7/8] do not show documentation comments on tooltip signatures --- src/fsharp/service/ServiceDeclarationLists.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index 8551897cfc0..7299ec633d9 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -368,7 +368,7 @@ module DeclarationListHelpers = // Types. | Item.Types(_, ((TType_app(tcref, _)) :: _)) | Item.UnqualifiedType (tcref :: _) -> - let denv = { denv with shortTypeNames = true } + let denv = { denv with shortTypeNames = true; showDocumentation = false } let layout = NicePrint.layoutTycon denv infoReader AccessibleFromSomewhere m (* width *) tcref.Deref let remarks = OutputFullName isListItem pubpathOfTyconRef fullDisplayTextOfTyconRefAsLayout tcref let layout = LayoutRender.toArray layout From 5d45c8014dbda302c514829f5d4170fbe5eadb80 Mon Sep 17 00:00:00 2001 From: Chet Husk Date: Thu, 1 Apr 2021 19:34:01 -0500 Subject: [PATCH 8/8] default documentation in sigs to false and document callsites that actually want it --- src/fsharp/TypedTreeOps.fs | 2 +- src/fsharp/TypedTreeOps.fsi | 1 + src/fsharp/fsc.fs | 28 +++++++++---------- src/fsharp/service/FSharpCheckerResults.fs | 14 ++++++---- src/fsharp/service/ServiceDeclarationLists.fs | 8 +++++- 5 files changed, 31 insertions(+), 22 deletions(-) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 1dd93ca40a1..1b7ae99c04d 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2795,7 +2795,7 @@ type DisplayEnv = showAttributes = false showOverrides = true showConstraintTyparAnnotations = true - showDocumentation = true + showDocumentation = false abbreviateAdditionalConstraints = false showTyparDefaultConstraints = false shortConstraints = false diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index d1023a82043..c8cd514ec55 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -987,6 +987,7 @@ type DisplayEnv = abbreviateAdditionalConstraints: bool showTyparDefaultConstraints: bool /// If set, signatures will be rendered with XML documentation comments for members if they exist + /// Defaults to false, expected use cases include things like signature file generation. showDocumentation: bool shrinkOverloads: bool printVerboseSignatures: bool diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 09b71d8835d..da1e1648ce0 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -309,20 +309,20 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, lcidFromCodePage, argv) /// Write a .fsi file for the --sig option module InterfaceFileWriter = - let BuildInitialDisplayEnvForSigFileGeneration tcGlobals = - let denv = DisplayEnv.Empty tcGlobals - let denv = - { denv with - showImperativeTyparAnnotations=true - showHiddenMembers=true - showObsoleteMembers=true - showAttributes=true } - denv.SetOpenPaths - [ FSharpLib.RootPath - FSharpLib.CorePath - FSharpLib.CollectionsPath - FSharpLib.ControlPath - (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ] + let BuildInitialDisplayEnvForSigFileGeneration tcGlobals = + let denv = + { DisplayEnv.Empty tcGlobals with + showImperativeTyparAnnotations = true + showHiddenMembers = true + showObsoleteMembers = true + showAttributes = true + showDocumentation = true } + denv.SetOpenPaths + [ FSharpLib.RootPath + FSharpLib.CorePath + FSharpLib.CollectionsPath + FSharpLib.ControlPath + (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ] let WriteInterfaceFile (tcGlobals, tcConfig: TcConfig, infoReader, declaredImpls) = diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 5f0e903ea11..a06665663f8 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -1974,13 +1974,15 @@ type FSharpCheckFileResults threadSafeOp (fun () -> None) (fun scope -> scope.ImplementationFile |> Option.map (fun implFile -> - let denv = DisplayEnv.Empty scope.TcGlobals + // this logic copied from fsc's InterfaceFileWriter.BuildInitialDisplayEnvForSigFileGeneration, + // should/can it be consolidated? let denv = - { denv with - showImperativeTyparAnnotations=true - showHiddenMembers=true - showObsoleteMembers=true - showAttributes=true } + { DisplayEnv.Empty scope.TcGlobals with + showImperativeTyparAnnotations = true + showHiddenMembers = true + showObsoleteMembers = true + showAttributes = true + showDocumentation = true } let denv = denv.SetOpenPaths [ FSharpLib.RootPath diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index 7299ec633d9..5b92be0433a 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -368,7 +368,13 @@ module DeclarationListHelpers = // Types. | Item.Types(_, ((TType_app(tcref, _)) :: _)) | Item.UnqualifiedType (tcref :: _) -> - let denv = { denv with shortTypeNames = true; showDocumentation = false } + let denv = { denv with + // tooltips are space-constrained, so use shorter names + shortTypeNames = true + // tooltips are space-constrained, so don't include xml doc comments + // on types/members. The doc comments for the actual member will still + // be shown in the tip. + showDocumentation = false } let layout = NicePrint.layoutTycon denv infoReader AccessibleFromSomewhere m (* width *) tcref.Deref let remarks = OutputFullName isListItem pubpathOfTyconRef fullDisplayTextOfTyconRefAsLayout tcref let layout = LayoutRender.toArray layout