diff --git a/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs new file mode 100644 index 000000000..0e4d47850 --- /dev/null +++ b/src/FsAutoComplete/CodeFixes/AddPrivateAccessModifier.fs @@ -0,0 +1,235 @@ +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.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 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 longIdentContainsPos (longIdent: LongIdent) (pos: FSharp.Compiler.Text.pos) = + longIdent + |> 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 + | SyntaxNode.SynTypeDefn(SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel _)) :: _ -> 0 // keep containing range of ctor decl to class range + | _ -> 1 + + path + |> Seq.skip skip + |> Seq.tryPick (fun p -> + match p with + | SyntaxNode.SynTypeDefn 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) + + let rec findNested path decls = + 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 -> + let editRange = getEditRangeForModule attributes r pos.Line + let path = (SyntaxNode.SynModule m) :: path + + match tryGetDeclContainingRange 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 + // Class Type + | 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 + + match tryGetDeclContainingRange path pos with + | Some r -> Some(editRange, r, Before) + | _ -> None + // AutoProperty + | SynTypeDefn(typeRepr = SynTypeDefnRepr.ObjectModel(_, members, _)) as t -> + let path = SyntaxNode.SynTypeDefn t :: 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 tryGetDeclContainingRange path pos with + | 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) + + let visitor = + { new SyntaxVisitorBase<_>() with + member _.VisitBinding(path, _, synBinding) = + 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 + -> + 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 + | _ -> None + | _ -> None + + member _.VisitModuleOrNamespace(path, synModuleOrNamespace) = + match synModuleOrNamespace with + | SynModuleOrNamespace( + longId = longId + attribs = attribs + accessibility = None + trivia = { LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Module r }) as mOrN when + longIdentContainsPos longId pos + -> + let editRange = getEditRangeForModule attribs r pos.Line + + 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 } + + SyntaxTraversal.Traverse(pos, input, visitor) + +let fix (getParseResultsForFile: GetParseResultsForFile) (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 rangesAndPlacement = getRangesAndPlacement parseAndCheck.GetAST fcsPos + + match rangesAndPlacement with + | Some(editRange, declRange, placement) -> + + let! (_, uses) = symbolUseWorkspace false true true fcsPos lineStr sourceText parseAndCheck + let useRanges = uses.Values |> Array.concat + + let usedOutsideOfDecl = + useRanges + |> Array.exists (fun usingRange -> + 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 editRange + NewText = text } + + return + [ { Edits = [| e |] + File = codeActionParams.TextDocument + Title = title + SourceDiagnostic = None + Kind = FixKind.Refactor } ] + | _ -> return [] + } diff --git a/src/FsAutoComplete/LspHelpers.fs b/src/FsAutoComplete/LspHelpers.fs index 6b10fc1fc..824dae84e 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 3de5c9de5..7ca88b328 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -1386,6 +1386,101 @@ 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 @@ -1504,6 +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) UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText RenameParamToMatchSignature.fix tryGetParseResultsForFile |]) @@ -1590,37 +1688,6 @@ 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 { @@ -1694,67 +1761,8 @@ 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/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs index 072d46636..cda183565 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,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) 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 b540170bb..5cd324cad 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -643,6 +643,445 @@ let private convertPositionalDUToNamedTests state = """ ]) +let private addPrivateAccessModifierTests state = + 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" + <| CodeFix.check + server + """ + let f$0 x = x * x + """ + Diagnostics.acceptAll + selectCodeFix + """ + let private f x = x * x + """ + + testCaseAsync "add private works for simple identifier" + <| CodeFix.check + server + """ + let x$0 = 23 + """ + Diagnostics.acceptAll + selectCodeFix + """ + let private x = 23 + """ + + testCaseAsync "add private 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 "add private is not offered for already private functions" + <| CodeFix.checkNotApplicable + server + """ + let private f$0 x = x * x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private is not offered for function with reference outside its declaring module" + <| CodeFix.checkNotApplicable + server + """ + module MyModule = + + let helper x = x + 10 + + let $0f x = helper x + + MyModule.f 10 + """ + 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 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 + server + """ + type MyClass() = + member _.$0X = 10 + + let myInst = MyClass() + myInst.X |> ignore + """ + 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 + + let myInst = MyClass() + myInst.X |> ignore + """ + 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 + """ + 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 + """ + type MyClass() = + let $0f x = x * x + """ + Diagnostics.acceptAll + selectCodeFix + + testCaseAsync "add private works for class member" + <| CodeFix.check + server + """ + type MyClass() = + member _.$0X = 10 + """ + Diagnostics.acceptAll + selectCodeFix + """ + 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 is not offered for DU type definition" // ref finding might not show us type inferred usages + <| CodeFix.checkNotApplicable + server + """ + type [] MyDi$0scUnion = + | Case1 + | Case2 + """ + 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 Record type definition" // ref finding might not show us type inferred usages + <| CodeFix.checkNotApplicable + server + """ + type [] My$0Record = + { Field1: int + Field2: string } + """ + Diagnostics.acceptAll + selectCodeFix + + 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 [] rec M$0 = + () + """ + Diagnostics.acceptAll + selectCodeFix + """ + module [] private rec 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 + + 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 = serverTestList (nameof ConvertTripleSlashCommentToXmlTaggedDoc) state defaultConfigDto None (fun server -> [ let selectCodeFix = CodeFix.withTitle ConvertTripleSlashCommentToXmlTaggedDoc.title @@ -2008,6 +2447,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/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