call the GenerateXmlDocumentation Command from a CodeFix

src/FsAutoComplete/CodeFixes/GenerateXmlDocumentation.fs

@@ -0,0 +1,158 @@
+module FsAutoComplete.CodeFix.GenerateXmlDocumentation
+
+open FsToolkit.ErrorHandling
+open FsAutoComplete.CodeFix.Types
+open Ionide.LanguageServerProtocol.Types
+open FsAutoComplete
+open FsAutoComplete.LspHelpers
+open FSharp.Compiler.Syntax
+open FSharp.Compiler.Text.Range
+
+let title = "Generate placeholder XML documentation"
+
+let private longIdentContainsPos (longIdent: LongIdent) (pos: FSharp.Compiler.Text.pos) =
+  longIdent
+  |> List.tryFind (fun i -> rangeContainsPos i.idRange pos)
+  |> Option.isSome
+
+let private isLowerAstElemWithEmptyPreXmlDoc input pos =
+  SyntaxTraversal.Traverse(
+    pos,
+    input,
+    { new SyntaxVisitorBase<_>() with
+        member _.VisitBinding(_, defaultTraverse, synBinding) =
+          match synBinding with
+          | SynBinding(xmlDoc = xmlDoc) as s when rangeContainsPos s.RangeOfBindingWithoutRhs pos && xmlDoc.IsEmpty ->
+            Some()
+          | _ -> defaultTraverse synBinding
+
+        member _.VisitComponentInfo(_, synComponentInfo) =
+          match synComponentInfo with
+          | SynComponentInfo(longId = longId; xmlDoc = xmlDoc) when longIdentContainsPos longId pos && xmlDoc.IsEmpty ->
+            Some()
+          | _ -> None
+
+        member _.VisitRecordDefn(_, fields, _) =
+          let isInLine c =
+            match c with
+            | SynField(xmlDoc = xmlDoc; idOpt = Some ident) when rangeContainsPos ident.idRange pos && xmlDoc.IsEmpty ->
+              Some()
+            | _ -> None
+
+          fields |> List.tryPick isInLine
+
+        member _.VisitUnionDefn(_, cases, _) =
+          let isInLine c =
+            match c with
+            | SynUnionCase(xmlDoc = xmlDoc; ident = (SynIdent(ident = ident))) when
+              rangeContainsPos ident.idRange pos && xmlDoc.IsEmpty
+              ->
+              Some()
+            | _ -> None
+
+          cases |> List.tryPick isInLine
+
+        member _.VisitEnumDefn(_, cases, _) =
+          let isInLine b =
+            match b with
+            | SynEnumCase(xmlDoc = xmlDoc; ident = (SynIdent(ident = ident))) when
+              rangeContainsPos ident.idRange pos && xmlDoc.IsEmpty
+              ->
+              Some()
+            | _ -> None
+
+          cases |> List.tryPick isInLine
+
+        member _.VisitLetOrUse(_, _, defaultTraverse, bindings, _) =
+          let isInLine b =
+            match b with
+            | SynBinding(xmlDoc = xmlDoc) as s when rangeContainsPos s.RangeOfBindingWithoutRhs pos && xmlDoc.IsEmpty ->
+              Some()
+            | _ -> defaultTraverse b
+
+          bindings |> List.tryPick isInLine
+
+        member _.VisitExpr(_, _, defaultTraverse, expr) = defaultTraverse expr } // needed for nested let bindings
+  )
+
+let private isModuleOrNamespaceOrAutoPropertyWithEmptyPreXmlDoc input pos =
+  SyntaxTraversal.Traverse(
+    pos,
+    input,
+    { new SyntaxVisitorBase<_>() with
+
+        member _.VisitModuleOrNamespace(_, synModuleOrNamespace) =
+          match synModuleOrNamespace with
+          | SynModuleOrNamespace(longId = longId; xmlDoc = xmlDoc) when
+            longIdentContainsPos longId pos && xmlDoc.IsEmpty
+            ->
+            Some()
+          | SynModuleOrNamespace(decls = decls) ->
+
+            let rec findNested decls =
+              decls
+              |> List.tryPick (fun d ->
+                match d with
+                | SynModuleDecl.NestedModule(moduleInfo = moduleInfo; decls = decls) ->
+                  match moduleInfo with
+                  | SynComponentInfo(longId = longId; xmlDoc = xmlDoc) when
+                    longIdentContainsPos longId pos && xmlDoc.IsEmpty
+                    ->
+                    Some()
+                  | _ -> findNested decls
+                | SynModuleDecl.Types(typeDefns = typeDefns) ->
+                  typeDefns
+                  |> List.tryPick (fun td ->
+                    match td with
+                    | SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _)) ->
+                      members
+                      |> List.tryPick (fun m ->
+                        match m with
+                        | SynMemberDefn.AutoProperty(ident = ident; xmlDoc = xmlDoc) when
+                          rangeContainsPos ident.idRange pos && xmlDoc.IsEmpty
+                          ->
+                          Some()
+                        | _ -> None)
+                    | _ -> None)
+                | _ -> None)
+
+            findNested decls }
+  )
+
+let private isAstElemWithEmptyPreXmlDoc input pos =
+  match isLowerAstElemWithEmptyPreXmlDoc input pos with
+  | Some xml -> Some xml
+  | _ -> isModuleOrNamespaceOrAutoPropertyWithEmptyPreXmlDoc input pos
+
+let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
+  fun codeActionParams ->
+    asyncResult {
+      let filePath = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath
+      let fcsPos = protocolPosToPos codeActionParams.Range.Start
+      let! (parseAndCheck, lineStr, _sourceText) = getParseResultsForFile filePath fcsPos
+      let showFix = isAstElemWithEmptyPreXmlDoc parseAndCheck.GetAST fcsPos
+
+      match showFix with
+      | Some _ ->
+        let! docEdit = Commands.GenerateXmlDocumentation(parseAndCheck, fcsPos, lineStr)
+
+        match docEdit with
+        | Some({ InsertPosition = insertPosition
+                 InsertText = formattedXmlDoc }) ->
+          let protocolPos = fcsPosToLsp insertPosition
+
+          let editRange =
+            { Start = protocolPos
+              End = protocolPos }
+
+          let text = formattedXmlDoc
+
+          return
+            [ { Edits = [| { Range = editRange; NewText = text } |]
+                File = codeActionParams.TextDocument
+                Title = title
+                SourceDiagnostic = None
+                Kind = FixKind.Refactor } ]
+        | _ -> return []
+      | None -> return []
+    }

src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs

@@ -1599,6 +1599,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
          AddExplicitTypeAnnotation.fix tryGetParseResultsForFile
          ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText
          ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText
+         GenerateXmlDocumentation.fix tryGetParseResultsForFile
          Run.ifEnabled
            (fun _ -> config.AddPrivateAccessModifier)
            (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace)

src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs

@@ -1210,6 +1210,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
              AddExplicitTypeAnnotation.fix tryGetParseResultsForFile
              ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText
              ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText
+             GenerateXmlDocumentation.fix tryGetParseResultsForFile
              Run.ifEnabled
                (fun _ -> config.AddPrivateAccessModifier)
                (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace)

test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs

@@ -1453,6 +1453,152 @@ let private convertTripleSlashCommentToXmlTaggedDocTests state =
         Diagnostics.acceptAll
         selectCodeFix ])
 
+let private generateXmlDocumentationTests state =
+  serverTestList (nameof GenerateXmlDocumentation) state defaultConfigDto None (fun server ->
+    [ let selectCodeFix = CodeFix.withTitle GenerateXmlDocumentation.title
+
+      testCaseAsync "documentation for function with two parameters"
+      <| CodeFix.check
+        server
+        """
+        let $0f x y = x + y
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+        """
+        /// <summary></summary>
+        /// <param name="x"></param>
+        /// <param name="y"></param>
+        /// <returns></returns>
+        let f x y = x + y
+        """
+
+      testCaseAsync "documentation for use"
+      <| CodeFix.check
+        server
+        """
+        let f a b _ =
+          use $0r = new System.IO.BinaryReader(null)
+
+          a + b
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+        """
+        let f a b _ =
+          /// <summary></summary>
+          /// <returns></returns>
+          use r = new System.IO.BinaryReader(null)
+
+          a + b
+        """
+
+      testCaseAsync "not applicable for record type"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        type MyRec$0ord = { Foo: int }
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+
+      testCaseAsync "not applicable for discriminated union type"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        type Dis$0cUnionTest =
+          | Field1
+          | Field2
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+
+      testCaseAsync "not applicable for discriminated union case"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        type DiscUnionTest =
+          | C$0ase1
+          | Case2
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+
+      testCaseAsync "not applicable on enum type"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        type myE$0num =
+        | value1 = 1
+        | value2 = 2
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+
+      testCaseAsync "not applicable on class type"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        type MyC$0lass() =
+          member val Name = "" with get, set
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+
+      testCaseAsync "documentation on member"
+      <| CodeFix.check
+        server
+        """
+        type MyClass() =
+          n$0ew(x: int) = MyClass()
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+        """
+        type MyClass() =
+          /// <summary></summary>
+          /// <param name="x"></param>
+          /// <returns></returns>
+          new(x: int) = MyClass()
+        """
+
+      testCaseAsync "documentation on autoproperty"
+      <| CodeFix.check
+        server
+        """
+        type MyClass() =
+          member val Na$0me = "" with get, set
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+        """
+        type MyClass() =
+          /// <summary></summary>
+          /// <returns></returns>
+          member val Name = "" with get, set
+        """
+
+      testCaseAsync "not applicable on named module"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        module $0M
+          let f x = x
+        """
+        Diagnostics.acceptAll
+        selectCodeFix
+
+      testCaseAsync "not applicable on nested module"
+      <| CodeFix.checkNotApplicable
+        server
+        """
+        module M
+          module MyNestedMo$0dule =
+            let x = 3
+        """
+        Diagnostics.acceptAll
+        selectCodeFix ])
+
 let private generateAbstractClassStubTests state =
   let config = { defaultConfigDto with AbstractClassStubGeneration = Some true }
   serverTestList (nameof GenerateAbstractClassStub) state config None (fun server -> [
@@ -2503,6 +2649,7 @@ let tests state = testList "CodeFix-tests" [
   generateAbstractClassStubTests state
   generateRecordStubTests state
   generateUnionCasesTests state
+  generateXmlDocumentationTests state
   ImplementInterfaceTests.tests state
   makeDeclarationMutableTests state
   makeOuterBindingRecursiveTests state