Xml comment generation for generated signature files

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 = false
         abbreviateAdditionalConstraints = false
         showTyparDefaultConstraints = false
         shortConstraints = false

src/fsharp/TypedTreeOps.fsi

@@ -986,6 +986,9 @@ type DisplayEnv =
       showConstraintTyparAnnotations:bool
       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
       g: TcGlobals

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

src/fsharp/service/FSharpCheckerResults.fs

@@ -1969,7 +1969,34 @@ 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 ->
+                // this logic copied from fsc's InterfaceFileWriter.BuildInitialDisplayEnvForSigFileGeneration,
+                // should/can it be consolidated?
+                let denv =
+                    { DisplayEnv.Empty scope.TcGlobals with
+                       showImperativeTyparAnnotations = true
+                       showHiddenMembers = true
+                       showObsoleteMembers = true
+                       showAttributes = true
+                       showDocumentation = 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 

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 *

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  }
+            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

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

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

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 =

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
+
+[<TestFixture>]
+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
+
+    [<Test>]
+    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"""

tests/fsharp/FSharpSuite.Tests.fsproj

@@ -25,6 +25,7 @@
     <Compile Include="single-test.fs" />
     <Compile Include="TypeProviderTests.fs" />
     <Compile Include="tests.fs" />
+    <Compile Include="Compiler\Service\SignatureGenerationTests.fs" />
     <Compile Include="Compiler\CodeGen\EmittedIL\StaticMember.fs" />
     <Compile Include="Compiler\CodeGen\EmittedIL\StaticLinkTests.fs" />
     <Compile Include="Compiler\CodeGen\EmittedIL\Mutation.fs" />