From d65795cf1f8d4ad2777ae0f2c090a5905387d043 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 17:33:12 +0100 Subject: [PATCH 01/15] add basic prototype codefix --- .../CodeFixes/AddPrivateAccessModifier.fs | 87 ++++++++ .../LspServers/AdaptiveFSharpLspServer.fs | 192 +++++++++--------- .../CodeFixTests/Tests.fs | 54 +++++ test/FsAutoComplete.Tests.Lsp/Program.fs | 2 +- 4 files changed, 242 insertions(+), 93 deletions(-) create mode 100644 src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs new file mode 100644 index 000000000..64d1d58fb --- /dev/null +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -0,0 +1,87 @@ +module FsAutoComplete.CodeFix.AddPrivateAccessModifier + +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 = "add private access modifier" + +let private getRangeToEdit input pos = + SyntaxTraversal.Traverse( + pos, + input, + { new SyntaxVisitorBase<_>() with + member _.VisitBinding(path, _, synBinding) = + match synBinding with + | SynBinding(headPat = headPat) as s when rangeContainsPos s.RangeOfHeadPattern pos -> + match headPat with + | SynPat.Named(accessibility = None) + | SynPat.LongIdent(accessibility = None) -> + let r = + path + |> Seq.rev + |> Seq.tryPick (fun p -> + match p with + | SyntaxNode.SynModule m -> Some m + | _ -> None) + + Some((s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start), r) + | _ -> None + | _ -> None } + ) + +type SymbolUseWorkspace = + bool + -> bool + -> bool + -> FSharp.Compiler.Text.Position + -> LineStr + -> NamedText + -> ParseAndCheckResults + -> Async, FSharp.Compiler.Text.range array>, string>> + +let fix + (getParseResultsForFile: GetParseResultsForFile) + (getRangeText: GetRangeText) + (symbolUseWorkspace: SymbolUseWorkspace) + : 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 rangeAndPath = getRangeToEdit parseAndCheck.GetAST fcsPos + + match rangeAndPath with + | Some(r, Some path) -> + + let! (s, uses) = symbolUseWorkspace false true false r.Start lineStr sourceText parseAndCheck + let useRanges = uses.Values |> Array.concat + let declRange = path.Range + + let usedOutsideOfDecl = + useRanges + |> Array.exists (fun usingRange -> + usingRange.FileName <> r.FileName + || not (rangeContainsRange declRange usingRange)) + + if usedOutsideOfDecl then + return [] + else + let e = + { Range = fcsRangeToLsp r + NewText = "private " } + + return + [ { Edits = [| e |] + File = codeActionParams.TextDocument + Title = title + SourceDiagnostic = None + Kind = FixKind.Refactor } ] + | _ -> return [] + } diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 3de5c9de5..893546206 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1386,6 +1386,102 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar member x.ParseFileInProject(file) = forceGetParseResults file |> Option.ofResult } + let getDependentProjectsOfProjects ps = + let projectSnapshot = forceLoadProjects () + + let allDependents = System.Collections.Generic.HashSet() + + let currentPass = ResizeArray() + currentPass.AddRange(ps |> List.map (fun p -> p.ProjectFileName)) + + let mutable continueAlong = true + + while continueAlong do + let dependents = + projectSnapshot + |> Seq.filter (fun p -> + p.ReferencedProjects + |> Seq.exists (fun r -> + match r.ProjectFilePath with + | None -> false + | Some p -> currentPass.Contains(p))) + + if Seq.isEmpty dependents then + continueAlong <- false + currentPass.Clear() + else + for d in dependents do + allDependents.Add d |> ignore + + currentPass.Clear() + currentPass.AddRange(dependents |> Seq.map (fun p -> p.ProjectFileName)) + + Seq.toList allDependents + + + let getDeclarationLocation (symbolUse, text) = + let getProjectOptions file = + getProjectOptionsForFile file |> AVal.force |> selectProject + + let projectsThatContainFile file = + getProjectOptionsForFile file |> AVal.force + + SymbolLocation.getDeclarationLocation ( + symbolUse, + text, + getProjectOptions, + projectsThatContainFile, + getDependentProjectsOfProjects + ) + + let symbolUseWorkspace + (includeDeclarations: bool) + (includeBackticks: bool) + (errorOnFailureToFixRange: bool) + pos + lineStr + text + tyRes + = + + let findReferencesForSymbolInFile (file: string, project, symbol) = + async { + let checker = checker |> AVal.force + + if File.Exists(UMX.untag file) then + // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files + return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol) + else + // untitled script files + match forceGetRecentTypeCheckResults file with + | Error _ -> return [||] + | Ok tyRes -> + let! ct = Async.CancellationToken + let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) + return usages |> Seq.map (fun u -> u.Range) + } + + let tryGetProjectOptionsForFsproj (file: string) = + forceGetProjectOptions file |> Option.ofResult + + let getAllProjectOptions () : _ seq = + allProjectOptions'.Content |> AVal.force :> _ + + Commands.symbolUseWorkspace + getDeclarationLocation + findReferencesForSymbolInFile + forceFindSourceText + tryGetProjectOptionsForFsproj + getAllProjectOptions + includeDeclarations + includeBackticks + errorOnFailureToFixRange + pos + lineStr + text + tyRes + + let codefixes = let getFileLines = forceFindSourceText @@ -1438,6 +1534,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let writeAbstractClassStub = AbstractClassStubGenerator.writeAbstractClassStub codeGenServer + let getAbstractClassStub tyRes objExprRange lines lineStr = Commands.getAbstractClassStub @@ -1504,6 +1601,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText + AddPrivateAccessModifier.fix tryGetParseResultsForFile getRangeText symbolUseWorkspace UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]) @@ -1590,38 +1688,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar |> Array.map (fun sourceFile -> proj, sourceFile)) |> Array.distinct - let getDependentProjectsOfProjects ps = - let projectSnapshot = forceLoadProjects () - - let allDependents = System.Collections.Generic.HashSet() - - let currentPass = ResizeArray() - currentPass.AddRange(ps |> List.map (fun p -> p.ProjectFileName)) - - let mutable continueAlong = true - - while continueAlong do - let dependents = - projectSnapshot - |> Seq.filter (fun p -> - p.ReferencedProjects - |> Seq.exists (fun r -> - match r.ProjectFilePath with - | None -> false - | Some p -> currentPass.Contains(p))) - - if Seq.isEmpty dependents then - continueAlong <- false - currentPass.Clear() - else - for d in dependents do - allDependents.Add d |> ignore - - currentPass.Clear() - currentPass.AddRange(dependents |> Seq.map (fun p -> p.ProjectFileName)) - - Seq.toList allDependents - + let bypassAdaptiveAndCheckDepenenciesForFile (filePath: string) = async { let tags = [ SemanticConventions.fsac_sourceCodePath, box (UMX.untag filePath) ] @@ -1694,68 +1761,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar } - let getDeclarationLocation (symbolUse, text) = - let getProjectOptions file = - getProjectOptionsForFile file |> AVal.force |> selectProject - - let projectsThatContainFile file = - getProjectOptionsForFile file |> AVal.force - - SymbolLocation.getDeclarationLocation ( - symbolUse, - text, - getProjectOptions, - projectsThatContainFile, - getDependentProjectsOfProjects - ) - - let symbolUseWorkspace - (includeDeclarations: bool) - (includeBackticks: bool) - (errorOnFailureToFixRange: bool) - pos - lineStr - text - tyRes - = - - let findReferencesForSymbolInFile (file: string, project, symbol) = - async { - let checker = checker |> AVal.force - - if File.Exists(UMX.untag file) then - // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files - return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol) - else - // untitled script files - match forceGetRecentTypeCheckResults file with - | Error _ -> return [||] - | Ok tyRes -> - let! ct = Async.CancellationToken - let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) - return usages |> Seq.map (fun u -> u.Range) - } - let tryGetProjectOptionsForFsproj (file: string) = - forceGetProjectOptions file |> Option.ofResult - - let getAllProjectOptions () : _ seq = - allProjectOptions'.Content |> AVal.force :> _ - - Commands.symbolUseWorkspace - getDeclarationLocation - findReferencesForSymbolInFile - forceFindSourceText - tryGetProjectOptionsForFsproj - getAllProjectOptions - includeDeclarations - includeBackticks - errorOnFailureToFixRange - pos - lineStr - text - tyRes + member private x.handleSemanticTokens (filePath: string) range : LspResult = result { diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index b540170bb..22e2953c3 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -643,6 +643,59 @@ let private convertPositionalDUToNamedTests state = """ ]) +let private addPrivateAccessModifierTests state = + serverTestList (nameof AddPrivateAccessModifier) state defaultConfigDto None (fun server -> + [ let selectCodeFix = CodeFix.withTitle AddPrivateAccessModifier.title + + testCaseAsync "addprivate works for simle function" + <| CodeFix.check + server + """ + let f$0 x = x * x + """ + Diagnostics.acceptAll + selectCodeFix + """ + let private f x = x * x + """ + + testCaseAsync "addprivate works for simle identifier" + <| CodeFix.check + server + """ + let x$0 = 23 + """ + Diagnostics.acceptAll + selectCodeFix + """ + let private x = 23 + """ + + testCaseAsync "addprivate is not offered for already private functions" + <| CodeFix.checkNotApplicable + server + """ + let private f$0 x = x * x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "addprivate is not offered for function with outside reference" + <| CodeFix.checkNotApplicable + server + """ + module MyModule = + + let helper x = x + 10 + + let $0f x = helper x + + MyModule.f 10 + """ + Diagnostics.acceptAll + selectCodeFix + ]) + let private convertTripleSlashCommentToXmlTaggedDocTests state = serverTestList (nameof ConvertTripleSlashCommentToXmlTaggedDoc) state defaultConfigDto None (fun server -> [ let selectCodeFix = CodeFix.withTitle ConvertTripleSlashCommentToXmlTaggedDoc.title @@ -2008,6 +2061,7 @@ let tests state = testList "CodeFix-tests" [ convertInvalidRecordToAnonRecordTests state convertPositionalDUToNamedTests state convertTripleSlashCommentToXmlTaggedDocTests state + addPrivateAccessModifierTests state generateAbstractClassStubTests state generateRecordStubTests state generateUnionCasesTests state diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index 1f25dcf6c..05c68740c 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -130,7 +130,7 @@ let tests = generalTests lspTests ] - + |> Test.filter defaultConfig.joinWith.asString (fun z -> (defaultConfig.joinWith.format z).Contains "addprivate" ) [] let main args = From e8b2da0ae3886c2ce16ed07a061c47b9324ec2ec Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 19:15:25 +0100 Subject: [PATCH 02/15] cleanup, fixes, tests --- .../CodeFixes/AddPrivateAccessModifier.fs | 31 ++++++++------- .../CodeFixTests/Tests.fs | 39 ++++++++++++++++++- 2 files changed, 55 insertions(+), 15 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index 64d1d58fb..135942ab7 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -11,6 +11,16 @@ open FSharp.Compiler.Text.Range let title = "add private access modifier" let private getRangeToEdit input pos = + let tryPickContainingRange (path: SyntaxVisitorPath) pos = + path + |> Seq.skip 1 + |> Seq.tryPick (fun p -> + match p with + | SyntaxNode.SynTypeDefn m when rangeContainsPos m.Range pos -> Some m.Range + | SyntaxNode.SynModule m when rangeContainsPos m.Range pos -> Some m.Range + | SyntaxNode.SynModuleOrNamespace m when rangeContainsPos m.Range pos -> Some m.Range + | _ -> None) + SyntaxTraversal.Traverse( pos, input, @@ -21,15 +31,11 @@ let private getRangeToEdit input pos = match headPat with | SynPat.Named(accessibility = None) | SynPat.LongIdent(accessibility = None) -> - let r = - path - |> Seq.rev - |> Seq.tryPick (fun p -> - match p with - | SyntaxNode.SynModule m -> Some m - | _ -> None) + let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start - Some((s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start), r) + match tryPickContainingRange path pos with + | Some r -> Some(editRange, r) + | _ -> None | _ -> None | _ -> None } ) @@ -55,14 +61,13 @@ let fix let filePath = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath let fcsPos = protocolPosToPos codeActionParams.Range.Start let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsPos - let rangeAndPath = getRangeToEdit parseAndCheck.GetAST fcsPos + let editRangeAndDeclRange = getRangeToEdit parseAndCheck.GetAST fcsPos - match rangeAndPath with - | Some(r, Some path) -> + match editRangeAndDeclRange with + | Some(r, declRange) -> - let! (s, uses) = symbolUseWorkspace false true false r.Start lineStr sourceText parseAndCheck + let! (_, uses) = symbolUseWorkspace false true true fcsPos lineStr sourceText parseAndCheck let useRanges = uses.Values |> Array.concat - let declRange = path.Range let usedOutsideOfDecl = useRanges diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index 22e2953c3..a62cb9526 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -647,7 +647,7 @@ let private addPrivateAccessModifierTests state = serverTestList (nameof AddPrivateAccessModifier) state defaultConfigDto None (fun server -> [ let selectCodeFix = CodeFix.withTitle AddPrivateAccessModifier.title - testCaseAsync "addprivate works for simle function" + testCaseAsync "addprivate works for simple function" <| CodeFix.check server """ @@ -659,7 +659,7 @@ let private addPrivateAccessModifierTests state = let private f x = x * x """ - testCaseAsync "addprivate works for simle identifier" + testCaseAsync "addprivate works for simple identifier" <| CodeFix.check server """ @@ -671,6 +671,38 @@ let private addPrivateAccessModifierTests state = let private x = 23 """ + testCaseAsync "addprivate works for simple identifier used in other private function" + <| CodeFix.check + server + """ + module PMod = + let xx$0x = 10 + + module PMod2 = + let insidePMod2 = 23 + + let private a = 23 + + let private g z = + let sF y = y + xxx + z + """ + Diagnostics.acceptAll + selectCodeFix + """ + module PMod = + let private xxx = 10 + + module PMod2 = + let insidePMod2 = 23 + + let private a = 23 + + let private g z = + let sF y = y + xxx + z + """ + testCaseAsync "addprivate is not offered for already private functions" <| CodeFix.checkNotApplicable server @@ -694,6 +726,9 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix + + + ]) let private convertTripleSlashCommentToXmlTaggedDocTests state = From 1642d6f8bd58585f24b386a7e5663488789b10e4 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 22:18:36 +0100 Subject: [PATCH 03/15] guard against LetBindings in ObjectModels --- .../CodeFixes/AddPrivateAccessModifier.fs | 45 ++++++++++++++++--- .../CodeFixTests/Tests.fs | 38 +++++++++++++++- 2 files changed, 76 insertions(+), 7 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index 135942ab7..bebf743e1 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -10,6 +10,37 @@ open FSharp.Compiler.Text.Range let title = "add private access modifier" +let private isLetInsideObjectModel input pos = + SyntaxTraversal.Traverse( + pos, + input, + { new SyntaxVisitorBase<_>() with + member _.VisitModuleOrNamespace(_, synModuleOrNamespace) = + + let rec tryFind (decls: SynModuleDecl list) = + decls + |> List.tryPick (fun d -> + match d with + | SynModuleDecl.Let(range = range) when rangeContainsPos range pos -> None + | 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.LetBindings(range = range) when rangeContainsPos range pos -> Some() + | _ -> None) + | _ -> None) + | SynModuleDecl.NestedModule(decls = nestedDecls) as m -> tryFind nestedDecls + | _ -> None) + + match synModuleOrNamespace with + | SynModuleOrNamespace(decls = decls) as s -> tryFind decls } + ) + |> Option.isSome + let private getRangeToEdit input pos = let tryPickContainingRange (path: SyntaxVisitorPath) pos = path @@ -21,13 +52,13 @@ let private getRangeToEdit input pos = | SyntaxNode.SynModuleOrNamespace m when rangeContainsPos m.Range pos -> Some m.Range | _ -> None) - SyntaxTraversal.Traverse( - pos, - input, + let visitor = { new SyntaxVisitorBase<_>() with member _.VisitBinding(path, _, synBinding) = match synBinding with - | SynBinding(headPat = headPat) as s when rangeContainsPos s.RangeOfHeadPattern pos -> + | SynBinding(headPat = headPat; kind = SynBindingKind.Normal) as s when + rangeContainsPos s.RangeOfHeadPattern pos + -> match headPat with | SynPat.Named(accessibility = None) | SynPat.LongIdent(accessibility = None) -> @@ -38,7 +69,11 @@ let private getRangeToEdit input pos = | _ -> None | _ -> None | _ -> None } - ) + + if isLetInsideObjectModel input pos then + None + else + SyntaxTraversal.Traverse(pos, input, visitor) type SymbolUseWorkspace = bool diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index a62cb9526..866cdf616 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -712,7 +712,7 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix - testCaseAsync "addprivate is not offered for function with outside reference" + testCaseAsync "addprivate is not offered for function with reference outside its declaring module" <| CodeFix.checkNotApplicable server """ @@ -726,9 +726,43 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix + + testCaseAsync "addprivate is not offered for member with reference outside its declaring class" + <| CodeFix.checkNotApplicable + server + """ + type MyClass() = + member _.$0X = 10 + let myInst = MyClass() + myInst.X |> ignore + """ + Diagnostics.acceptAll + selectCodeFix - + testCaseAsync "addprivate is not offered for let bindings inside a class" + <| CodeFix.checkNotApplicable + server + """ + type MyClass() = + let $0f x = x * x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "addprivate works for class member" + <| CodeFix.check + server + """ + type MyClass() = + member _.$0X = 10 + """ + Diagnostics.acceptAll + selectCodeFix + """ + type MyClass() = + member private _.X = 10 + """ ]) let private convertTripleSlashCommentToXmlTaggedDocTests state = From 5c20e37d39be611f2d840e288b44cba7be9dbab5 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 22:35:25 +0100 Subject: [PATCH 04/15] hook up in FsAutoComplete.Lsp --- .../CodeFixes/AddPrivateAccessModifier.fs | 3 +-- .../LspServers/AdaptiveFSharpLspServer.fs | 2 +- .../LspServers/FsAutoComplete.Lsp.fs | 20 +++++++++++++++++++ 3 files changed, 22 insertions(+), 3 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index bebf743e1..548bd7c17 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -8,7 +8,7 @@ open FsAutoComplete.LspHelpers open FSharp.Compiler.Syntax open FSharp.Compiler.Text.Range -let title = "add private access modifier" +let title = "Add private access modifier" let private isLetInsideObjectModel input pos = SyntaxTraversal.Traverse( @@ -88,7 +88,6 @@ type SymbolUseWorkspace = let fix (getParseResultsForFile: GetParseResultsForFile) - (getRangeText: GetRangeText) (symbolUseWorkspace: SymbolUseWorkspace) : CodeFix = fun codeActionParams -> diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 893546206..384fa8f19 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1601,7 +1601,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText - AddPrivateAccessModifier.fix tryGetParseResultsForFile getRangeText symbolUseWorkspace + AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]) diff --git a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs index 072d46636..fa36e7cee 100644 --- a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs @@ -1135,6 +1135,25 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) = let getAbstractClassStubReplacements () = abstractClassStubReplacements () + let symbolUseWorkspace + (includeDeclarations: bool) + (includeBackticks: bool) + (errorOnFailureToFixRange: bool) + pos + lineStr + text + tyRes + = + commands.SymbolUseWorkspace( + pos, + lineStr, + text, + tyRes, + includeDeclarations, + includeBackticks, + errorOnFailureToFixRange + ) + codefixes <- [| Run.ifEnabled (fun _ -> config.UnusedOpensAnalyzer) (RemoveUnusedOpens.fix getFileLines) Run.ifEnabled @@ -1191,6 +1210,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) = AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText + AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |] From d48e7e44abd5dfde84a3347ccd263ccb93c74dc1 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 22:36:18 +0100 Subject: [PATCH 05/15] remove test filter --- test/FsAutoComplete.Tests.Lsp/Program.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index 05c68740c..af9b11566 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -130,7 +130,6 @@ let tests = generalTests lspTests ] - |> Test.filter defaultConfig.joinWith.asString (fun z -> (defaultConfig.joinWith.format z).Contains "addprivate" ) [] let main args = From 5a319ffe6188d1409584f250cd8a35890bd3b29f Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 22:44:06 +0100 Subject: [PATCH 06/15] keep whitespace as it was --- src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs | 2 -- test/FsAutoComplete.Tests.Lsp/Program.fs | 1 + 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 384fa8f19..f0b1e54e1 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1418,7 +1418,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar Seq.toList allDependents - let getDeclarationLocation (symbolUse, text) = let getProjectOptions file = getProjectOptionsForFile file |> AVal.force |> selectProject @@ -1535,7 +1534,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar AbstractClassStubGenerator.writeAbstractClassStub codeGenServer - let getAbstractClassStub tyRes objExprRange lines lineStr = Commands.getAbstractClassStub tryFindAbstractClassExprInBufferAtPos diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index af9b11566..1f25dcf6c 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -131,6 +131,7 @@ let tests = lspTests ] + [] let main args = let outputTemplate = From 588992523df86f87c2a43528286ff3c4b31f8fc3 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 24 Mar 2023 22:46:44 +0100 Subject: [PATCH 07/15] format --- .../LspServers/AdaptiveFSharpLspServer.fs | 114 +++++++++--------- 1 file changed, 57 insertions(+), 57 deletions(-) diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index f0b1e54e1..c66911323 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1419,66 +1419,66 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar Seq.toList allDependents let getDeclarationLocation (symbolUse, text) = - let getProjectOptions file = - getProjectOptionsForFile file |> AVal.force |> selectProject - - let projectsThatContainFile file = - getProjectOptionsForFile file |> AVal.force - - SymbolLocation.getDeclarationLocation ( - symbolUse, - text, - getProjectOptions, - projectsThatContainFile, - getDependentProjectsOfProjects - ) + let getProjectOptions file = + getProjectOptionsForFile file |> AVal.force |> selectProject + + let projectsThatContainFile file = + getProjectOptionsForFile file |> AVal.force + + SymbolLocation.getDeclarationLocation ( + symbolUse, + text, + getProjectOptions, + projectsThatContainFile, + getDependentProjectsOfProjects + ) let symbolUseWorkspace - (includeDeclarations: bool) - (includeBackticks: bool) - (errorOnFailureToFixRange: bool) + (includeDeclarations: bool) + (includeBackticks: bool) + (errorOnFailureToFixRange: bool) + pos + lineStr + text + tyRes + = + + let findReferencesForSymbolInFile (file: string, project, symbol) = + async { + let checker = checker |> AVal.force + + if File.Exists(UMX.untag file) then + // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files + return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol) + else + // untitled script files + match forceGetRecentTypeCheckResults file with + | Error _ -> return [||] + | Ok tyRes -> + let! ct = Async.CancellationToken + let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) + return usages |> Seq.map (fun u -> u.Range) + } + + let tryGetProjectOptionsForFsproj (file: string) = + forceGetProjectOptions file |> Option.ofResult + + let getAllProjectOptions () : _ seq = + allProjectOptions'.Content |> AVal.force :> _ + + Commands.symbolUseWorkspace + getDeclarationLocation + findReferencesForSymbolInFile + forceFindSourceText + tryGetProjectOptionsForFsproj + getAllProjectOptions + includeDeclarations + includeBackticks + errorOnFailureToFixRange pos lineStr text tyRes - = - - let findReferencesForSymbolInFile (file: string, project, symbol) = - async { - let checker = checker |> AVal.force - - if File.Exists(UMX.untag file) then - // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files - return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol) - else - // untitled script files - match forceGetRecentTypeCheckResults file with - | Error _ -> return [||] - | Ok tyRes -> - let! ct = Async.CancellationToken - let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct) - return usages |> Seq.map (fun u -> u.Range) - } - - let tryGetProjectOptionsForFsproj (file: string) = - forceGetProjectOptions file |> Option.ofResult - - let getAllProjectOptions () : _ seq = - allProjectOptions'.Content |> AVal.force :> _ - - Commands.symbolUseWorkspace - getDeclarationLocation - findReferencesForSymbolInFile - forceFindSourceText - tryGetProjectOptionsForFsproj - getAllProjectOptions - includeDeclarations - includeBackticks - errorOnFailureToFixRange - pos - lineStr - text - tyRes let codefixes = @@ -1533,7 +1533,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let writeAbstractClassStub = AbstractClassStubGenerator.writeAbstractClassStub codeGenServer - + let getAbstractClassStub tyRes objExprRange lines lineStr = Commands.getAbstractClassStub tryFindAbstractClassExprInBufferAtPos @@ -1686,7 +1686,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar |> Array.map (fun sourceFile -> proj, sourceFile)) |> Array.distinct - + let bypassAdaptiveAndCheckDepenenciesForFile (filePath: string) = async { let tags = [ SemanticConventions.fsac_sourceCodePath, box (UMX.untag filePath) ] @@ -1761,7 +1761,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar - + member private x.handleSemanticTokens (filePath: string) range : LspResult = result { From e78bdf042f5d850918c7bb8050ea15e338d4d8ff Mon Sep 17 00:00:00 2001 From: dawe Date: Sat, 25 Mar 2023 03:00:13 +0100 Subject: [PATCH 08/15] more guards against bad offerings --- .../CodeFixes/AddPrivateAccessModifier.fs | 135 +++++++++++++++--- .../CodeFixTests/Tests.fs | 93 ++++++++++-- 2 files changed, 197 insertions(+), 31 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index 548bd7c17..5520b65b3 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -6,10 +6,26 @@ open Ionide.LanguageServerProtocol.Types open FsAutoComplete open FsAutoComplete.LspHelpers open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Text.Range let title = "Add private access modifier" +type SymbolUseWorkspace = + bool + -> bool + -> bool + -> FSharp.Compiler.Text.Position + -> LineStr + -> NamedText + -> ParseAndCheckResults + -> Async, FSharp.Compiler.Text.range array>, string>> + +type private Placement = + | Before + | After + let private isLetInsideObjectModel input pos = SyntaxTraversal.Traverse( pos, @@ -52,6 +68,54 @@ let private getRangeToEdit input pos = | SyntaxNode.SynModuleOrNamespace m when rangeContainsPos m.Range pos -> Some m.Range | _ -> None) + let rec findNested path decls = + decls + |> List.tryPick (fun d -> + match d with + | SynModuleDecl.NestedModule( + moduleInfo = SynComponentInfo(longId = longId; accessibility = None); trivia = { ModuleKeyword = Some r }) as m when + longId + |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) + |> Option.isSome + -> + let editRange = r.WithStart r.End + let path = (SyntaxNode.SynModule m) :: path + + match tryPickContainingRange path pos with + | Some r -> Some(editRange, r, After) + | _ -> None + | SynModuleDecl.NestedModule(moduleInfo = moduleInfo; decls = decls) as m -> + let path = (SyntaxNode.SynModule m) :: path + + match moduleInfo with + | _ -> findNested path decls + | SynModuleDecl.Types(typeDefns = typeDefns) as t -> + let path = (SyntaxNode.SynModule t) :: path + + typeDefns + |> List.tryPick (fun td -> + match td with + | SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _)) as d -> + let path = SyntaxNode.SynTypeDefn d :: path + + members + |> List.tryPick (fun m -> + match m with + | SynMemberDefn.AutoProperty(accessibility = None; ident = ident; trivia = trivia) as a when + rangeContainsPos ident.idRange pos + -> + let editRange = + trivia.LeadingKeyword.Range.WithStart trivia.LeadingKeyword.Range.End + + let path = SyntaxNode.SynMemberDefn a :: path + + match tryPickContainingRange path pos with + | Some r -> Some(editRange, r, After) + | _ -> None + | _ -> None) + | _ -> None) + | _ -> None) + let visitor = { new SyntaxVisitorBase<_>() with member _.VisitBinding(path, _, synBinding) = @@ -60,36 +124,56 @@ let private getRangeToEdit input pos = rangeContainsPos s.RangeOfHeadPattern pos -> match headPat with - | SynPat.Named(accessibility = None) - | SynPat.LongIdent(accessibility = None) -> + | SynPat.LongIdent(longDotId = longDotId; accessibility = None; argPats = synArgPats) -> + let posInArgs = + synArgPats.Patterns |> List.exists (fun p -> rangeContainsPos p.Range pos) + + let posInFirstIdent = + longDotId.LongIdent.Length > 1 + && rangeContainsPos longDotId.LongIdent[0].idRange pos + + if posInArgs || posInFirstIdent then + None + else + let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start + + match tryPickContainingRange path pos with + | Some r -> Some(editRange, r, Before) + | _ -> None + | SynPat.Named(accessibility = None; isThisVal = false) -> let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start match tryPickContainingRange path pos with - | Some r -> Some(editRange, r) + | Some r -> Some(editRange, r, Before) | _ -> None | _ -> None - | _ -> None } + | _ -> None + + member _.VisitModuleOrNamespace(path, synModuleOrNamespace) = + match synModuleOrNamespace with + | SynModuleOrNamespace( + longId = longId + accessibility = None + trivia = { LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Module r }) when + longId + |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) + |> Option.isSome + -> + let editRange = r.WithStart r.End + + match tryPickContainingRange path pos with + | Some r -> Some(editRange, r, After) + | _ -> None + | SynModuleOrNamespace(decls = decls) as mOrN -> + let path = SyntaxNode.SynModuleOrNamespace mOrN :: path + findNested path decls } if isLetInsideObjectModel input pos then None else SyntaxTraversal.Traverse(pos, input, visitor) -type SymbolUseWorkspace = - bool - -> bool - -> bool - -> FSharp.Compiler.Text.Position - -> LineStr - -> NamedText - -> ParseAndCheckResults - -> Async, FSharp.Compiler.Text.range array>, string>> - -let fix - (getParseResultsForFile: GetParseResultsForFile) - (symbolUseWorkspace: SymbolUseWorkspace) - : CodeFix = +let fix (getParseResultsForFile: GetParseResultsForFile) (symbolUseWorkspace: SymbolUseWorkspace) : CodeFix = fun codeActionParams -> asyncResult { let filePath = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath @@ -98,7 +182,7 @@ let fix let editRangeAndDeclRange = getRangeToEdit parseAndCheck.GetAST fcsPos match editRangeAndDeclRange with - | Some(r, declRange) -> + | Some(editRange, declRange, placement) -> let! (_, uses) = symbolUseWorkspace false true true fcsPos lineStr sourceText parseAndCheck let useRanges = uses.Values |> Array.concat @@ -106,15 +190,20 @@ let fix let usedOutsideOfDecl = useRanges |> Array.exists (fun usingRange -> - usingRange.FileName <> r.FileName + usingRange.FileName <> editRange.FileName || not (rangeContainsRange declRange usingRange)) if usedOutsideOfDecl then return [] else + let text = + match placement with + | Before -> "private " + | After -> " private" + let e = - { Range = fcsRangeToLsp r - NewText = "private " } + { Range = fcsRangeToLsp editRange + NewText = text } return [ { Edits = [| e |] diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index 866cdf616..522bf504c 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -647,7 +647,7 @@ let private addPrivateAccessModifierTests state = serverTestList (nameof AddPrivateAccessModifier) state defaultConfigDto None (fun server -> [ let selectCodeFix = CodeFix.withTitle AddPrivateAccessModifier.title - testCaseAsync "addprivate works for simple function" + testCaseAsync "add private works for simple function" <| CodeFix.check server """ @@ -659,7 +659,7 @@ let private addPrivateAccessModifierTests state = let private f x = x * x """ - testCaseAsync "addprivate works for simple identifier" + testCaseAsync "add private works for simple identifier" <| CodeFix.check server """ @@ -671,7 +671,7 @@ let private addPrivateAccessModifierTests state = let private x = 23 """ - testCaseAsync "addprivate works for simple identifier used in other private function" + testCaseAsync "add private works for simple identifier used in other private function" <| CodeFix.check server """ @@ -703,7 +703,7 @@ let private addPrivateAccessModifierTests state = z """ - testCaseAsync "addprivate is not offered for already private functions" + testCaseAsync "add private is not offered for already private functions" <| CodeFix.checkNotApplicable server """ @@ -712,7 +712,7 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix - testCaseAsync "addprivate is not offered for function with reference outside its declaring module" + testCaseAsync "add private is not offered for function with reference outside its declaring module" <| CodeFix.checkNotApplicable server """ @@ -727,7 +727,7 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix - testCaseAsync "addprivate is not offered for member with reference outside its declaring class" + testCaseAsync "add private is not offered for member with reference outside its declaring class" <| CodeFix.checkNotApplicable server """ @@ -739,8 +739,31 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix + + testCaseAsync "add private is not offered for member with reference outside its declaring class when caret is on thisValue" + <| CodeFix.checkNotApplicable + server + """ + type MyClass() = + member _$0.X = 10 - testCaseAsync "addprivate is not offered for let bindings inside a class" + let myInst = MyClass() + myInst.X |> ignore + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for member when caret is on parameter" + <| CodeFix.checkNotApplicable + server + """ + type MyClass() = + member _.Func x$0 = x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for let bindings inside a class" <| CodeFix.checkNotApplicable server """ @@ -750,7 +773,7 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix - testCaseAsync "addprivate works for class member" + testCaseAsync "add private works for class member" <| CodeFix.check server """ @@ -763,6 +786,60 @@ let private addPrivateAccessModifierTests state = type MyClass() = member private _.X = 10 """ + + testCaseAsync "add private works for autoproperty" + <| CodeFix.check + server + """ + type MyClass() = + member val Name$0 = "" with get, set + """ + Diagnostics.acceptAll + selectCodeFix + """ + type MyClass() = + member val private Name = "" with get, set + """ + + testCaseAsync "add private is not offered for autoproperty with references outside its class" + <| CodeFix.checkNotApplicable + server + """ + type MyClass() = + member val Name$0 = "" with get, set + + let myInst = MyClass() + myInst.Name |> ignore + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private works for module" + <| CodeFix.check + server + """ + module M$0 = + () + """ + Diagnostics.acceptAll + selectCodeFix + """ + module private M = + () + """ + + testCaseAsync "add private is not offered for module with references outside its declaring module" + <| CodeFix.checkNotApplicable + server + """ + module M = + module N$0 = + let foofoo = 10 + + M.N.foofoo |> ignore + """ + Diagnostics.acceptAll + selectCodeFix ]) let private convertTripleSlashCommentToXmlTaggedDocTests state = From a5725f414126eaccad2c21b02b1e90abac71867c Mon Sep 17 00:00:00 2001 From: dawe Date: Sat, 25 Mar 2023 15:01:03 +0100 Subject: [PATCH 09/15] Improve Module support --- .../CodeFixes/AddPrivateAccessModifier.fs | 41 +++-- .../CodeFixTests/Tests.fs | 152 +++++++++++++++++- 2 files changed, 175 insertions(+), 18 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index 5520b65b3..7092ba5a0 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -57,8 +57,14 @@ let private isLetInsideObjectModel input pos = ) |> Option.isSome -let private getRangeToEdit input pos = - let tryPickContainingRange (path: SyntaxVisitorPath) pos = +let private getRangesAndPlacement input pos = + + let getEditRangeForModule (attributes: SynAttributes) (moduleKeywordRange: FSharp.Compiler.Text.Range) posLine = + match List.tryLast attributes with + | Some a when a.Range.EndLine = posLine -> a.Range.WithStart a.Range.End + | _ -> moduleKeywordRange.WithStart moduleKeywordRange.End + + let tryGetDeclContainingRange (path: SyntaxVisitorPath) pos = path |> Seq.skip 1 |> Seq.tryPick (fun p -> @@ -73,15 +79,16 @@ let private getRangeToEdit input pos = |> List.tryPick (fun d -> match d with | SynModuleDecl.NestedModule( - moduleInfo = SynComponentInfo(longId = longId; accessibility = None); trivia = { ModuleKeyword = Some r }) as m when + moduleInfo = SynComponentInfo(attributes = attributes; longId = longId; accessibility = None) + trivia = { ModuleKeyword = Some r }) as m when longId |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) |> Option.isSome -> - let editRange = r.WithStart r.End + let editRange = getEditRangeForModule attributes r pos.Line let path = (SyntaxNode.SynModule m) :: path - match tryPickContainingRange path pos with + match tryGetDeclContainingRange path pos with | Some r -> Some(editRange, r, After) | _ -> None | SynModuleDecl.NestedModule(moduleInfo = moduleInfo; decls = decls) as m -> @@ -109,7 +116,7 @@ let private getRangeToEdit input pos = let path = SyntaxNode.SynMemberDefn a :: path - match tryPickContainingRange path pos with + match tryGetDeclContainingRange path pos with | Some r -> Some(editRange, r, After) | _ -> None | _ -> None) @@ -137,13 +144,13 @@ let private getRangeToEdit input pos = else let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start - match tryPickContainingRange path pos with + match tryGetDeclContainingRange path pos with | Some r -> Some(editRange, r, Before) | _ -> None | SynPat.Named(accessibility = None; isThisVal = false) -> let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start - match tryPickContainingRange path pos with + match tryGetDeclContainingRange path pos with | Some r -> Some(editRange, r, Before) | _ -> None | _ -> None @@ -153,17 +160,21 @@ let private getRangeToEdit input pos = match synModuleOrNamespace with | SynModuleOrNamespace( longId = longId + attribs = attribs accessibility = None - trivia = { LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Module r }) when + trivia = { LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Module r }) as mOrN when longId |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) |> Option.isSome -> - let editRange = r.WithStart r.End + let editRange = getEditRangeForModule attribs r pos.Line - match tryPickContainingRange path pos with - | Some r -> Some(editRange, r, After) - | _ -> None + if path.Length = 0 then // Top level module + Some(editRange, mOrN.Range, After) + else + match tryGetDeclContainingRange path pos with + | Some r -> Some(editRange, r, After) + | _ -> None | SynModuleOrNamespace(decls = decls) as mOrN -> let path = SyntaxNode.SynModuleOrNamespace mOrN :: path findNested path decls } @@ -179,9 +190,9 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (symbolUseWorkspace: Sy let filePath = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath let fcsPos = protocolPosToPos codeActionParams.Range.Start let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsPos - let editRangeAndDeclRange = getRangeToEdit parseAndCheck.GetAST fcsPos + let rangesAndPlacement = getRangesAndPlacement parseAndCheck.GetAST fcsPos - match editRangeAndDeclRange with + match rangesAndPlacement with | Some(editRange, declRange, placement) -> let! (_, uses) = symbolUseWorkspace false true true fcsPos lineStr sourceText parseAndCheck diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index 522bf504c..075e8c194 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -753,7 +753,7 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix - testCaseAsync "add private is not offered for member when caret is on parameter" + testCaseAsync "add private is not offered for class member when caret is on parameter" <| CodeFix.checkNotApplicable server """ @@ -813,18 +813,164 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix + + testCaseAsync "add private is not offered for member with reference outside its declaring DU" + <| CodeFix.checkNotApplicable + server + """ + type MyDiscUnion = + | Case1 + | Case2 + with + member _.F$0oo x = x + + let x = MyDiscUnion.Case1 + x.Foo 10 + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for member with reference outside its declaring DU when caret is on thisValue" + <| CodeFix.checkNotApplicable + server + """ + type MyDiscUnion = + | Case1 + | Case2 + with + member $0_.Foo x = x + + let x = MyDiscUnion.Case1 + x.Foo 10 + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for DU member when caret is on parameter" + <| CodeFix.checkNotApplicable + server + """ + type MyDiscUnion = + | Case1 + | Case2 + with + member _.Foo $0x = x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private works for DU member" + <| CodeFix.check + server + """ + type MyDiscUnion = + | Case1 + | Case2 + with + member _.Fo$0o x = x + """ + Diagnostics.acceptAll + selectCodeFix + """ + type MyDiscUnion = + | Case1 + | Case2 + with + member private _.Foo x = x + """ + + testCaseAsync "add private is not offered for member with reference outside its declaring Record" + <| CodeFix.checkNotApplicable + server + """ + type MyRecord = + { Field1: int + Field2: string } + with + member _.F$0oo x = x + + let x = { Field1 = 23; Field2 = "bla" } + x.Foo 10 + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for member with reference outside its declaring Record when caret is on thisValue" + <| CodeFix.checkNotApplicable + server + """ + type MyRecord = + { Field1: int + Field2: string } + with + member _$0.Foo x = x + + let x = { Field1 = 23; Field2 = "bla" } + x.Foo 10 + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for Record member when caret is on parameter" + <| CodeFix.checkNotApplicable + server + """ + type MyRecord = + { Field1: int + Field2: string } + with + member _.Foo $0x = x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private works for Record member" + <| CodeFix.check + server + """ + type MyRecord = + { Field1: int + Field2: string } + with + member _.Fo$0o x = x + """ + Diagnostics.acceptAll + selectCodeFix + """ + type MyRecord = + { Field1: int + Field2: string } + with + member private _.Foo x = x + """ + + testCaseAsync "add private works for top level module" + <| CodeFix.check + server + """ + module [] rec M$0 + + module Sub = () + """ + Diagnostics.acceptAll + selectCodeFix + """ + module [] private rec M + + module Sub = () + """ testCaseAsync "add private works for module" <| CodeFix.check server """ - module M$0 = + module [] rec M$0 = () """ Diagnostics.acceptAll selectCodeFix """ - module private M = + module [] private rec M = () """ From 967a0098f19a2b80f10839648d9fb6b14f699c8b Mon Sep 17 00:00:00 2001 From: dawe Date: Sat, 25 Mar 2023 17:45:43 +0100 Subject: [PATCH 10/15] support for type definitions --- .../CodeFixes/AddPrivateAccessModifier.fs | 24 ++++++---- .../CodeFixTests/Tests.fs | 46 +++++++++++++++++++ 2 files changed, 62 insertions(+), 8 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index 7092ba5a0..a461feded 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -64,6 +64,11 @@ let private getRangesAndPlacement input pos = | Some a when a.Range.EndLine = posLine -> a.Range.WithStart a.Range.End | _ -> moduleKeywordRange.WithStart moduleKeywordRange.End + let longIdentContainsPos (longIdent: LongIdent) (pos: FSharp.Compiler.Text.pos) = + longIdent + |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) + |> Option.isSome + let tryGetDeclContainingRange (path: SyntaxVisitorPath) pos = path |> Seq.skip 1 @@ -80,11 +85,7 @@ let private getRangesAndPlacement input pos = match d with | SynModuleDecl.NestedModule( moduleInfo = SynComponentInfo(attributes = attributes; longId = longId; accessibility = None) - trivia = { ModuleKeyword = Some r }) as m when - longId - |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) - |> Option.isSome - -> + trivia = { ModuleKeyword = Some r }) as m when longIdentContainsPos longId pos -> let editRange = getEditRangeForModule attributes r pos.Line let path = (SyntaxNode.SynModule m) :: path @@ -102,6 +103,15 @@ let private getRangesAndPlacement input pos = typeDefns |> List.tryPick (fun td -> match td with + | SynTypeDefn(typeInfo = SynComponentInfo(longId = longId; accessibility = None; range = r)) as t when + longIdentContainsPos longId pos + -> + let editRange = r.WithEnd r.Start + let path = SyntaxNode.SynTypeDefn t :: path + + match tryGetDeclContainingRange path pos with + | Some r -> Some(editRange, r, Before) + | _ -> None | SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _)) as d -> let path = SyntaxNode.SynTypeDefn d :: path @@ -163,9 +173,7 @@ let private getRangesAndPlacement input pos = attribs = attribs accessibility = None trivia = { LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Module r }) as mOrN when - longId - |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) - |> Option.isSome + longIdentContainsPos longId pos -> let editRange = getEditRangeForModule attribs r pos.Line diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index 075e8c194..e815cb55e 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -727,6 +727,20 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix + testCaseAsync "add private works for class type definition" + <| CodeFix.check + server + """ + type [] MyCla$0ss() = + member _.X = 10 + """ + Diagnostics.acceptAll + selectCodeFix + """ + type [] private MyClass() = + member _.X = 10 + """ + testCaseAsync "add private is not offered for member with reference outside its declaring class" <| CodeFix.checkNotApplicable server @@ -814,6 +828,22 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix + testCaseAsync "add private works for DU type definition" + <| CodeFix.check + server + """ + type [] MyDi$0scUnion = + | Case1 + | Case2 + """ + Diagnostics.acceptAll + selectCodeFix + """ + type [] private MyDiscUnion = + | Case1 + | Case2 + """ + testCaseAsync "add private is not offered for member with reference outside its declaring DU" <| CodeFix.checkNotApplicable server @@ -879,6 +909,22 @@ let private addPrivateAccessModifierTests state = member private _.Foo x = x """ + testCaseAsync "add private works for Record definition" + <| CodeFix.check + server + """ + type [] My$0Record = + { Field1: int + Field2: string } + """ + Diagnostics.acceptAll + selectCodeFix + """ + type [] private MyRecord = + { Field1: int + Field2: string } + """ + testCaseAsync "add private is not offered for member with reference outside its declaring Record" <| CodeFix.checkNotApplicable server From 25e92c52a3b05128bde97aef531ef623922ed57b Mon Sep 17 00:00:00 2001 From: dawe Date: Sat, 25 Mar 2023 19:11:36 +0100 Subject: [PATCH 11/15] deal with ref finding shortages --- .../CodeFixes/AddPrivateAccessModifier.fs | 21 ++++---- .../CodeFixTests/Tests.fs | 53 +++++++++++++------ 2 files changed, 48 insertions(+), 26 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index a461feded..e49fa099d 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -103,9 +103,9 @@ let private getRangesAndPlacement input pos = typeDefns |> List.tryPick (fun td -> match td with - | SynTypeDefn(typeInfo = SynComponentInfo(longId = longId; accessibility = None; range = r)) as t when - longIdentContainsPos longId pos - -> + | SynTypeDefn( + typeInfo = SynComponentInfo(longId = longId; accessibility = None; range = r) + typeRepr = SynTypeDefnRepr.ObjectModel _) as t when longIdentContainsPos longId pos -> let editRange = r.WithEnd r.Start let path = SyntaxNode.SynTypeDefn t :: path @@ -137,19 +137,18 @@ let private getRangesAndPlacement input pos = { new SyntaxVisitorBase<_>() with member _.VisitBinding(path, _, synBinding) = match synBinding with + | SynBinding(valData = SynValData(memberFlags = Some({ MemberKind = SynMemberKind.Constructor }))) -> None | SynBinding(headPat = headPat; kind = SynBindingKind.Normal) as s when rangeContainsPos s.RangeOfHeadPattern pos -> match headPat with - | SynPat.LongIdent(longDotId = longDotId; accessibility = None; argPats = synArgPats) -> - let posInArgs = - synArgPats.Patterns |> List.exists (fun p -> rangeContainsPos p.Range pos) - - let posInFirstIdent = - longDotId.LongIdent.Length > 1 - && rangeContainsPos longDotId.LongIdent[0].idRange pos + | SynPat.LongIdent(longDotId = longDotId; accessibility = None) -> + let posValidInSynLongIdent = + longDotId.LongIdent + |> List.skip (if longDotId.LongIdent.Length > 1 then 1 else 0) + |> List.exists (fun i -> rangeContainsPos i.idRange pos) - if posInArgs || posInFirstIdent then + if not posValidInSynLongIdent then None else let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index e815cb55e..c5dc4f0b8 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -740,6 +740,29 @@ let private addPrivateAccessModifierTests state = type [] private MyClass() = member _.X = 10 """ + + testCaseAsync "add private is not offered for class type definition with reference" + <| CodeFix.checkNotApplicable + server + """ + type MyCla$0ss() = + member _.X = 10 + + let _ = MyClass() + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for explicit ctor" // ref finding might not show us usages + <| CodeFix.checkNotApplicable + server + """ + type MyC(x: int) = + ne$0w() = + MyC(23) + """ + Diagnostics.acceptAll + selectCodeFix testCaseAsync "add private is not offered for member with reference outside its declaring class" <| CodeFix.checkNotApplicable @@ -767,6 +790,16 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix + testCaseAsync "add private is not offered for member when caret is in SynTypArDecl" + <| CodeFix.checkNotApplicable + server + """ + type MyC() = + member _.X<'T$0> a = a + """ + Diagnostics.acceptAll + selectCodeFix + testCaseAsync "add private is not offered for class member when caret is on parameter" <| CodeFix.checkNotApplicable server @@ -828,8 +861,8 @@ let private addPrivateAccessModifierTests state = Diagnostics.acceptAll selectCodeFix - testCaseAsync "add private works for DU type definition" - <| CodeFix.check + testCaseAsync "add private is not offered for DU type definition" // ref finding might not show us type inferred usages + <| CodeFix.checkNotApplicable server """ type [] MyDi$0scUnion = @@ -838,12 +871,7 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix - """ - type [] private MyDiscUnion = - | Case1 - | Case2 - """ - + testCaseAsync "add private is not offered for member with reference outside its declaring DU" <| CodeFix.checkNotApplicable server @@ -909,8 +937,8 @@ let private addPrivateAccessModifierTests state = member private _.Foo x = x """ - testCaseAsync "add private works for Record definition" - <| CodeFix.check + testCaseAsync "add private is not offered for Record type definition" // ref finding might not show us type inferred usages + <| CodeFix.checkNotApplicable server """ type [] My$0Record = @@ -919,11 +947,6 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix - """ - type [] private MyRecord = - { Field1: int - Field2: string } - """ testCaseAsync "add private is not offered for member with reference outside its declaring Record" <| CodeFix.checkNotApplicable From fde67bd9056330ebf248a30096304dd8c02f6af2 Mon Sep 17 00:00:00 2001 From: dawe Date: Sat, 25 Mar 2023 21:44:46 +0100 Subject: [PATCH 12/15] support type abbreviations --- .../CodeFixes/AddPrivateAccessModifier.fs | 29 ++++++++++++++++--- .../CodeFixTests/Tests.fs | 26 ++++++++++++++++- 2 files changed, 50 insertions(+), 5 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index e49fa099d..8b43b0868 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -70,12 +70,17 @@ let private getRangesAndPlacement input pos = |> Option.isSome let tryGetDeclContainingRange (path: SyntaxVisitorPath) pos = + let skip = + match path with + | SyntaxNode.SynTypeDefn(SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel _)) :: _ -> 0 // keep containing range of ctor decl to class range + | _ -> 1 + path - |> Seq.skip 1 + |> Seq.skip skip |> Seq.tryPick (fun p -> match p with | SyntaxNode.SynTypeDefn m when rangeContainsPos m.Range pos -> Some m.Range - | SyntaxNode.SynModule m when rangeContainsPos m.Range pos -> Some m.Range + | SyntaxNode.SynModule(SynModuleDecl.NestedModule(range = r)) when rangeContainsPos r pos -> Some r | SyntaxNode.SynModuleOrNamespace m when rangeContainsPos m.Range pos -> Some m.Range | _ -> None) @@ -83,6 +88,7 @@ let private getRangesAndPlacement input pos = decls |> List.tryPick (fun d -> match d with + // Nested Module | SynModuleDecl.NestedModule( moduleInfo = SynComponentInfo(attributes = attributes; longId = longId; accessibility = None) trivia = { ModuleKeyword = Some r }) as m when longIdentContainsPos longId pos -> @@ -103,6 +109,7 @@ let private getRangesAndPlacement input pos = typeDefns |> List.tryPick (fun td -> match td with + // Class Type | SynTypeDefn( typeInfo = SynComponentInfo(longId = longId; accessibility = None; range = r) typeRepr = SynTypeDefnRepr.ObjectModel _) as t when longIdentContainsPos longId pos -> @@ -112,8 +119,9 @@ let private getRangesAndPlacement input pos = match tryGetDeclContainingRange path pos with | Some r -> Some(editRange, r, Before) | _ -> None - | SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _)) as d -> - let path = SyntaxNode.SynTypeDefn d :: path + // AutoProperty + | SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _)) as t -> + let path = SyntaxNode.SynTypeDefn t :: path members |> List.tryPick (fun m -> @@ -130,6 +138,18 @@ let private getRangesAndPlacement input pos = | Some r -> Some(editRange, r, After) | _ -> None | _ -> None) + // Type Abbreviation + | SynTypeDefn( + typeInfo = SynComponentInfo(accessibility = None; range = r) + typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.TypeAbbrev _)) as t when + rangeContainsPos r pos + -> + let editRange = r.WithEnd r.Start + let path = SyntaxNode.SynTypeDefn t :: path + + match tryGetDeclContainingRange path pos with + | Some r -> Some(editRange, r, Before) + | _ -> None | _ -> None) | _ -> None) @@ -137,6 +157,7 @@ let private getRangesAndPlacement input pos = { new SyntaxVisitorBase<_>() with member _.VisitBinding(path, _, synBinding) = match synBinding with + // explicit Ctor | SynBinding(valData = SynValData(memberFlags = Some({ MemberKind = SynMemberKind.Constructor }))) -> None | SynBinding(headPat = headPat; kind = SynBindingKind.Normal) as s when rangeContainsPos s.RangeOfHeadPattern pos diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index c5dc4f0b8..3622c77c7 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -936,7 +936,7 @@ let private addPrivateAccessModifierTests state = with member private _.Foo x = x """ - + testCaseAsync "add private is not offered for Record type definition" // ref finding might not show us type inferred usages <| CodeFix.checkNotApplicable server @@ -1055,6 +1055,30 @@ let private addPrivateAccessModifierTests state = """ Diagnostics.acceptAll selectCodeFix + + testCaseAsync "add private works for type abbreviation" + <| CodeFix.check + server + """ + type My$0Int = int + """ + Diagnostics.acceptAll + selectCodeFix + """ + type private MyInt = int + """ + + testCaseAsync "add private is not offered for type abbreviation with reference outside its declaring module" + <| CodeFix.checkNotApplicable + server + """ + module M = + type My$0Int = int + + let x: M.MyInt = 23 + """ + Diagnostics.acceptAll + selectCodeFix ]) let private convertTripleSlashCommentToXmlTaggedDocTests state = From 2a2c77199decfd6606f0571e71988007cf135b7f Mon Sep 17 00:00:00 2001 From: dawe Date: Sat, 25 Mar 2023 22:11:13 +0100 Subject: [PATCH 13/15] simplify check for let in object model --- .../CodeFixes/AddPrivateAccessModifier.fs | 83 +++++++------------ 1 file changed, 32 insertions(+), 51 deletions(-) diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs index 8b43b0868..0e4d47850 100644 --- a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -26,37 +26,6 @@ type private Placement = | Before | After -let private isLetInsideObjectModel input pos = - SyntaxTraversal.Traverse( - pos, - input, - { new SyntaxVisitorBase<_>() with - member _.VisitModuleOrNamespace(_, synModuleOrNamespace) = - - let rec tryFind (decls: SynModuleDecl list) = - decls - |> List.tryPick (fun d -> - match d with - | SynModuleDecl.Let(range = range) when rangeContainsPos range pos -> None - | 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.LetBindings(range = range) when rangeContainsPos range pos -> Some() - | _ -> None) - | _ -> None) - | SynModuleDecl.NestedModule(decls = nestedDecls) as m -> tryFind nestedDecls - | _ -> None) - - match synModuleOrNamespace with - | SynModuleOrNamespace(decls = decls) as s -> tryFind decls } - ) - |> Option.isSome - let private getRangesAndPlacement input pos = let getEditRangeForModule (attributes: SynAttributes) (moduleKeywordRange: FSharp.Compiler.Text.Range) posLine = @@ -69,6 +38,17 @@ let private getRangesAndPlacement input pos = |> List.tryFind (fun i -> rangeContainsPos i.idRange pos) |> Option.isSome + let isLetInsideObjectModel (path: SyntaxVisitorPath) pos = + path + |> List.exists (function + | SyntaxNode.SynTypeDefn(SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _))) -> + members + |> List.exists (fun m -> + match m with + | SynMemberDefn.LetBindings(range = range) when rangeContainsPos range pos -> true + | _ -> false) + | _ -> false) + let tryGetDeclContainingRange (path: SyntaxVisitorPath) pos = let skip = match path with @@ -159,31 +139,35 @@ let private getRangesAndPlacement input pos = match synBinding with // explicit Ctor | SynBinding(valData = SynValData(memberFlags = Some({ MemberKind = SynMemberKind.Constructor }))) -> None + // let bindings, members | SynBinding(headPat = headPat; kind = SynBindingKind.Normal) as s when rangeContainsPos s.RangeOfHeadPattern pos -> - match headPat with - | SynPat.LongIdent(longDotId = longDotId; accessibility = None) -> - let posValidInSynLongIdent = - longDotId.LongIdent - |> List.skip (if longDotId.LongIdent.Length > 1 then 1 else 0) - |> List.exists (fun i -> rangeContainsPos i.idRange pos) - - if not posValidInSynLongIdent then - None - else + if isLetInsideObjectModel path pos then + None + else + match headPat with + | SynPat.LongIdent(longDotId = longDotId; accessibility = None) -> + let posValidInSynLongIdent = + longDotId.LongIdent + |> List.skip (if longDotId.LongIdent.Length > 1 then 1 else 0) + |> List.exists (fun i -> rangeContainsPos i.idRange pos) + + if not posValidInSynLongIdent then + None + else + let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start + + match tryGetDeclContainingRange path pos with + | Some r -> Some(editRange, r, Before) + | _ -> None + | SynPat.Named(accessibility = None; isThisVal = false) -> let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start match tryGetDeclContainingRange path pos with | Some r -> Some(editRange, r, Before) | _ -> None - | SynPat.Named(accessibility = None; isThisVal = false) -> - let editRange = s.RangeOfHeadPattern.WithEnd s.RangeOfHeadPattern.Start - - match tryGetDeclContainingRange path pos with - | Some r -> Some(editRange, r, Before) | _ -> None - | _ -> None | _ -> None member _.VisitModuleOrNamespace(path, synModuleOrNamespace) = @@ -207,10 +191,7 @@ let private getRangesAndPlacement input pos = let path = SyntaxNode.SynModuleOrNamespace mOrN :: path findNested path decls } - if isLetInsideObjectModel input pos then - None - else - SyntaxTraversal.Traverse(pos, input, visitor) + SyntaxTraversal.Traverse(pos, input, visitor) let fix (getParseResultsForFile: GetParseResultsForFile) (symbolUseWorkspace: SymbolUseWorkspace) : CodeFix = fun codeActionParams -> From 83e2695137157fde72a7de90f689608be2de8d9a Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 31 Mar 2023 00:17:22 +0200 Subject: [PATCH 14/15] add AddPrivateAccessModifier to config --- src/FsAutoComplete/LspHelpers.fs | 5 +++++ src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs | 2 +- src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs | 2 +- test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs | 3 ++- test/FsAutoComplete.Tests.Lsp/Helpers.fs | 1 + 5 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/FsAutoComplete/LspHelpers.fs b/src/FsAutoComplete/LspHelpers.fs index 6b10fc1fc..8367619af 100644 --- a/src/FsAutoComplete/LspHelpers.fs +++ b/src/FsAutoComplete/LspHelpers.fs @@ -638,6 +638,7 @@ type FSharpConfigDto = InterfaceStubGeneration: bool option InterfaceStubGenerationObjectIdentifier: string option InterfaceStubGenerationMethodBody: string option + AddPrivateAccessModifier: bool option UnusedOpensAnalyzer: bool option UnusedDeclarationsAnalyzer: bool option SimplifyNameAnalyzer: bool option @@ -756,6 +757,7 @@ type FSharpConfig = InterfaceStubGeneration: bool InterfaceStubGenerationObjectIdentifier: string InterfaceStubGenerationMethodBody: string + AddPrivateAccessModifier: bool UnusedOpensAnalyzer: bool UnusedDeclarationsAnalyzer: bool SimplifyNameAnalyzer: bool @@ -797,6 +799,7 @@ type FSharpConfig = InterfaceStubGeneration = false InterfaceStubGenerationObjectIdentifier = "this" InterfaceStubGenerationMethodBody = "failwith \"Not Implemented\"" + AddPrivateAccessModifier = false UnusedOpensAnalyzer = false UnusedDeclarationsAnalyzer = false SimplifyNameAnalyzer = false @@ -836,6 +839,7 @@ type FSharpConfig = InterfaceStubGenerationObjectIdentifier = defaultArg dto.InterfaceStubGenerationObjectIdentifier "this" InterfaceStubGenerationMethodBody = defaultArg dto.InterfaceStubGenerationMethodBody "failwith \"Not Implemented\"" + AddPrivateAccessModifier = defaultArg dto.AddPrivateAccessModifier false UnusedOpensAnalyzer = defaultArg dto.UnusedOpensAnalyzer false UnusedDeclarationsAnalyzer = defaultArg dto.UnusedDeclarationsAnalyzer false SimplifyNameAnalyzer = defaultArg dto.SimplifyNameAnalyzer false @@ -926,6 +930,7 @@ type FSharpConfig = defaultArg dto.InterfaceStubGenerationObjectIdentifier x.InterfaceStubGenerationObjectIdentifier InterfaceStubGenerationMethodBody = defaultArg dto.InterfaceStubGenerationMethodBody x.InterfaceStubGenerationMethodBody + AddPrivateAccessModifier = defaultArg dto.AddPrivateAccessModifier x.AddPrivateAccessModifier UnusedOpensAnalyzer = defaultArg dto.UnusedOpensAnalyzer x.UnusedOpensAnalyzer UnusedDeclarationsAnalyzer = defaultArg dto.UnusedDeclarationsAnalyzer x.UnusedDeclarationsAnalyzer SimplifyNameAnalyzer = defaultArg dto.SimplifyNameAnalyzer x.SimplifyNameAnalyzer diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index c66911323..cff11d01e 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1599,7 +1599,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText - AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace + Run.ifEnabled (fun _ -> config.AddPrivateAccessModifier) (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace) UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]) diff --git a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs index fa36e7cee..a73e222ff 100644 --- a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs @@ -1210,7 +1210,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) = AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText - AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace + Run.ifEnabled (fun _ -> config.AddPrivateAccessModifier) (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace) 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 3622c77c7..5cd324cad 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -644,7 +644,8 @@ let private convertPositionalDUToNamedTests state = ]) let private addPrivateAccessModifierTests state = - serverTestList (nameof AddPrivateAccessModifier) state defaultConfigDto None (fun server -> + let config = { defaultConfigDto with AddPrivateAccessModifier = Some true } + serverTestList (nameof AddPrivateAccessModifier) state config None (fun server -> [ let selectCodeFix = CodeFix.withTitle AddPrivateAccessModifier.title testCaseAsync "add private works for simple function" diff --git a/test/FsAutoComplete.Tests.Lsp/Helpers.fs b/test/FsAutoComplete.Tests.Lsp/Helpers.fs index 99f1d265d..2ad51f8bd 100644 --- a/test/FsAutoComplete.Tests.Lsp/Helpers.fs +++ b/test/FsAutoComplete.Tests.Lsp/Helpers.fs @@ -234,6 +234,7 @@ let defaultConfigDto: FSharpConfigDto = UnionCaseStubGenerationBody = None RecordStubGeneration = None RecordStubGenerationBody = None + AddPrivateAccessModifier = None UnusedOpensAnalyzer = None UnusedDeclarationsAnalyzer = None SimplifyNameAnalyzer = None From 3b2273a1d7135e6db84dba169a07b7dede453362 Mon Sep 17 00:00:00 2001 From: dawe Date: Fri, 31 Mar 2023 00:26:09 +0200 Subject: [PATCH 15/15] format --- src/FsAutoComplete/LspHelpers.fs | 2 +- src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs | 4 +++- src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs | 4 +++- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/FsAutoComplete/LspHelpers.fs b/src/FsAutoComplete/LspHelpers.fs index 8367619af..824dae84e 100644 --- a/src/FsAutoComplete/LspHelpers.fs +++ b/src/FsAutoComplete/LspHelpers.fs @@ -839,7 +839,7 @@ type FSharpConfig = InterfaceStubGenerationObjectIdentifier = defaultArg dto.InterfaceStubGenerationObjectIdentifier "this" InterfaceStubGenerationMethodBody = defaultArg dto.InterfaceStubGenerationMethodBody "failwith \"Not Implemented\"" - AddPrivateAccessModifier = defaultArg dto.AddPrivateAccessModifier false + AddPrivateAccessModifier = defaultArg dto.AddPrivateAccessModifier false UnusedOpensAnalyzer = defaultArg dto.UnusedOpensAnalyzer false UnusedDeclarationsAnalyzer = defaultArg dto.UnusedDeclarationsAnalyzer false SimplifyNameAnalyzer = defaultArg dto.SimplifyNameAnalyzer false diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index cff11d01e..7ca88b328 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1599,7 +1599,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText - Run.ifEnabled (fun _ -> config.AddPrivateAccessModifier) (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace) + Run.ifEnabled + (fun _ -> config.AddPrivateAccessModifier) + (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace) UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]) diff --git a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs index a73e222ff..cda183565 100644 --- a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs @@ -1210,7 +1210,9 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) = AddExplicitTypeAnnotation.fix tryGetParseResultsForFile ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText - Run.ifEnabled (fun _ -> config.AddPrivateAccessModifier) (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace) + Run.ifEnabled + (fun _ -> config.AddPrivateAccessModifier) + (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace) UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]