diff --git a/src/FsAutoComplete/CodeFixes/ConvertTripleSlashCommentToXmlTaggedDoc.fs b/src/FsAutoComplete/CodeFixes/ConvertTripleSlashCommentToXmlTaggedDoc.fs new file mode 100644 index 000000000..ba46ceb52 --- /dev/null +++ b/src/FsAutoComplete/CodeFixes/ConvertTripleSlashCommentToXmlTaggedDoc.fs @@ -0,0 +1,198 @@ +module FsAutoComplete.CodeFix.ConvertTripleSlashCommentToXmlTaggedDoc + +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 +open FSharp.Compiler.Xml +open System + +let title = "Convert '///' comment to XML-tagged doc comment" + +let private containsPosAndNotEmptyAndNotElaborated (pos: FSharp.Compiler.Text.Position) (xmlDoc: PreXmlDoc) = + let containsPosAndNoSummaryPresent (xd: PreXmlDoc) = + let d = xd.ToXmlDoc(false, None) + + if rangeContainsPos d.Range pos then + let summaryPresent = + d.UnprocessedLines |> Array.exists (fun s -> s.Contains("")) + + not summaryPresent + else + false + + not xmlDoc.IsEmpty && containsPosAndNoSummaryPresent xmlDoc + +let private isLowerAstElemWithPreXmlDoc input pos = + SyntaxTraversal.Traverse( + pos, + input, + { new SyntaxVisitorBase<_>() with + member _.VisitBinding(_, defaultTraverse, synBinding) = + match synBinding with + | SynBinding(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | _ -> defaultTraverse synBinding + + member _.VisitComponentInfo(_, synComponentInfo) = + match synComponentInfo with + | SynComponentInfo(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | _ -> None + + member _.VisitRecordDefn(_, fields, _) = + let isInLine c = + match c with + | SynField(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | _ -> None + + fields |> List.tryPick isInLine + + member _.VisitUnionDefn(_, cases, _) = + let isInLine c = + match c with + | SynUnionCase(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | _ -> None + + cases |> List.tryPick isInLine + + member _.VisitEnumDefn(_, cases, _) = + let isInLine b = + match b with + | SynEnumCase(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | _ -> None + + cases |> List.tryPick isInLine + + member _.VisitLetOrUse(_, _, defaultTraverse, bindings, _) = + let isInLine b = + match b with + | SynBinding(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | _ -> defaultTraverse b + + bindings |> List.tryPick isInLine + + member _.VisitExpr(_, _, defaultTraverse, expr) = defaultTraverse expr } // needed for nested let bindings + ) + +let private isModuleOrNamespaceOrAutoPropertyWithPreXmlDoc input pos = + SyntaxTraversal.Traverse( + pos, + input, + { new SyntaxVisitorBase<_>() with + + member _.VisitModuleOrNamespace(_, synModuleOrNamespace) = + match synModuleOrNamespace with + | SynModuleOrNamespace(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> Some xmlDoc + | 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(xmlDoc = xmlDoc) when containsPosAndNotEmptyAndNotElaborated pos xmlDoc -> + Some xmlDoc + | _ -> 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(xmlDoc = xmlDoc) when + containsPosAndNotEmptyAndNotElaborated pos xmlDoc + -> + Some xmlDoc + | _ -> None) + | _ -> None) + | _ -> None) + + findNested decls } + ) + +let private isAstElemWithPreXmlDoc input pos = + match isLowerAstElemWithPreXmlDoc input pos with + | Some xml -> Some xml + | _ -> isModuleOrNamespaceOrAutoPropertyWithPreXmlDoc input pos + +let private collectCommentContents + (startPos: FSharp.Compiler.Text.Position) + (endPos: FSharp.Compiler.Text.Position) + (sourceText: NamedText) + = + let rec loop (p: FSharp.Compiler.Text.Position) acc = + if p.Line > endPos.Line then + acc + else + let currentLine = sourceText.GetLine p + + match currentLine with + | None -> acc + | Some line -> + let idx = line.IndexOf("///") + + if idx >= 0 then + let existingComment = line.TrimStart().Substring(3).TrimStart() + let acc = acc @ [ existingComment ] + + match sourceText.NextLine p with + | None -> acc + | Some nextLinePos -> loop nextLinePos acc + else + acc + + loop startPos List.empty + +let private wrapInSummary indent comments = + let indentation = String.replicate indent " " + + match comments with + | [] -> $"{indentation}/// " + | [ c ] -> $"{indentation}/// %s{c}" + | cs -> + seq { + yield $"{indentation}/// {Environment.NewLine}" + yield! cs |> List.map (fun s -> $"%s{indentation}/// %s{s}{Environment.NewLine}") + yield $"%s{indentation}/// " + } + |> String.concat "" + +let fix (getParseResultsForFile: GetParseResultsForFile) (getRangeText: GetRangeText) : 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 = isAstElemWithPreXmlDoc parseAndCheck.GetAST fcsPos + + match showFix with + | Some xmlDoc -> + let d = xmlDoc.ToXmlDoc(false, None) + + let origCommentContents = + collectCommentContents d.Range.Start d.Range.End sourceText + + let indent = lineStr.IndexOf("///") + let summaryXmlDoc = wrapInSummary indent origCommentContents + + let range = + { Start = fcsPosToLsp (d.Range.Start.WithColumn 0) + End = fcsPosToLsp (d.Range.End) } + + let e = + { Range = range + NewText = summaryXmlDoc } + + return + [ { Edits = [| e |] + File = codeActionParams.TextDocument + Title = title + SourceDiagnostic = None + Kind = FixKind.Refactor } ] + | None -> return [] + } diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 5258578c0..2f4bb7930 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1534,6 +1534,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar AddMissingInstanceMember.fix AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText + ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]) diff --git a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs index 5b828fcb5..5bc4880e7 100644 --- a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs @@ -1197,6 +1197,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) = AddMissingInstanceMember.fix AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText + ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |] diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index fb50240d7..b0687b700 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -627,6 +627,325 @@ let private convertPositionalDUToNamedTests state = """ ]) +let private convertTripleSlashCommentToXmlTaggedDocTests state = + serverTestList (nameof ConvertTripleSlashCommentToXmlTaggedDoc) state defaultConfigDto None (fun server -> + [ let selectCodeFix = CodeFix.withTitle ConvertTripleSlashCommentToXmlTaggedDoc.title + + testCaseAsync "single line comment over top level function" + <| CodeFix.check + server + """ + /// $0line 1 + let f () = () + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// line 1 + let f () = () + """ + + testCaseAsync "multiline comments over top level function" + <| CodeFix.check + server + """ + /// $0line 1 + /// line 2 + /// line 3 + /// line 4 + let f a b c = a + b + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// + /// line 1 + /// line 2 + /// line 3 + /// line 4 + /// + let f a b c = a + b + """ + + testCaseAsync "multiline comments over nested function" + <| CodeFix.check + server + """ + /// line 1 + /// line 2 + /// line 3 + let g () = + /// line 1 + /// line 2 + /// line $03 + /// line 4 + let f x = x * x + () + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// line 1 + /// line 2 + /// line 3 + let g () = + /// + /// line 1 + /// line 2 + /// line 3 + /// line 4 + /// + let f x = x * x + () + """ + + testCaseAsync "single line comment over use" + <| CodeFix.check + server + """ + let f a b _ = + /// line on use$0 + use r = new System.IO.BinaryReader(null) + + a + b + """ + Diagnostics.acceptAll + selectCodeFix + """ + let f a b _ = + /// line on use + use r = new System.IO.BinaryReader(null) + + a + b + """ + + testCaseAsync "multiline comments over record type" + <| CodeFix.check + server + """ + /// line 1 + /// line 2 + /// line 3 + $0/// line 4 + type MyRecord = { Foo: int } + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// + /// line 1 + /// line 2 + /// line 3 + /// line 4 + /// + type MyRecord = { Foo: int } + """ + + testCaseAsync "multiline comments over discriminated union type" + <| CodeFix.check + server + """ + /// line 1 on DU + /// $0line 2 on DU + /// line 3 on DU + type DiscUnionTest = + /// line 1 on Field 1 + /// line 2 on Field 1 + | Field1 + /// line 1 on Field 2 + /// line 2 on Field 2 + | Field2 + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// + /// line 1 on DU + /// line 2 on DU + /// line 3 on DU + /// + type DiscUnionTest = + /// line 1 on Field 1 + /// line 2 on Field 1 + | Field1 + /// line 1 on Field 2 + /// line 2 on Field 2 + | Field2 + """ + + testCaseAsync "multiline comments over discriminated union field" + <| CodeFix.check + server + """ + /// line 1 on DU + /// line 2 on DU + /// line 3 on DU + type DiscUnionTest = + /// line 1 on Field 1 + /// line 2 on Field 1 + | Field1 + /// line 1 $0on Field 2 + /// line 2 on Field 2 + | Field2 + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// line 1 on DU + /// line 2 on DU + /// line 3 on DU + type DiscUnionTest = + /// line 1 on Field 1 + /// line 2 on Field 1 + | Field1 + /// + /// line 1 on Field 2 + /// line 2 on Field 2 + /// + | Field2 + """ + + testCaseAsync "multiline comments over enum" + <| CodeFix.check + server + """ + $0/// line 1 on enum + /// line 2 on enum + type myEnum = + | value1 = 1 + | value2 = 2 + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// + /// line 1 on enum + /// line 2 on enum + /// + type myEnum = + | value1 = 1 + | value2 = 2 + """ + + testCaseAsync "multiline comment over class" + <| CodeFix.check + server + """ + //$0/ On Class 1 + /// On Class 2 + type MyClass() = + /// On member 1 + /// On member 2 + member val Name = "" with get, set + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// + /// On Class 1 + /// On Class 2 + /// + type MyClass() = + /// On member 1 + /// On member 2 + member val Name = "" with get, set + """ + + testCaseAsync "multiline comment over member" + <| CodeFix.check + server + """ + type MyClass() = + /// on new 1 + $0/// on new 2 + new() = MyClass() + """ + Diagnostics.acceptAll + selectCodeFix + """ + type MyClass() = + /// + /// on new 1 + /// on new 2 + /// + new() = MyClass() + """ + + testCaseAsync "multiline comment over autoproperty" + <| CodeFix.check + server + """ + type MyClass() = + /// line 1 on autoproperty + /// li$0ne 2 on autoproperty + member val Name = "" with get, set + """ + Diagnostics.acceptAll + selectCodeFix + """ + type MyClass() = + /// + /// line 1 on autoproperty + /// line 2 on autoproperty + /// + member val Name = "" with get, set + """ + + testCaseAsync "multiline comment over named module" + <| CodeFix.check + server + """ + $0/// On named module 1 + /// On named module 2 + module M + let f x = x + """ + Diagnostics.acceptAll + selectCodeFix + """ + /// + /// On named module 1 + /// On named module 2 + /// + module M + let f x = x + """ + + testCaseAsync "multiline comment over nested module" + <| CodeFix.check + server + """ + module M + module MyNestedModule = + /// Line 1 on$0 MyNestedNestedModule + /// Line 2 on MyNestedNestedModule + module MyNestedNestedModule = + let x = 3 + """ + Diagnostics.acceptAll + selectCodeFix + """ + module M + module MyNestedModule = + /// + /// Line 1 on MyNestedNestedModule + /// Line 2 on MyNestedNestedModule + /// + module MyNestedNestedModule = + let x = 3 + """ + + testCaseAsync "is not applicable to existing xml tag comment" + <| CodeFix.checkNotApplicable + server + """ + /// + /// foo$0 + /// ... + """ + Diagnostics.acceptAll + selectCodeFix ]) + let private generateAbstractClassStubTests state = let config = { defaultConfigDto with AbstractClassStubGeneration = Some true } serverTestList (nameof GenerateAbstractClassStub) state config None (fun server -> [ @@ -1656,6 +1975,7 @@ let tests state = testList "CodeFix-tests" [ convertDoubleEqualsToSingleEqualsTests state convertInvalidRecordToAnonRecordTests state convertPositionalDUToNamedTests state + convertTripleSlashCommentToXmlTaggedDocTests state generateAbstractClassStubTests state generateRecordStubTests state generateUnionCasesTests state