diff --git a/.gitattributes b/.gitattributes index f3cb1d33f..1a5505de5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -21,3 +21,7 @@ *.sh text eol=lf Makefile.orig text eol=lf configure.sh text eol=lf + +*.fs text eol=lf +*.fsi text eol=lf +*.fsx text eol=lf diff --git a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs index f9858c587..3f6e41b1d 100644 --- a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs +++ b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs @@ -11,6 +11,7 @@ open FSharp.Compiler.Symbols open FsAutoComplete.FCSPatches open FSharp.Compiler.Syntax +let title = "Add explicit type annotation" let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix = fun codeActionParams -> asyncResult { @@ -44,7 +45,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix = match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as v when isValidParameterWithoutTypeAnnotation v symbolUse -> let typeString = v.FullType.Format symbolUse.DisplayContext - let title = "Add explicit type annotation" + let title = title let fcsSymbolRange = symbolUse.Range let protocolSymbolRange = fcsRangeToLsp fcsSymbolRange let! symbolText = sourceText.GetText fcsSymbolRange diff --git a/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs b/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs index 9a80970dd..ed6b05018 100644 --- a/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs +++ b/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs @@ -7,6 +7,7 @@ open Ionide.LanguageServerProtocol.Types open FsAutoComplete open FsAutoComplete.LspHelpers +let title = "Add missing 'fun' keyword" /// a codefix that adds a missing 'fun' keyword to a lambda let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix = Run.ifDiagnosticByCode @@ -51,7 +52,7 @@ let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix = let symbolStartRange = fcsPosToProtocolRange fcsStartPos return - [ { Title = "Add missing 'fun' keyword" + [ { Title = title File = codeActionParams.TextDocument SourceDiagnostic = Some diagnostic Edits = diff --git a/src/FsAutoComplete/CodeFixes/AddMissingInstanceMember.fs b/src/FsAutoComplete/CodeFixes/AddMissingInstanceMember.fs index 460e5eaff..49bcb2e7d 100644 --- a/src/FsAutoComplete/CodeFixes/AddMissingInstanceMember.fs +++ b/src/FsAutoComplete/CodeFixes/AddMissingInstanceMember.fs @@ -4,10 +4,11 @@ open FsToolkit.ErrorHandling open FsAutoComplete.CodeFix.Types open Ionide.LanguageServerProtocol.Types +let title = "Add missing instance member parameter" let fix = Run.ifDiagnosticByCode (Set.ofList [ "673" ]) (fun diagnostic codeActionParams -> asyncResult { return [{ - Title = "Add missing instance member parameter" + Title = title File = codeActionParams.TextDocument Kind = FixKind.Fix SourceDiagnostic = Some diagnostic diff --git a/src/FsAutoComplete/CodeFixes/ChangeTypeOfNameToNameOf.fs b/src/FsAutoComplete/CodeFixes/ChangeTypeOfNameToNameOf.fs index 0ab49495f..65ea18727 100644 --- a/src/FsAutoComplete/CodeFixes/ChangeTypeOfNameToNameOf.fs +++ b/src/FsAutoComplete/CodeFixes/ChangeTypeOfNameToNameOf.fs @@ -28,6 +28,7 @@ type FSharpParseFileResults with | _ -> defaultTraverse expr | _ -> defaultTraverse expr }) +let title = "Use 'nameof'" let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix = fun codeActionParams -> asyncResult { @@ -42,7 +43,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix = return [{ Edits = [| { Range = fcsRangeToLsp results.FullExpressionRange; NewText = replacement } |] File = codeActionParams.TextDocument - Title = "Use 'nameof'" + Title = title SourceDiagnostic = None Kind = FixKind.Refactor }] } diff --git a/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs b/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs index 23af9cceb..a7111aac3 100644 --- a/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs +++ b/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs @@ -111,6 +111,7 @@ let private toPosSeq (range: FSharp.Compiler.Text.Range, text: NamedText) = if FSharp.Compiler.Text.Range.rangeContainsPos range nextPos then Some (currentPos, nextPos) else None ) +let title = "Convert to named patterns" let fix (getParseResultsForFile: GetParseResultsForFile) (getRangeText: GetRangeText) : CodeFix = fun codeActionParams -> asyncResult { @@ -192,7 +193,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getRangeText: GetRange return [ { Edits = allEdits File = codeActionParams.TextDocument - Title = "Convert to named patterns" + Title = title SourceDiagnostic = None Kind = FixKind.Refactor } ] } diff --git a/src/FsAutoComplete/CodeFixes/GenerateAbstractClassStub.fs b/src/FsAutoComplete/CodeFixes/GenerateAbstractClassStub.fs index d8ae983c0..f3ff5d07f 100644 --- a/src/FsAutoComplete/CodeFixes/GenerateAbstractClassStub.fs +++ b/src/FsAutoComplete/CodeFixes/GenerateAbstractClassStub.fs @@ -8,6 +8,7 @@ open FsAutoComplete open FsAutoComplete.LspHelpers open FSharp.UMX +let title = "Generate abstract class members" /// a codefix that generates stubs for required override members in abstract types let fix (getParseResultsForFile: GetParseResultsForFile) (genAbstractClassStub: _ -> _ -> _ -> _ -> Async>) @@ -46,7 +47,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) return [ { SourceDiagnostic = Some diagnostic - Title = "Generate abstract class members" + Title = title File = codeActionParams.TextDocument Edits = [| { Range = fcsPosToProtocolRange position diff --git a/src/FsAutoComplete/CodeFixes/GenerateRecordStub.fs b/src/FsAutoComplete/CodeFixes/GenerateRecordStub.fs index e79b7c4a2..318b8d2ae 100644 --- a/src/FsAutoComplete/CodeFixes/GenerateRecordStub.fs +++ b/src/FsAutoComplete/CodeFixes/GenerateRecordStub.fs @@ -6,6 +6,7 @@ open Ionide.LanguageServerProtocol.Types open FsAutoComplete open FsAutoComplete.LspHelpers +let title = "Generate record stub" /// a codefix that generates member stubs for a record declaration let fix (getParseResultsForFile: GetParseResultsForFile) (genRecordStub: _ -> _ -> _ -> _ -> Async>) @@ -31,7 +32,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) return [ { SourceDiagnostic = None - Title = "Generate record stub" + Title = title File = codeActionParams.TextDocument Edits = [| { Range = fcsPosToProtocolRange position diff --git a/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs b/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs index a8e135eb8..11c505234 100644 --- a/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs +++ b/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs @@ -8,6 +8,7 @@ open FsAutoComplete open FsAutoComplete.LspHelpers open FsAutoComplete.CodeFix.Navigation +let title = "Generate union pattern match cases" /// a codefix that generates union cases for an incomplete match expression let fix (getFileLines: GetFileLines) (getParseResultsForFile: GetParseResultsForFile) @@ -46,7 +47,7 @@ let fix (getFileLines: GetFileLines) return [ { SourceDiagnostic = Some diagnostic File = codeActionParams.TextDocument - Title = "Generate union pattern match cases" + Title = title Edits = [| { Range = range; NewText = replaced } |] Kind = FixKind.Fix } ] diff --git a/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs b/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs index 7a837e4dc..93d1e110a 100644 --- a/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs +++ b/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs @@ -7,6 +7,7 @@ open Ionide.LanguageServerProtocol.Types open FsAutoComplete open FsAutoComplete.LspHelpers +let title = "Make outer binding recursive" let fix (getParseResultsForFile: GetParseResultsForFile) (getLineText: GetLineText) : CodeFix = Run.ifDiagnosticByCode (Set.ofList [ "39" ]) @@ -31,7 +32,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getLineText: GetLineTe "member names didn't match, don't suggest fix" return - [ { Title = "Make outer binding recursive" + [ { Title = title File = codeActionParams.TextDocument SourceDiagnostic = Some diagnostic Kind = FixKind.Fix diff --git a/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs b/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs index 13602d295..b3dea2537 100644 --- a/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs +++ b/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs @@ -7,6 +7,7 @@ open Ionide.LanguageServerProtocol.Types open FsAutoComplete open FsAutoComplete.LspHelpers +let title = "Use subtraction instead of negation" /// a codefix that corrects - to - when negation is not intended let fix (getFileLines: GetFileLines) : CodeFix = Run.ifDiagnosticByCode (Set.ofList [ "3" ]) (fun diagnostic codeActionParams -> @@ -22,7 +23,7 @@ let fix (getFileLines: GetFileLines) : CodeFix = let! oneBack = dec lines dash |> Result.ofOption (fun _ -> "No one back") return [ { SourceDiagnostic = Some diagnostic - Title = "Use subtraction instead of negation" + Title = title File = codeActionParams.TextDocument Edits = [| { Range = { Start = oneBack; End = dash } diff --git a/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs b/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs index baea14fc9..d96b618ef 100644 --- a/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs +++ b/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs @@ -63,6 +63,8 @@ type FSharpParseFileResults with | Some range -> Some range | _ -> defaultTraverse binding }) +let titleParameter = "Remove unused parameter" +let titleBinding = "Remove unused binding" let fix (getParseResults: GetParseResultsForFile): CodeFix = Run.ifDiagnosticByCode (Set.ofList ["1182"]) @@ -82,7 +84,7 @@ let fix (getParseResults: GetParseResultsForFile): CodeFix = |> Result.ofOption (fun _ -> "failed to walk") // replace from there to the end of the pattern's range let replacementRange = { Start = endOfPrecedingToken; End = protocolRange.End } - return [ { Title = "Remove unused parameter" + return [ { Title = titleParameter Edits = [| { Range = replacementRange; NewText = "" } |] File = codeActionParams.TextDocument SourceDiagnostic = Some diagnostic @@ -98,7 +100,7 @@ let fix (getParseResults: GetParseResultsForFile): CodeFix = // walk back to the start of the keyword, which is always `let` or `use` let! keywordStartColumn = decMany lines endOfPrecedingKeyword 3 |> Result.ofOption (fun _ -> "failed to walk") let replacementRange = { Start = keywordStartColumn; End = protocolRange.End } - return [ { Title = "Remove unused binding" + return [ { Title = titleBinding Edits = [| { Range = replacementRange; NewText = "" } |] File = codeActionParams.TextDocument SourceDiagnostic = Some diagnostic diff --git a/src/FsAutoComplete/CodeFixes/UnusedValue.fs b/src/FsAutoComplete/CodeFixes/UnusedValue.fs index 976465b91..a5d93df70 100644 --- a/src/FsAutoComplete/CodeFixes/UnusedValue.fs +++ b/src/FsAutoComplete/CodeFixes/UnusedValue.fs @@ -6,6 +6,8 @@ open FsAutoComplete.CodeFix.Types open FsAutoComplete open FsAutoComplete.LspHelpers +let titleReplace = "Replace with _" +let titlePrefix = "Prefix with _" /// a codefix that suggests prepending a _ to unused values let fix (getRangeText: GetRangeText) = Run.ifDiagnosticByMessage @@ -19,7 +21,7 @@ let fix (getRangeText: GetRangeText) = return [ { SourceDiagnostic = Some diagnostic File = codeActionParams.TextDocument - Title = "Replace with _" + Title = titleReplace Edits = [| { Range = diagnostic.Range NewText = "_" } |] @@ -31,14 +33,14 @@ let fix (getRangeText: GetRangeText) = return [ { SourceDiagnostic = Some diagnostic File = codeActionParams.TextDocument - Title = "Replace with _" + Title = titleReplace Edits = [| { Range = diagnostic.Range NewText = replaceSuggestion } |] Kind = FixKind.Refactor } { SourceDiagnostic = Some diagnostic File = codeActionParams.TextDocument - Title = "Prefix with _" + Title = titlePrefix Edits = [| { Range = diagnostic.Range NewText = prefixSuggestion } |] diff --git a/src/FsAutoComplete/CodeFixes/UseTripleQuotedInterpolation.fs b/src/FsAutoComplete/CodeFixes/UseTripleQuotedInterpolation.fs index de7d344a9..ac8d709ac 100644 --- a/src/FsAutoComplete/CodeFixes/UseTripleQuotedInterpolation.fs +++ b/src/FsAutoComplete/CodeFixes/UseTripleQuotedInterpolation.fs @@ -7,6 +7,7 @@ open FsAutoComplete open FsAutoComplete.LspHelpers open FsAutoComplete.FCSPatches +let title = "Use triple-quoted string interpolation" /// a codefix that replaces erroring single-quoted interpolations with triple-quoted interpolations let fix (getParseResultsForFile: GetParseResultsForFile) (getRangeText: GetRangeText) : CodeFix = Run.ifDiagnosticByCode (Set.ofList [ "3373" ]) (fun diagnostic codeActionParams -> @@ -28,7 +29,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getRangeText: GetRange return [ { File = codeActionParams.TextDocument SourceDiagnostic = Some diagnostic - Title = "Use triple-quoted string interpolation" + Title = title Edits = [| { Range = fcsRangeToLsp range NewText = newText } |] diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs index ebe3605e9..61037caa4 100644 --- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs @@ -127,6 +127,10 @@ type FSharpLspClient(sendServerNotification: ClientNotificationSender, sendServe sendServerNotification "fsharp/fileParsed" (box p) |> Async.Ignore + member __.NotifyDocumentAnalyzed(p: DocumentAnalyzedNotification) = + sendServerNotification "fsharp/documentAnalyzed" (box p) + |> Async.Ignore + member __.NotifyTestDetected (p: TestDetectedNotification) = sendServerNotification "fsharp/testDetected" (box p) |> Async.Ignore @@ -244,7 +248,40 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS let mutable sigHelpKind = None let mutable binaryLogConfig = Ionide.ProjInfo.BinaryLogGeneration.Off - let parseFile (p: DidChangeTextDocumentParams) = + let analyzeFile (filePath) = + let analyzers = [ + // if config.Linter then + // commands.Lint filePath |> Async.Ignore + if config.UnusedOpensAnalyzer then + commands.CheckUnusedOpens filePath + if config.UnusedDeclarationsAnalyzer then + commands.CheckUnusedDeclarations filePath + if config.SimplifyNameAnalyzer then + commands.CheckSimplifiedNames filePath + ] + + analyzers + |> Async.Parallel + |> Async.Ignore + + let parseFile + (filePath: string) + (version: int) + (content: NamedText) + = async { + let tfmConfig = config.UseSdkScripts + do! + commands.Parse filePath content version (Some tfmConfig) + |> Async.Ignore + + async { + do! analyzeFile filePath + do! lspClient.NotifyDocumentAnalyzed { TextDocument = { Uri = filePath |> Path.LocalPathToUri; Version = Some version } } + } + |> Async.Start + } + + let parseChangedFile (p: DidChangeTextDocumentParams) = async { let doc = p.TextDocument @@ -256,26 +293,14 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS if contentChange.Range.IsNone && contentChange.RangeLength.IsNone then let content = NamedText(filePath, contentChange.Text) - let tfmConfig = config.UseSdkScripts logger.info ( Log.setMessage "ParseFile - Parsing {file}" >> Log.addContextDestructured "file" filePath ) - do! - commands.Parse filePath content version (Some tfmConfig) - |> Async.Ignore - - // if config.Linter then do! (commands.Lint filePath |> Async.Ignore) - if config.UnusedOpensAnalyzer then - Async.Start(commands.CheckUnusedOpens filePath) - - if config.UnusedDeclarationsAnalyzer then - Async.Start(commands.CheckUnusedDeclarations filePath) //fire and forget this analyzer now that it's syncronous + do! parseFile filePath version content - if config.SimplifyNameAnalyzer then - Async.Start(commands.CheckSimplifiedNames filePath) else logger.warn (Log.setMessage "ParseFile - Parse not started, received partial change") | _ -> @@ -286,7 +311,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS } |> Async.Start - let parseFileDebuncer = Debounce(500, parseFile) + let parseFileDebuncer = Debounce(500, parseChangedFile) let sendDiagnostics (uri: DocumentUri) (diags: Diagnostic []) = @@ -605,9 +630,10 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS commands.SetLinterConfigRelativePath config.LinterConfig // TODO(CH): make the destination part of config, so that non-FSAC editors don't have the '.ionide' path binaryLogConfig <- - match config.GenerateBinlog with - | false -> Ionide.ProjInfo.BinaryLogGeneration.Off - | true -> Ionide.ProjInfo.BinaryLogGeneration.Within(DirectoryInfo(Path.Combine(rootPath.Value, ".ionide"))) + match config.GenerateBinlog, rootPath with + | _, None + | false, _ -> Ionide.ProjInfo.BinaryLogGeneration.Off + | true, Some rootPath -> Ionide.ProjInfo.BinaryLogGeneration.Within(DirectoryInfo(Path.Combine(rootPath, ".ionide"))) () do @@ -995,19 +1021,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS commands.SetFileContent(filePath, content, Some doc.Version, config.ScriptTFM) - do! - (commands.Parse filePath content doc.Version (Some tfmConfig) - |> Async.Ignore) - - // if config.Linter then do! (commands.Lint filePath |> Async.Ignore) - if config.UnusedOpensAnalyzer then - Async.Start(commands.CheckUnusedOpens filePath) - - if config.UnusedDeclarationsAnalyzer then - Async.Start(commands.CheckUnusedDeclarations filePath) - - if config.SimplifyNameAnalyzer then - Async.Start(commands.CheckSimplifiedNames filePath) + do! parseFile filePath doc.Version content } override __.TextDocumentDidChange(p) = diff --git a/src/FsAutoComplete/LspHelpers.fs b/src/FsAutoComplete/LspHelpers.fs index cd7c5737c..7b3188a4d 100644 --- a/src/FsAutoComplete/LspHelpers.fs +++ b/src/FsAutoComplete/LspHelpers.fs @@ -521,6 +521,15 @@ module ClassificationUtils = type PlainNotification= { Content: string } +/// Notification when a `TextDocument` is completely analyzed: +/// F# Compiler checked file & all Analyzers (like `UnusedOpensAnalyzer`) are done. +/// +/// Used to signal all Diagnostics for this `TextDocument` are collected and sent. +/// -> For tests to get all Diagnostics of `TextDocument` +type DocumentAnalyzedNotification = { + TextDocument: VersionedTextDocumentIdentifier +} + type TestDetectedNotification = { File: string Tests: TestAdapter.TestAdapterEntry array } diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs index 483e44d97..ef6b6efcc 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs @@ -1,925 +1,430 @@ module FsAutoComplete.Tests.CodeFixTests open Expecto -open System.IO open Helpers +open Utils.ServerTests +open Utils.CursorbasedTests open Ionide.LanguageServerProtocol.Types -open FsAutoComplete.Utils - -let pos (line, character) = { Line = line; Character = character } -let range st e = { Start = pos st; End = pos e } -let rangeP st e = { Start = st; End = e } - -/// naive iteration, assumes start and end are on same line -let iterateRange (r: Range) = - seq { - if r.Start = r.End then - yield r.Start - else - for c = r.Start.Character to r.End.Character do - yield pos (r.Start.Line, c) - } - -let (|Refactor|_|) title newText action = - match action with - | { Title = title' - Kind = Some "refactor" - Edit = Some { DocumentChanges = Some [| { Edits = [| { NewText = newText' } |] } |] } } when - title' = title && newText' = newText - -> - Some() - | _ -> None - -let (|AtRange|_|) range (action: CodeAction) = - match action with - | { Edit = Some { DocumentChanges = Some [| { Edits = [| { Range = range' } |] } |] } } when range = range' -> Some() - | _ -> None - -let abstractClassGenerationTests state = - let server = - async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "AbstractClassGeneration") - - let! (server, events) = - serverInitialize path { defaultConfigDto with AbstractClassStubGeneration = Some true } state - - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") (fun e -> e) - - return (server, path, diagnostics) +open FsAutoComplete.CodeFix + +module private Diagnostics = + let expectCode code (diags: Diagnostic[]) = + Expecto.Flip.Expect.exists + $"There should be a Diagnostic with code %s{code}" + (fun (d: Diagnostic) -> d.Code = Some code) + diags + let acceptAll = ignore + + open FsAutoComplete.Logging + let private logger = FsAutoComplete.Logging.LogProvider.getLoggerByName "CodeFixes.Diagnostics" + /// Usage: `(Diagnostics.log >> Diagnostics.expectCode "XXX")` + /// Logs as `info` + let log (diags: Diagnostic[]) = + logger.info ( + Log.setMessage "diags({count})={diags}" + >> Log.addContext "count" diags.Length + >> Log.addContextDestructured "diags" diags + ) + diags + +module CodeFix = + open FsAutoComplete.Logging + let private logger = FsAutoComplete.Logging.LogProvider.getLoggerByName "CodeFixes.CodeFix" + /// Usage: `(CodeFix.log >> CodeFix.withTitle "XXX")` + /// Logs as `info` + let log (codeActions: CodeAction[]) = + logger.info ( + Log.setMessage "codeActions({count})={codeActions}" + >> Log.addContext "count" codeActions.Length + >> Log.addContextDestructured "codeActions" codeActions + ) + codeActions + +let private generateAbstractClassStubTests state = + let config = { defaultConfigDto with AbstractClassStubGeneration = Some true } + // issue: returns same fix twice: + // Once for error 54 (`This type is 'abstract' since some abstract members have not been given an implementation.`) + // And once for error 365 (`No implementation was given for those members [...]`) + pserverTestList (nameof GenerateAbstractClassStub) state config None (fun server -> [ + let selectCodeFix = CodeFix.withTitle GenerateAbstractClassStub.title + testCaseAsync "can generate a derivative of a long ident - System.IO.Stream" <| + CodeFix.checkApplicable server + """ + type My$0Stream() = + inherit System.IO.Stream() + """ + (Diagnostics.expectCode "365") + selectCodeFix + testCaseAsync "can generate a derivative for a simple ident - Stream" <| + CodeFix.checkApplicable server + """ + open System.IO + type My$0Stream2() = + inherit Stream() + """ + (Diagnostics.expectCode "365") + selectCodeFix + ]) + +let private generateUnionCasesTests state = + let config = + { defaultConfigDto with + UnionCaseStubGeneration = Some true + UnionCaseStubGenerationBody = Some "failwith \"---\"" } - |> Async.Cache - - let canGenerateForLongIdent = - testCaseAsync - "can generate a derivative of a long ident - System.IO.Stream" - (async { - let! server, file, diagnostics = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Code = Some "365" && d.Range.Start.Line = 0) - |> Option.defaultWith (fun _ -> failtest "Should have gotten an error of type 365") - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Generate abstract class members" } |])) -> () - | Ok other -> failtestf $"Should have generated the rest of the base class, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - let canGenerateForIdent = - testCaseAsync - "can generate a derivative for a simple ident - Stream" - (async { - let! server, file, diagnostics = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Code = Some "365" && d.Range.Start.Line = 5) - |> Option.defaultWith (fun _ -> failtest "Should have gotten an error of type 365") - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Generate abstract class members" } |])) -> () - | Ok other -> failtestf $"Should have generated the rest of the base class, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - testList - "abstract class generation" - [ canGenerateForLongIdent - canGenerateForIdent ] - -let generateMatchTests state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MatchCaseGeneration") - - let! (server, events) = serverInitialize path { defaultConfigDto with UnionCaseStubGeneration = Some true } state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") (fun e -> e) - - return (server, path, diagnostics) + serverTestList (nameof GenerateUnionCases) state config None (fun server -> [ + let selectCodeFix = CodeFix.withTitle GenerateUnionCases.title + testCaseAsync "can generate match cases for a simple DU" <| + CodeFix.check server + """ + type Letter = A | B | C + + let char = A + + match $0char with + | A -> () + """ + (Diagnostics.expectCode "25") + (CodeFix.withTitle GenerateUnionCases.title) + """ + type Letter = A | B | C + + let char = A + + match char with + | A -> () + | B -> failwith "---" + | C -> failwith "---" + """ + ]) + +let private generateRecordStubTests state = + let config = + { defaultConfigDto with + RecordStubGeneration = Some true + RecordStubGenerationBody = Some "failwith \"---\"" } - |> Async.Cache - - testList - "generate match cases" - [ testCaseAsync - "can generate match cases for a simple DU" - (async { - let! server, file, diagnostics = server - let expectedDiagnostic = diagnostics.[0] - Expect.equal expectedDiagnostic.Code (Some "25") "Should have a empty match warning" - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = expectedDiagnostic.Range - Context = { Diagnostics = [| expectedDiagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Generate union pattern match cases" } |])) -> - () - | Ok other -> failtestf $"Should have generated the rest of match cases, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let generateRecordStubTests state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "RecordStubGeneration") - - let! (server, events) = serverInitialize path { defaultConfigDto with RecordStubGeneration = Some true } state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") (fun e -> e) - - return (server, path, diagnostics) - } - |> Async.Cache - - testList - "generate record stubs" - [ testCaseAsync - "can generate record stubs for every pos in the record as soon as one field is known" - (async { - let! server, file, diagnostics = server - let expectedDiagnostic = diagnostics.[0] - Expect.equal expectedDiagnostic.Code (Some "764") "Should have missing record field diagnostic" - - for pos in iterateRange expectedDiagnostic.Range do - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = rangeP pos pos - Context = { Diagnostics = [| expectedDiagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Generate record stub" - Edit = Some { DocumentChanges = Some [| { Edits = [| { Range = { Start = { Line = 2 - Character = 18 } - End = { Line = 2 - Character = 18 } } - NewText = "\n b = failwith \"Not Implemented\"" } |] } |] } } |])) -> - () - | Ok other -> - failtestf - $"Should have generated the rest of the record body at %d{pos.Line},%d{pos.Character}, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - - -let missingFunKeywordTests state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MissingFunKeyword") - - let! (server, events) = serverInitialize path defaultConfigDto state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") (fun e -> e) - - return (server, path, diagnostics) - } - |> Async.Cache - - testList - "missing fun keyword" - [ testCaseAsync - "can generate the fun keyword when error 10 is raised" - (async { - let! server, file, diagnostics = server - let expectedDiagnostic = diagnostics.[0] - Expect.equal expectedDiagnostic.Code (Some "10") "Should have a missing fun keyword error" - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = expectedDiagnostic.Range - Context = { Diagnostics = [| expectedDiagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Add missing 'fun' keyword" - Kind = Some "quickfix" - Edit = Some { DocumentChanges = Some [| { Edits = [| { NewText = "fun " } |] } |] } } |])) -> - () - | Ok other -> failtestf $"Should have generated missing fun keyword, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let outerBindingRecursiveTests state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "OuterBindingRecursive") - - let! (server, events) = serverInitialize path defaultConfigDto state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") (fun e -> e) - - return (server, path, diagnostics) - } - |> Async.Cache - - testList - "outer binding recursive" - [ testCaseAsync - "can make the outer binding recursive when self-referential" - (async { - let! server, file, diagnostics = server - let expectedDiagnostic = diagnostics.[0] - Expect.equal expectedDiagnostic.Code (Some "39") "Should have a not defined value error" - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = expectedDiagnostic.Range - Context = { Diagnostics = [| expectedDiagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Make outer binding recursive" - Kind = Some "quickfix" - Edit = Some { DocumentChanges = Some [| { Edits = [| { NewText = "rec " } |] } |] } } |])) -> - () - | Ok other -> failtestf $"Should have generated a rec keyword, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let nameofInsteadOfTypeofNameTests state = - let server = - async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "NameofInsteadOfTypeofName") - - let! (server, events) = serverInitialize path defaultConfigDto state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap id (fun _ -> failtest "Should not have had errors") - - return (server, path) - } - |> Async.Cache - - testList - "use nameof instead of typeof.Name" - [ testCaseAsync - "can suggest fix" - (async { - let! server, file = server - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = - { Start = { Line = 0; Character = 8 } - End = { Line = 0; Character = 8 } } - Context = { Diagnostics = [||] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Use 'nameof'" - Kind = Some "refactor" - Edit = Some { DocumentChanges = Some [| { Edits = [| { NewText = "nameof(Async)" } |] } |] } } |])) -> - () - | Ok other -> failtestf $"Should have generated nameof, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let missingInstanceMemberTests state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MissingInstanceMember") - - let! (server, events) = serverInitialize path defaultConfigDto state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - waitForParseResultsForFile "Script.fsx" events - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") (fun e -> e) - - return (server, path, diagnostics) - } - |> Async.Cache - - testList - "missing instance member" - [ testCaseAsync - "can add this member prefix" - (async { - let! server, file, diagnostics = server - let expectedDiagnostic = diagnostics.[0] - Expect.equal expectedDiagnostic.Code (Some "673") "Should have a missing self identifier error" - - let! response = - server.TextDocumentCodeAction - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = expectedDiagnostic.Range - Context = { Diagnostics = [| expectedDiagnostic |] } } - - match response with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Add missing instance member parameter" - Kind = Some "quickfix" - Edit = Some { DocumentChanges = Some [| { Edits = [| { NewText = "x." } |] } |] } } |])) -> - () - | Ok other -> failtestf $"Should have generated an instance member, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let unusedValueTests state = - let (|ActReplace|_|) = (|Refactor|_|) "Replace with _" "_" - - let (|ActPrefix|_|) oldText = - (|Refactor|_|) "Prefix with _" $"_{oldText}" - - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "UnusedValue") - - let cfg = { defaultConfigDto with UnusedDeclarationsAnalyzer = Some true } - - let! (server, events) = serverInitialize path cfg state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - events - |> waitForFsacDiagnosticsForFile "Script.fsx" - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") id - - return (server, path, diagnostics) - } - |> Async.Cache - - let canReplaceUnusedSelfReference = - testCaseAsync - "can replace unused self-reference" - (async { - let! server, file, diagnostics = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> - d.Range.Start = { Line = 2; Character = 9 } - && d.Range.End = { Line = 2; Character = 13 }) - |> Option.defaultWith (fun () -> failwith "could not find diagnostic with expected range") - - let detected = - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - match! server.TextDocumentCodeAction detected with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ActReplace |])) -> () - | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - let canReplaceUnusedBinding = - testCaseAsync - "can replace unused binding" - (async { - let! server, file, diagnostics = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> - d.Range.Start = { Line = 9; Character = 4 } - && d.Range.End = { Line = 9; Character = 7 }) - |> Option.defaultWith (fun () -> failwith "could not find diagnostic with expected range") - - let detected = - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - match! server.TextDocumentCodeAction detected with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ActReplace; ActPrefix "six" |])) -> () - | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - let canReplaceUnusedParameter = - testCaseAsync - "can replace unused parameter" - (async { - let! server, file, diagnostics = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> - d.Range.Start = { Line = 15; Character = 16 } - && d.Range.End = { Line = 15; Character = 21 }) - |> Option.defaultWith (fun () -> failwith "could not find diagnostic with expected range") - - let detected = - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - match! server.TextDocumentCodeAction detected with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ActReplace - ActPrefix "three" - _ (* explicit type annotation codefix *) |])) -> () - | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - testList - "unused value" - [ canReplaceUnusedSelfReference - canReplaceUnusedBinding - canReplaceUnusedParameter ] - -let removeUnusedBindingTests state = - let (|RemoveBinding|_|) = (|Refactor|_|) "Remove unused binding" "" - - let (|RemoveParameter|_|) = (|Refactor|_|) "Remove unused parameter" "" - - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "RemoveUnusedBinding") - - let cfg = { defaultConfigDto with FSIExtraParameters = Some [| "--warnon:1182" |] } - - let! (server, events) = serverInitialize path cfg state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - events - |> waitForCompilerDiagnosticsForFile "Script.fsx" - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") id - - return (server, path, diagnostics) - } - |> Async.Cache - - let canRemoveUnusedSingleCharacterFunctionParameter = - testCaseAsync - "can remove unused single character function parameter" - (async { - let! server, file, diagnostics = server - let targetRange = range (0, 9) (0, 10) - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Range = targetRange && d.Code = Some "1182") - |> Option.defaultWith (fun () -> failwith "could not find diagnostic with expected range and code") - - let detected = - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - let replacementRange = range (0, 8) (0, 10) - - match! server.TextDocumentCodeAction detected with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| RemoveParameter & AtRange replacementRange - _ (* explicit type annotation codefix *) |])) -> () - | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - let canRemoveUnusedSingleCharacterFunctionParameterInParens = - testCaseAsync - "can remove unused single character function parameter in parens" - (async { - let! server, file, diagnostics = server - let targetRange = range (2, 11) (2, 12) - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Range = targetRange && d.Code = Some "1182") - |> Option.defaultWith (fun () -> failwith "could not find diagnostic with expected range and code") - - let detected = - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - let replacementRange = range (2, 9) (2, 13) - - match! server.TextDocumentCodeAction detected with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| RemoveParameter & AtRange replacementRange - _ (* explicit type annotation codefix *) |])) -> () - | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - let canRemoveUnusedBindingInsideTopLevel = - testCaseAsync - "can remove unused binding inside top level" - (async { - let! server, file, diagnostics = server - let targetRange = range (5, 6) (5, 10) - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Range = targetRange && d.Code = Some "1182") - |> Option.defaultWith (fun () -> failwith "could not find diagnostic with expected range and code") - - let detected = - { CodeActionParams.TextDocument = { Uri = Path.FilePathToUri file } - Range = diagnostic.Range - Context = { Diagnostics = [| diagnostic |] } } - - let replacementRange = range (5, 2) (5, 16) // span of whole `let incr...` binding - - match! server.TextDocumentCodeAction detected with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| RemoveBinding & AtRange replacementRange |])) -> () - | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) - - - testList - "remove unused binding" - [ canRemoveUnusedSingleCharacterFunctionParameter - canRemoveUnusedSingleCharacterFunctionParameterInParens - canRemoveUnusedBindingInsideTopLevel ] - -let addExplicitTypeAnnotationTests state = - let server = - async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "ExplicitTypeAnnotations") - - let cfg = defaultConfigDto - let! (server, events) = serverInitialize path cfg state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - do! - events - |> waitForParseResultsForFile "Script.fsx" - |> AsyncResult.bimap id (fun _ -> failtest "Should not have had errors") - - return (server, path) - } - |> Async.Cache - - let (|ExplicitAnnotation|_|) = (|Refactor|_|) "Add explicit type annotation" - - testList - "explicit type annotations" - [ testCaseAsync - "can suggest explicit parameter for record-typed function parameters" - (async { - let! (server, filePath) = server - - let context: CodeActionParams = - { Context = { Diagnostics = [||] } - Range = - { Start = { Line = 3; Character = 9 } - End = { Line = 3; Character = 9 } } - TextDocument = { Uri = Path.FilePathToUri filePath } } - - match! server.TextDocumentCodeAction context with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ExplicitAnnotation "(f: Foo)" |])) -> () - | Ok other -> failtestf $"Should have generated explicit type annotation, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let negationToSubstraction state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "NegationToSubstraction") - - let cfg = defaultConfigDto - let! (server, events) = serverInitialize path cfg state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - events - |> waitForParseResultsForFile "Script.fsx" - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") id - - return (server, path, diagnostics) - } - |> Async.Cache - - let (|NegationToSubstraction|_|) = (|Refactor|_|) "Negation to substraction" - - testList - "negation to substraction" - [ testCaseAsync - "converts negation to substraction" - (async { - let! (server, filePath, diagnostics) = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Code = Some "3" && d.Range.Start.Line = 2) - |> Option.defaultWith (fun _ -> failtest "Should have gotten an error of type 3") - - let context: CodeActionParams = - { Context = { Diagnostics = [| diagnostic |] } - Range = - { Start = { Line = 2; Character = 13 } - End = { Line = 2; Character = 14 } } - TextDocument = { Uri = Path.FilePathToUri filePath } } - - match! server.TextDocumentCodeAction context with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Use subtraction instead of negation" - Kind = Some "quickfix" - Edit = Some { DocumentChanges = Some [| { Edits = [| { Range = { Start = { Line = 2 - Character = 15 } - End = { Line = 2 - Character = 16 } } - NewText = "- " } |] } |] } } |])) -> - () - | Ok other -> failtestf $"Should have converted negation to substraction, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let positionalToNamedDUTests state = - let server = - async { - let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "PositionalToNamedDU") - - let cfg = defaultConfigDto - let! (server, events) = serverInitialize path cfg state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - events - |> waitForParseResultsForFile "Script.fsx" - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") id - - return (server, path) - } - |> Async.Cache - - let expectEdits invokePos edits = - async { - let! (server, filePath) = server - - let context: CodeActionParams = - { Context = { Diagnostics = [||] } - Range = invokePos - TextDocument = { Uri = Path.FilePathToUri filePath } } - - match! server.TextDocumentCodeAction context with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Convert to named patterns" - Kind = Some "refactor" - Edit = Some { DocumentChanges = Some [| { Edits = es } |] } } |])) when - es = edits - -> - () - | Ok other -> failtestf $"Should have converted positional DUs to named patterns, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - } - - testList - "convert positional DU match to named" - [ testCaseAsync - "in parenthesized let binding" - (let patternPos = - { Start = { Line = 2; Character = 9 } - End = { Line = 2; Character = 10 } } - - let edits = - [| { Range = - { Start = { Line = 2; Character = 7 } - End = { Line = 2; Character = 7 } } - NewText = "a = " } - { Range = - { Start = { Line = 2; Character = 8 } - End = { Line = 2; Character = 8 } } - NewText = ";" } - { Range = - { Start = { Line = 2; Character = 8 } - End = { Line = 2; Character = 9 } } - NewText = "" } - { Range = - { Start = { Line = 2; Character = 10 } - End = { Line = 2; Character = 10 } } - NewText = "b = " } - { Range = - { Start = { Line = 2; Character = 11 } - End = { Line = 2; Character = 11 } } - NewText = ";" } |] - - expectEdits patternPos edits) - testCaseAsync - "in simple match" - (let patternPos = - { Start = { Line = 5; Character = 5 } - End = { Line = 5; Character = 6 } } - - let edits = - [| { Range = - { Start = { Line = 5; Character = 4 } - End = { Line = 5; Character = 4 } } - NewText = "a = " } - { Range = - { Start = { Line = 5; Character = 5 } - End = { Line = 5; Character = 5 } } - NewText = ";" } - { Range = - { Start = { Line = 5; Character = 5 } - End = { Line = 5; Character = 6 } } - NewText = "" } - { Range = - { Start = { Line = 5; Character = 7 } - End = { Line = 5; Character = 7 } } - NewText = "b = " } - { Range = - { Start = { Line = 5; Character = 8 } - End = { Line = 5; Character = 8 } } - NewText = ";" } |] - - expectEdits patternPos edits) - testCaseAsync - "in parenthesized match" - (let patternPos = - { Start = { Line = 8; Character = 7 } - End = { Line = 8; Character = 8 } } - - let edits = - [| { Range = - { Start = { Line = 8; Character = 5 } - End = { Line = 8; Character = 5 } } - NewText = "a = " } - { Range = - { Start = { Line = 8; Character = 6 } - End = { Line = 8; Character = 6 } } - NewText = ";" } - { Range = - { Start = { Line = 8; Character = 6 } - End = { Line = 8; Character = 7 } } - NewText = "" } - { Range = - { Start = { Line = 8; Character = 8 } - End = { Line = 8; Character = 8 } } - NewText = "b = " } - { Range = - { Start = { Line = 8; Character = 9 } - End = { Line = 8; Character = 9 } } - NewText = ";" } |] - - expectEdits patternPos edits) - testCaseAsync - "when there are new fields on the DU" - (let patternPos = - { Start = { Line = 12; Character = 29 } - End = { Line = 12; Character = 30 } } - - let edits = - [| { Range = - { Start = { Line = 12; Character = 28 } - End = { Line = 12; Character = 28 } } - NewText = "a = " } - { Range = - { Start = { Line = 12; Character = 29 } - End = { Line = 12; Character = 29 } } - NewText = ";" } - { Range = - { Start = { Line = 12; Character = 29 } - End = { Line = 12; Character = 30 } } - NewText = "" } - { Range = - { Start = { Line = 12; Character = 31 } - End = { Line = 12; Character = 31 } } - NewText = "b = " } - { Range = - { Start = { Line = 12; Character = 32 } - End = { Line = 12; Character = 32 } } - NewText = ";" } - { Range = - { Start = { Line = 12; Character = 32 } - End = { Line = 12; Character = 32 } } - NewText = "c = _;" } |] - - expectEdits patternPos edits) ] - -let tripleQuotedInterpolationTests state = - let server = - async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "TripleQuotedInterpolation") - - let cfg = defaultConfigDto - let! (server, events) = serverInitialize path cfg state - do! waitForWorkspaceFinishedParsing events - let path = Path.Combine(path, "Script.fsx") - let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } - do! server.TextDocumentDidOpen tdop - - let! diagnostics = - events - |> waitForParseResultsForFile "Script.fsx" - |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") id - - return (server, path, diagnostics) - } - |> Async.Cache - - testList - "interpolation fixes" - [ testCaseAsync - "converts erroring single-quoted interpolation to triple-quoted" - (async { - let! (server, filePath, diagnostics) = server - - let diagnostic = - diagnostics - |> Array.tryFind (fun d -> d.Code = Some "3373") - |> Option.defaultWith (fun _ -> failtest "Should have gotten an error of type 3373") - - let context: CodeActionParams = - { Context = { Diagnostics = [| diagnostic |] } - Range = - { Start = diagnostic.Range.Start - End = diagnostic.Range.Start } - TextDocument = { Uri = Path.FilePathToUri filePath } } - - match! server.TextDocumentCodeAction context with - | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Use triple-quoted string interpolation" - Kind = Some "quickfix" - Edit = Some { DocumentChanges = Some [| { Edits = [| { Range = { Start = { Line = 0 - Character = 8 } - End = { Line = 0 - Character = 44 } } - NewText = "$\"\"\":^) {if true then \"y\" else \"n\"} d\"\"\"" } |] } |] } } |])) -> - () - | Ok other -> - failtestf - $"Should have converted single quoted interpolations to triple quotes, but instead generated %A{other}" - | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] - -let tests state = - testList - "codefix tests" - [ abstractClassGenerationTests state - generateRecordStubTests state - generateMatchTests state - missingFunKeywordTests state - outerBindingRecursiveTests state - nameofInsteadOfTypeofNameTests state - missingInstanceMemberTests state - unusedValueTests state - addExplicitTypeAnnotationTests state - negationToSubstraction state - removeUnusedBindingTests state - positionalToNamedDUTests state ] + serverTestList (nameof GenerateRecordStub) state config None (fun server -> [ + CodeFix.testAllPositions "can generate record stubs for every pos in the record as soon as one field is known" + server + """ + type R = { a: string; b: int } + + let a = $0{ $0a = $0"";$0 }$0 + """ + (Diagnostics.expectCode "764") + (CodeFix.withTitle GenerateRecordStub.title) + """ + type R = { a: string; b: int } + + let a = { a = ""; + b = failwith "---" } + """ + ]) + +let private addMissingFunKeywordTests state = + serverTestList (nameof AddMissingFunKeyword) state defaultConfigDto None (fun server -> [ + testCaseAsync "can generate the fun keyword when error 10 is raised" <| + CodeFix.check server + """ + let doThing = x $0-> printfn "%s" x + """ + (Diagnostics.expectCode "10") + (CodeFix.ofKind "quickfix" >> CodeFix.withTitle AddMissingFunKeyword.title) + """ + let doThing = fun x -> printfn "%s" x + """ + ]) + +let private makeOuterBindingRecursiveTests state = + serverTestList (nameof MakeOuterBindingRecursive) state defaultConfigDto None (fun server -> [ + testCaseAsync "can make the outer binding recursive when self-referential" <| + CodeFix.check server + """ + let mySum xs acc = + match xs with + | [] -> acc + | _ :: tail -> + $0mySum tail (acc + 1) + """ + (Diagnostics.expectCode "39") + (CodeFix.ofKind "quickfix" >> CodeFix.withTitle MakeOuterBindingRecursive.title) + """ + let rec mySum xs acc = + match xs with + | [] -> acc + | _ :: tail -> + mySum tail (acc + 1) + """ + ]) + +let private changeTypeOfNameToNameOfTests state = + serverTestList (nameof ChangeTypeOfNameToNameOf) state defaultConfigDto None (fun server -> [ + testCaseAsync "can suggest fix" <| + CodeFix.check server + """ + let x = $0typeof>.Name + """ + (Diagnostics.acceptAll) + (CodeFix.ofKind "refactor" >> CodeFix.withTitle ChangeTypeOfNameToNameOf.title) + """ + let x = nameof(Async) + """ + ]) + +let private addMissingInstanceMemberTests state = + serverTestList (nameof AddMissingInstanceMember) state defaultConfigDto None (fun server -> [ + testCaseAsync "can add this member prefix" <| + CodeFix.check server + """ + type C () = + member $0Foo() = () + """ + (Diagnostics.expectCode "673") + (CodeFix.ofKind "quickfix" >> CodeFix.withTitle AddMissingInstanceMember.title) + """ + type C () = + member x.Foo() = () + """ + ]) + +let private unusedValueTests state = + let config = { defaultConfigDto with UnusedDeclarationsAnalyzer = Some true } + serverTestList (nameof UnusedValue) state config None (fun server -> [ + let selectReplace = CodeFix.ofKind "refactor" >> CodeFix.withTitle UnusedValue.titleReplace + let selectPrefix = CodeFix.ofKind "refactor" >> CodeFix.withTitle UnusedValue.titlePrefix + + testCaseAsync "can replace unused self-reference" <| + CodeFix.check server + """ + type MyClass() = + member $0this.DoAThing() = () + """ + (Diagnostics.acceptAll) + selectReplace + """ + type MyClass() = + member _.DoAThing() = () + """ + testCaseAsync "can replace unused binding" <| + CodeFix.check server + """ + let $0six = 6 + """ + (Diagnostics.acceptAll) + selectReplace + """ + let _ = 6 + """ + testCaseAsync "can prefix unused binding" <| + CodeFix.check server + """ + let $0six = 6 + """ + (Diagnostics.acceptAll) + selectPrefix + """ + let _six = 6 + """ + testCaseAsync "can replace unused parameter" <| + CodeFix.check server + """ + let add one two $0three = one + two + """ + (Diagnostics.acceptAll) + selectReplace + """ + let add one two _ = one + two + """ + testCaseAsync "can prefix unused parameter" <| + CodeFix.check server + """ + let add one two $0three = one + two + """ + (Diagnostics.log >> Diagnostics.acceptAll) + (CodeFix.log >> selectPrefix) + """ + let add one two _three = one + two + """ + ]) + +let private removeUnusedBindingTests state = + let config = { defaultConfigDto with FSIExtraParameters = Some [| "--warnon:1182" |] } + serverTestList (nameof RemoveUnusedBinding) state config None (fun server -> [ + let selectRemoveUnusedBinding = CodeFix.withTitle RemoveUnusedBinding.titleBinding + let selectRemoveUnusedParameter = CodeFix.withTitle RemoveUnusedBinding.titleParameter + let validateDiags = Diagnostics.expectCode "1182" + + testCaseAsync "can remove unused single character function parameter" <| + CodeFix.check server + """ + let incr $0i x = 2 + """ + validateDiags + selectRemoveUnusedParameter + """ + let incr x = 2 + """ + testCaseAsync "can remove unused single character function parameter in parens" <| + CodeFix.check server + """ + let incr ($0i) x = 2 + """ + validateDiags + selectRemoveUnusedParameter + """ + let incr x = 2 + """ + testCaseAsync "can remove unused binding inside top level" <| + //ENHANCEMENT: remove empty line + CodeFix.check server + """ + let container () = + let $0incr x = 2 + () + """ + validateDiags + selectRemoveUnusedBinding + """ + let container () = + + () + """ + ]) + +let private addExplicitTypeToParameterTests state = + serverTestList (nameof AddExplicitTypeToParameter) state defaultConfigDto None (fun server -> [ + testCaseAsync "can suggest explicit parameter for record-typed function parameters" <| + CodeFix.check server + """ + type Foo = + { name: string } + + let name $0f = + f.name + """ + (Diagnostics.acceptAll) + (CodeFix.withTitle AddExplicitTypeToParameter.title) + """ + type Foo = + { name: string } + + let name (f: Foo) = + f.name + """ + ]) + +let private negationToSubtractionTests state = + serverTestList (nameof NegationToSubtraction) state defaultConfigDto None (fun server -> [ + testCaseAsync "converts negation to subtraction" <| + CodeFix.check server + """ + let getListWithoutFirstAndLastElement list = + let l = List.length list + list[ 1 .. $0l -1 ] + """ + (Diagnostics.expectCode "3") + (CodeFix.ofKind "quickfix" >> CodeFix.withTitle NegationToSubtraction.title) + """ + let getListWithoutFirstAndLastElement list = + let l = List.length list + list[ 1 .. l - 1 ] + """ + ]) + +let private convertPositionalDUToNamedTests state = + serverTestList (nameof ConvertPositionalDUToNamed) state defaultConfigDto None (fun server -> [ + let selectCodeFix = CodeFix.withTitle ConvertPositionalDUToNamed.title + testCaseAsync "in parenthesized let binding" <| + CodeFix.check server + """ + type A = A of a: int * b: bool + + let (A(a$0, b)) = A(1, true) + """ + Diagnostics.acceptAll + selectCodeFix + """ + type A = A of a: int * b: bool + + let (A(a = a; b = b;)) = A(1, true) + """ + testCaseAsync "in simple match" <| + CodeFix.check server + """ + type A = A of a: int * b: bool + + match A(1, true) with + | A(a$0, b) -> () + """ + Diagnostics.acceptAll + selectCodeFix + """ + type A = A of a: int * b: bool + + match A(1, true) with + | A(a = a; b = b;) -> () + """ + testCaseAsync "in parenthesized match" <| + CodeFix.check server + """ + type A = A of a: int * b: bool + + match A(1, true) with + | (A(a$0, b)) -> () + """ + Diagnostics.acceptAll + selectCodeFix + """ + type A = A of a: int * b: bool + + match A(1, true) with + | (A(a = a; b = b;)) -> () + """ + testCaseAsync "when there are new fields on the DU" <| + //ENHANCEMENT: add space before wildcard case + CodeFix.check server + """ + type ThirdFieldWasJustAdded = ThirdFieldWasJustAdded of a: int * b: bool * c: char + + let (ThirdFieldWasJustAdded($0a, b)) = ThirdFieldWasJustAdded(1, true, 'c') + """ + Diagnostics.acceptAll + selectCodeFix + """ + type ThirdFieldWasJustAdded = ThirdFieldWasJustAdded of a: int * b: bool * c: char + + let (ThirdFieldWasJustAdded(a = a; b = b;c = _;)) = ThirdFieldWasJustAdded(1, true, 'c') + """ + ]) + +let private useTripleQuotedInterpolationTests state = + serverTestList (nameof UseTripleQuotedInterpolation) state defaultConfigDto None (fun server -> [ + testCaseAsync "converts erroring single-quoted interpolation to triple-quoted" <| + CodeFix.check server + """ + let a = $":^) {if true then $0"y" else "n"} d" + """ + (Diagnostics.expectCode "3373") + (CodeFix.ofKind "quickfix" >> CodeFix.withTitle UseTripleQuotedInterpolation.title) + // cannot use triple quotes string here: ends with `"""` -> cannot use in string + @" + let a = $"""""":^) {if true then ""y"" else ""n""} d"""""" + " + ]) + +let tests state = testList "CodeFix tests" [ + generateAbstractClassStubTests state + generateUnionCasesTests state + generateRecordStubTests state + addMissingFunKeywordTests state + makeOuterBindingRecursiveTests state + changeTypeOfNameToNameOfTests state + addMissingInstanceMemberTests state + unusedValueTests state + removeUnusedBindingTests state + addExplicitTypeToParameterTests state + negationToSubtractionTests state + convertPositionalDUToNamedTests state + useTripleQuotedInterpolationTests state +] diff --git a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj index 842e2535d..d0090d26c 100644 --- a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj +++ b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj @@ -17,6 +17,15 @@ + + + + + + + + + diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index d2d0a1b13..907ea1759 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -35,18 +35,22 @@ let loaders = let mutable toolsPath = Ionide.ProjInfo.Init.init (System.IO.DirectoryInfo Environment.CurrentDirectory) None -[] -let tests = +let lspTests = testList "lsp" [ for (name, workspaceLoaderFactory) in loaders do testList name - [ Templates.tests () + [ + Templates.tests () let state () = FsAutoComplete.State.Initial toolsPath workspaceLoaderFactory initTests state + + Utils.Tests.Server.tests state + Utils.Tests.CursorbasedTests.tests state + codeLensTest state documentSymbolTest state Completion.autocompleteTest state @@ -78,7 +82,19 @@ let tests = InfoPanelTests.docFormattingTest state DetectUnitTests.tests state XmlDocumentationGeneration.tests state - InlayHintTests.tests state ] ] + InlayHintTests.tests state + ] + ] + +[] +let tests = testList "FSAC" [ + testList (nameof(Utils)) [ + Utils.Tests.Utils.tests + Utils.Tests.TextEdit.tests + ] + + lspTests +] [] diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/AbstractClassGeneration/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/AbstractClassGeneration/Script.fsx deleted file mode 100644 index a3207e996..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/AbstractClassGeneration/Script.fsx +++ /dev/null @@ -1,7 +0,0 @@ -type MyStream() = - inherit System.IO.Stream() - - -open System.IO -type MyStream2() = - inherit Stream() diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/ExplicitTypeAnnotations/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/ExplicitTypeAnnotations/Script.fsx deleted file mode 100644 index 07aeff1af..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/ExplicitTypeAnnotations/Script.fsx +++ /dev/null @@ -1,5 +0,0 @@ -type Foo = - { name: string } - -let name f = - f.name diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/FoldingTests/Library.fs b/test/FsAutoComplete.Tests.Lsp/TestCases/FoldingTests/Library.fs index cd4d416cf..5a3b47f6f 100644 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/FoldingTests/Library.fs +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/FoldingTests/Library.fs @@ -1,7 +1,7 @@ -namespace FoldingTests - -/// some comments -/// multiline, of course -module Say = - let hello name = - printfn "Hello %s" name +namespace FoldingTests + +/// some comments +/// multiline, of course +module Say = + let hello name = + printfn "Hello %s" name diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/MatchCaseGeneration/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/MatchCaseGeneration/Script.fsx deleted file mode 100644 index fb59e59e3..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/MatchCaseGeneration/Script.fsx +++ /dev/null @@ -1,6 +0,0 @@ -type Letter = A | B | C - -let char = A - -match char with -| A -> () diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/MissingFunKeyword/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/MissingFunKeyword/Script.fsx deleted file mode 100644 index 766a2e69f..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/MissingFunKeyword/Script.fsx +++ /dev/null @@ -1 +0,0 @@ -let doThing = x -> printfn "%s" x diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/MissingInstanceMember/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/MissingInstanceMember/Script.fsx deleted file mode 100644 index d5c2fdff2..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/MissingInstanceMember/Script.fsx +++ /dev/null @@ -1,2 +0,0 @@ -type C () = - member Foo() = () diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/NameofInsteadOfTypeofName/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/NameofInsteadOfTypeofName/Script.fsx deleted file mode 100644 index 9288efe05..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/NameofInsteadOfTypeofName/Script.fsx +++ /dev/null @@ -1 +0,0 @@ -let x = typeof>.Name diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/NegationToSubstraction/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/NegationToSubstraction/Script.fsx deleted file mode 100644 index d519794ac..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/NegationToSubstraction/Script.fsx +++ /dev/null @@ -1,3 +0,0 @@ -let getListWithoutFirstAndLastElement list = - let l = List.length list - list[ 1 .. l -1 ] diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/OuterBindingRecursive/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/OuterBindingRecursive/Script.fsx deleted file mode 100644 index c4df74ae4..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/OuterBindingRecursive/Script.fsx +++ /dev/null @@ -1,6 +0,0 @@ -let mySum xs acc = - match xs with - | [] -> acc - | _ :: tail -> - mySum tail (acc + 1) - diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/PositionalToNamedDU/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/PositionalToNamedDU/Script.fsx deleted file mode 100644 index 136ec8017..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/PositionalToNamedDU/Script.fsx +++ /dev/null @@ -1,13 +0,0 @@ -type A = A of a: int * b: bool - -let (A(a, b)) = A(1, true) - -match A(1, true) with -| A(a, b) -> () - -match A(1, true) with -| (A(a, b)) -> () - -type ThirdFieldWasJustAdded = ThirdFieldWasJustAdded of a: int * b: bool * c: char - -let (ThirdFieldWasJustAdded(a, b)) = ThirdFieldWasJustAdded(1, true, 'c') diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/RecordStubGeneration/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/RecordStubGeneration/Script.fsx deleted file mode 100644 index e0e7aeb04..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/RecordStubGeneration/Script.fsx +++ /dev/null @@ -1,3 +0,0 @@ -type R = { a: string; b: int } - -let a = { a = ""; } diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/RemoveUnusedBinding/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/RemoveUnusedBinding/Script.fsx deleted file mode 100644 index ae7e48670..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/RemoveUnusedBinding/Script.fsx +++ /dev/null @@ -1,7 +0,0 @@ -let incr i x = 2 - -let incr2 (i) = 2 - -let container () = - let incr x = 2 - () diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/JustScript/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/JustScript/Script.fsx new file mode 100644 index 000000000..41595c1a6 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/JustScript/Script.fsx @@ -0,0 +1 @@ +let foo = bar \ No newline at end of file diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Other.fs b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Other.fs new file mode 100644 index 000000000..4e1234e4c --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Other.fs @@ -0,0 +1,6 @@ +module Other + +let doStuff () = + printfn "Hello world" + +let foo = otherBar diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Program.fs b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Program.fs new file mode 100644 index 000000000..6fc978941 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Program.fs @@ -0,0 +1,15 @@ +// Learn more about F# at http://docs.microsoft.com/dotnet/fsharp + +open System + +let foo = programBar + +// Define a function to construct a message to print +let from whom = + sprintf "from %s" whom + +[] +let main argv = + let message = from "F#" // Call the function + printfn "Hello world %s" message + 0 // return an integer exit code \ No newline at end of file diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Project.fsproj b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Project.fsproj new file mode 100644 index 000000000..4e9141bc8 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/ServerTests/Project/Project.fsproj @@ -0,0 +1,13 @@ + + + + Exe + net6.0 + + + + + + + + diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/TripleQuotedInterpolation/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/TripleQuotedInterpolation/Script.fsx deleted file mode 100644 index 03c245bb7..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/TripleQuotedInterpolation/Script.fsx +++ /dev/null @@ -1 +0,0 @@ -let a = $":^) {if true then "y" else "n"} d" diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/UnusedValue/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/UnusedValue/Script.fsx deleted file mode 100644 index 1f2971f6a..000000000 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/UnusedValue/Script.fsx +++ /dev/null @@ -1,16 +0,0 @@ -(* unused self reference *) -type MyClass() = - member this.DoAThing() = () - - -(* - replace usused binding with _ - prefix _ to unused binding -*) -let six = 6 - -(* - replace usused function parameter with _ - prefix _ to unused function parameter -*) -let add one two three = one + two diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs new file mode 100644 index 000000000..a6f3c3063 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs @@ -0,0 +1,162 @@ +module Utils.Tests.CursorbasedTests +open Expecto +open Helpers +open Ionide.LanguageServerProtocol.Types +open Utils.Utils +open Utils.ServerTests +open Utils.CursorbasedTests + +module private CodeFix = + let private expectLength n (fixes: CodeAction[]) = + // Note: this fails with `failwith` instead of `Expect....` (-> AssertException) to fail `Expect.failure` + // Expect.hasLength fixes n "Incorrect number of CodeFixes" + if fixes.Length <> n then + failwith $"Expected {n} CodeFixes, but was {fixes.Length}" + fixes + let private expectAtLeast n (fixes: CodeAction[]) = + // Expect.isGreaterThanOrEqual (fixes |> Array.length) n "Too few CodeFixes" + if fixes.Length < n then + failwith $"Expected at least {n} CodeFixes, but was {fixes.Length}" + fixes + + let private checkNotApplicableTests server = testList (nameof CodeFix.checkNotApplicable) [ + let expectFailCheckNotApplicable + server + beforeWithCursor + chooseFix + = + CodeFix.checkNotApplicable server beforeWithCursor ignore chooseFix + |> Expect.failure + + testCaseAsync "not applicable when some code actions but no matching one" <| + CodeFix.checkNotApplicable + server + "let a$0 = 42" + ignore + ( + CodeFix.withTitle "Add missing '=' to type definition" + >> expectLength 0 + ) + testCaseAsync "not applicable when no code actions" <| + CodeFix.checkNotApplicable + server + """ + let a$0 = 42 + a + 42 + """ + ignore + (expectLength 0) + testCaseAsync "not not applicable when one code action" <| + expectFailCheckNotApplicable + server + "let a$0 = 42" + ( + (CodeFix.withTitle "Replace with _") + >> expectLength 1 + ) + testCaseAsync "not not applicable when multiple code actions" <| + expectFailCheckNotApplicable + server + "let a$0 = 42" + (expectAtLeast 2) + ] + + let private checkApplicableTests server = testList (nameof CodeFix.checkApplicable) [ + let expectFailCheckApplicable + server + beforeWithCursor + chooseFix + = + CodeFix.checkApplicable server beforeWithCursor ignore chooseFix + |> Expect.failure + + testCaseAsync "applicable when one code action" <| + CodeFix.checkApplicable + server + "let a$0 = 42" + ignore + ( + (CodeFix.withTitle "Replace with _") + >> expectLength 1 + ) + testCaseAsync "not applicable when no code action" <| + expectFailCheckApplicable + server + "let a$0 = 42" + ( + CodeFix.withTitle "Add missing '=' to type definition" + >> expectLength 0 + ) + testCaseAsync "not applicable when multiple code actions" <| + expectFailCheckApplicable + server + "let a$0 = 42" + ( + expectAtLeast 2 + ) + ] + + let private checkTests server = testList (nameof CodeFix.check) [ + let expectFailCheck + server + beforeWithCursor + chooseFix + expected + = + CodeFix.check server beforeWithCursor ignore chooseFix expected + |> Expect.failure + + testCaseAsync "can get expected output" <| + CodeFix.check + server + "let a$0 = 42" + ignore + ( + (CodeFix.withTitle "Replace with _") + >> expectLength 1 + ) + "let _ = 42" + testCaseAsync "fails when unexpected output" <| + expectFailCheck + server + "let a$0 = 42" + ( + (CodeFix.withTitle "Replace with _") + >> expectLength 1 + ) + "let b = 42" + testCaseAsync "fails when no code action" <| + expectFailCheck + server + "let a$0 = 42" + ( + CodeFix.withTitle "Add missing '=' to type definition" + >> expectLength 0 + ) + "let _ = 42" + testCaseAsync "fails when multiple code actions" <| + expectFailCheck + server + "let a$0 = 42" + ( + expectAtLeast 2 + ) + "let _ = 42" + ] + + let tests state = + let config = + { defaultConfigDto with + UnusedOpensAnalyzer = Some true + UnusedDeclarationsAnalyzer = Some true + SimplifyNameAnalyzer = Some true + } + serverTestList (nameof CodeFix) state config None (fun server -> [ + checkNotApplicableTests server + checkApplicableTests server + checkTests server + ]) + +let tests state = testList (nameof Utils.CursorbasedTests) [ + CodeFix.tests state +] diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.fs new file mode 100644 index 000000000..f256140a8 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.fs @@ -0,0 +1,298 @@ +module Utils.CursorbasedTests +open Expecto +open Ionide.LanguageServerProtocol.Types +open FsToolkit.ErrorHandling +open Utils.Utils +open Utils.Server +open Utils.TextEdit +open Ionide.ProjInfo.Logging + +/// Checks for CodeFixes, CodeActions +/// +/// Prefixes: +/// * `check`: Check to use inside a `testCaseAsync`. Not a Test itself! +/// * `test`: Returns Expecto Test. Usually combines multiple tests (like: test all positions). +module CodeFix = + let private logger = LogProvider.getLoggerByName "CursorbasedTests.CodeFix" + + let private diagnosticsIn (range: Range) (diags: Diagnostic[]) = + diags + |> Array.filter (fun diag -> range |> Range.overlapsStrictly diag.Range) + + /// Note: Return should be just ONE `CodeAction` (for Applicable) or ZERO `CodeAction` (for Not Applicable). + /// But actual return type is an array of `CodeAction`s: + /// * Easier to successive filter CodeActions down with simple pipe and `Array.filter` + /// * Returning `CodeAction option` would mean different filters for `check` (exactly one fix) and `checkNotApplicable` (exactly zero fix). + /// Both error with multiple matching fixes! + type ChooseFix = CodeAction[] -> CodeAction[] + type ExpectedResult = + | NotApplicable + | Applicable + | After of string + + let checkFixAt + (doc: Document, diagnostics: Diagnostic[]) + (beforeWithoutCursor: string, cursorRange: Range) + (validateDiagnostics: Diagnostic[] -> unit) + (chooseFix: ChooseFix) + (expected: ExpectedResult) + = async { + // filter to only diags matching the cursor range + let diags = diagnostics |> diagnosticsIn cursorRange + validateDiagnostics diags + // get code fixes from server + let! res = doc |> Document.codeActionAt diags cursorRange + let allCodeActions = + match res, expected with + | None, (Applicable | After _) -> + // error here instead of later to return error noting it was `None` instead of empty CodeAction array + Expect.isSome res "No CodeAction returned (`None`)" + failwith "unreachable" + | None, NotApplicable -> + [||] + | Some res, _ -> + match res with + | TextDocumentCodeActionResult.Commands cs -> failtestf "Expected CodeActions, but got commands: %A" cs + | TextDocumentCodeActionResult.CodeActions cas -> cas + + // select code action to use + let codeActions = chooseFix allCodeActions + + let getCodeAction = + // validate codeAction (exactly one) + // split test into two to output all available code actions when no matching + function + | [||] -> failtestf "No matching CodeAction. Available code actions were: %A" allCodeActions + | _ -> + Expect.hasLength codeActions 1 "Should be exactly ONE applicable code action" + codeActions |> Array.head + + match expected with + | NotApplicable -> + // Expect.isEmpty codeActions "There should be no applicable code action" // doesn't show `actual` when not empty + if not (codeActions |> Array.isEmpty) then + failtestf "There should be no applicable code action, but was %A" codeActions + | Applicable -> + codeActions + |> getCodeAction + |> ignore + //ENHANCEMENT?: apply edits to check valid? + | After expected -> + let codeAction = codeActions |> getCodeAction + + /// Error message is appended by selected `codeAction` + let inline failCodeFixTest (msg: string) = + let msg = + if System.String.IsNullOrWhiteSpace msg || System.Char.IsPunctuation(msg, msg.Length-1) then + msg + else + msg + "." + failtest $"{msg} CodeAction was: %A{codeAction}" + + // only text edits supported + if codeAction.Command |> Option.isSome then + failCodeFixTest "Code action contains commands. Commands aren't supported in this test!" + + let edits = + codeAction.Edit + |> Option.defaultWith (fun _ -> failCodeFixTest "Code action doesn't contain any edits") + |> WorkspaceEdit.tryExtractTextEditsInSingleFile doc.VersionedTextDocumentIdentifier + |> Result.valueOr failCodeFixTest + + // apply fix + let actual = + beforeWithoutCursor + |> TextEdits.apply edits + |> Result.valueOr failCodeFixTest + + Expect.equal actual expected "Incorrect text after applying the chosen code action" + } + + let private checkFix + (server: CachedServer) + (beforeWithCursor: string) + (validateDiagnostics: Diagnostic[] -> unit) + (chooseFix: ChooseFix) + (expected: ExpectedResult) + = async { + let (range, text) = + beforeWithCursor + |> Text.trimTripleQuotation + |> Cursor.assertExtractRange + // load text file + let! (doc, diags) = server |> Server.createUntitledDocument text + use doc = doc // ensure doc gets closed (disposed) after test + + do! checkFixAt (doc, diags) (text, range) validateDiagnostics chooseFix expected + } + + /// Checks a CodeFix (CodeAction) for validity. + /// + /// * Extracts cursor position (`$0`) or range (between two `$0`) from `beforeWithCursor` + /// * Opens untitled Doc with source `beforeWithCursor` (with cursor removed) + /// * Note: untitled Document acts as Script file! + /// * Note: untitled Documents doesn't exist on disk! + /// * Waits for Diagnostics in that doc + /// * Filters Diags down to diags matching cursor position/range + /// * Then validates diags with `validateDiagnostics` + /// * Note: Validates filtered diags (-> only diags at cursor pos); not all diags in doc! + /// * Gets CodeFixes (CodeActions) from LSP server (`textDocument/codeAction`) for cursor range + /// * Request includes filtered diags + /// * Selects CodeFix from returned CodeFixes with `chooseFix` + /// * Note: `chooseFix` should return a single CodeFix. No CodeFix or multiple CodeFixes count as Failure! + /// * Use `checkNotApplicable` when there shouldn't be a CodeFix + /// * Note: Though `chooseFix` should return one CodeFix, the function actually returns an array of CodeFixes. + /// Reasons: + /// * Easier to filter down CodeFixes (`CodeFix.ofKind "..." >> CodeFix.withTitle "..."`) + /// * Better error messages: Can differentiate between no CodeFixes and too many CodeFixes + /// * Validates selected CodeFix: + /// * Applies selected CodeFix to source (`beforeWithCursor` with cursor removed) + /// * Compares result with `expected` + /// + /// Note: + /// `beforeWithCursor` as well as `expected` get trimmed with `Text.trimTripleQuotation`: Leading empty line and indentation gets removed. + /// + /// Note: + /// `beforeWithCursor` and `expected` MUST use `\n` for linebreaks -- using `\r` (either alone or as `\r\n`) results in test failure! + /// Linebreaks from edits in selected CodeFix are all transformed to just `\n` + /// -> CodeFix can use `\r` and `\r\n` + /// If you want to validate Line Endings of CodeFix, add a validation step to your `chooseFix` + let check + server + beforeWithCursor + validateDiagnostics + chooseFix + expected + = + checkFix + server + beforeWithCursor + validateDiagnostics + chooseFix + (After (expected |> Text.trimTripleQuotation)) + + /// Note: Doesn't apply Fix! Just checks its existence! + let checkApplicable + server + beforeWithCursor + validateDiagnostics + chooseFix + = + checkFix + server + beforeWithCursor + validateDiagnostics + chooseFix + Applicable + + let checkNotApplicable + server + beforeWithCursor + validateDiagnostics + chooseFix + = + checkFix + server + beforeWithCursor + validateDiagnostics + chooseFix + NotApplicable + + let matching cond (fixes: CodeAction array) = + fixes + |> Array.filter cond + let withTitle title = matching (fun f -> f.Title = title) + let ofKind kind = matching (fun f -> f.Kind = Some kind) + + /// Bundled tests in Expecto test + module private Test = + /// One `testCaseAsync` for each cursorRange. + /// All test cases use same document (`ServerTests.documentTestList`) with source `beforeWithoutCursor`. + /// + /// Test names: + /// * `name` is name of outer test list. + /// * Each test case: `Cursor {i} at {pos or range}` + /// + /// Note: Sharing a common `Document` is just barely faster than using a new `Document` for each test (at least for simple source in `beforeWithoutCursor`). + let checkFixAll + (name: string) + (server: CachedServer) + (beforeWithoutCursor: string) + (cursorRanges: Range seq) + (validateDiagnostics: Diagnostic[] -> unit) + (chooseFix: ChooseFix) + (expected: ExpectedResult) + = + Expect.isNonEmpty cursorRanges "No Range(s) specified" + ServerTests.documentTestList name server (Server.createUntitledDocument beforeWithoutCursor) (fun doc -> [ + for (i, range) in cursorRanges |> Seq.indexed do + let pos = + if range |> Range.isPosition then + range.Start.DebuggerDisplay + else + $"{range.Start.DebuggerDisplay}..{range.End.DebuggerDisplay}" + testCaseAsync $"Cursor {i} at {pos}" (async { + let! (doc, diags) = doc + do! checkFixAt (doc, diags) (beforeWithoutCursor, range) validateDiagnostics chooseFix expected + }) + ]) + + /// One test for each Cursor. + /// + /// Note: Tests single positions -> each `$0` gets checked. + /// -> Every test is for single-position range (`Start=End`)! + let checkAllPositions + (name: string) + (server: CachedServer) + (beforeWithCursors: string) + (validateDiagnostics: Diagnostic[] -> unit) + (chooseFix: ChooseFix) + (expected: ExpectedResult) + = + let (beforeWithoutCursor, poss) = beforeWithCursors |> Text.trimTripleQuotation |> Cursors.extract + let ranges = poss |> List.map (fun p -> { Start = p; End = p }) + checkFixAll name server beforeWithoutCursor ranges validateDiagnostics chooseFix expected + + let testAllPositions + name + server + beforeWithCursors + validateDiagnostics + chooseFix + expected + = + Test.checkAllPositions + name + server + beforeWithCursors + validateDiagnostics + chooseFix + (After (expected |> Text.trimTripleQuotation)) + let testApplicableAllPositions + name + server + beforeWithCursors + validateDiagnostics + chooseFix + = + Test.checkAllPositions + name + server + beforeWithCursors + validateDiagnostics + chooseFix + Applicable + let testNotApplicableAllPositions + name + server + beforeWithCursors + validateDiagnostics + chooseFix + = + Test.checkAllPositions + name + server + beforeWithCursors + validateDiagnostics + chooseFix + NotApplicable diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Server.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Server.Tests.fs new file mode 100644 index 000000000..5d13d0a21 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/Server.Tests.fs @@ -0,0 +1,666 @@ +module Utils.Tests.Server +open System +open Expecto +open Helpers +open FsAutoComplete +open FsAutoComplete.Lsp +open FsAutoComplete.LspHelpers +open Ionide.LanguageServerProtocol +open Ionide.LanguageServerProtocol.Types +open Utils.ServerTests +open Utils.Server +open Utils.Utils +open FsToolkit.ErrorHandling +open FSharpx.Control + +let tests state = testList (nameof(Server)) [ + testList "no root path" [ + testList "can get diagnostics" [ + let config = + { defaultConfigDto with + UnusedOpensAnalyzer = Some false + UnusedDeclarationsAnalyzer = Some false + SimplifyNameAnalyzer = Some false + } + serverTestList "no analyzers" state config None (fun server -> [ + testCaseAsync "can get nothing wrong" (async { + let! (doc, diags) = server |> Server.createUntitledDocument "" + use doc = doc + Expect.isEmpty diags "There should be no diagnostics" + + for i in 1..5 do + let! diags = doc |> Document.changeTextTo (string i) + Expect.isEmpty diags "There should be no diagnostics" + }) + testCaseAsync "can get single error" (async { + let! (doc, diags) = server |> Server.createUntitledDocument "let foo = notdefined" + use doc = doc + Expect.hasLength diags 1 "There should be 1 error" + Expect.exists diags (fun d -> d.Message.Contains "notdefined") "" + let! diags = doc |> Document.changeTextTo "let bar = doesnotexist" + Expect.hasLength diags 1 "There should be 1 error" + Expect.exists diags (fun d -> d.Message.Contains "doesnotexist") "" + let! diags = doc |> Document.changeTextTo "let baz = nope" + Expect.hasLength diags 1 "There should be 1 error" + Expect.exists diags (fun d -> d.Message.Contains "nope") "" + }) + testCaseAsync "can get multiple errors" (async { + let source = "let foo = {0}\nlet bar = {1}\nlet baz = {2}" + let names = [|"notdefined"; "doesnotexist"; "nope"|] + let fnames i = names |> Array.map (fun n -> sprintf "%s%i" n i) + let fsource i = String.Format(source, fnames i |> Seq.cast |> Seq.toArray) + + let! (doc, diags) = server |> Server.createUntitledDocument (fsource 0) + use doc = doc + Expect.hasLength diags (names.Length) "" + for name in fnames 0 do + Expect.exists diags (fun d -> d.Message.Contains name) "" + + for i in 1..2 do + let! diags = doc |> Document.changeTextTo (fsource i) + Expect.hasLength diags (names.Length) "" + for name in fnames i do + Expect.exists diags (fun d -> d.Message.Contains name) "" + }) + ]) + + let config = + { defaultConfigDto with + UnusedOpensAnalyzer = Some false + UnusedDeclarationsAnalyzer = Some true + SimplifyNameAnalyzer = Some false + } + serverTestList "just unused decl analyzer" state config None (fun server -> [ + testCaseAsync "can get nothing wrong" <| (async { + let! (doc, diags) = server |> Server.createUntitledDocument "" + use doc = doc + Expect.isEmpty diags "There should be no diagnostics" + + for i in 1..5 do + let! diags = doc |> Document.changeTextTo (string i) + Expect.isEmpty diags "There should be no diagnostics" + }) + testCaseAsync "can get diags for single line" (async { + let! (doc, diags) = server |> Server.createUntitledDocument "let foo = notdefined" + use doc = doc + Expect.hasLength diags 2 "" + Expect.exists diags (fun d -> d.Message.Contains "notdefined") "" + Expect.exists diags (fun d -> d.Message = "This value is unused") "" + let! diags = doc |> Document.changeTextTo "let bar = doesnotexist" + Expect.hasLength diags 2 "" + Expect.exists diags (fun d -> d.Message.Contains "doesnotexist") "" + Expect.exists diags (fun d -> d.Message = "This value is unused") "" + let! diags = doc |> Document.changeTextTo "let baz = nope" + Expect.hasLength diags 2 "" + Expect.exists diags (fun d -> d.Message.Contains "nope") "" + Expect.exists diags (fun d -> d.Message = "This value is unused") "" + }) + testCaseAsync "can get diags for multiple lines" (async { + let nVars = 3 + let values i = Array.init nVars (sprintf "someValue%i%i" i) + let source i = + values i + |> Seq.mapi (sprintf "let var%i = %s") + |> String.concat "\n" + + let! (doc, diags) = server |> Server.createUntitledDocument (source 0) + use doc = doc + Expect.hasLength diags (nVars * 2) "" + values 0 + |> Array.iteri (fun i name -> + Expect.exists diags (fun d -> d.Message.Contains name) $"No diags with name {name}" + Expect.exists diags (fun d -> d.Message = "This value is unused" && d.Range.Start.Line = i) $"No unused value error in line {i}" + ) + + for i in 1..2 do + let! diags = doc |> Document.changeTextTo (source i) + Expect.hasLength diags (nVars * 2) "" + values i + |> Array.iteri (fun i name -> + Expect.exists diags (fun d -> d.Message.Contains name) $"No diags with name {name}" + Expect.exists diags (fun d -> d.Message = "This value is unused" && d.Range.Start.Line = i) $"No unused value error in line {i}" + ) + }) + ]) + + let config = + { defaultConfigDto with + UnusedOpensAnalyzer = Some true + UnusedDeclarationsAnalyzer = Some true + SimplifyNameAnalyzer = Some true + } + serverTestList "three analyzers" state config None (fun server -> [ + testCaseAsync "can get nothing wrong" (async { + let! (doc, diags) = server |> Server.createUntitledDocument "" + use doc = doc + Expect.isEmpty diags "There should be no diagnostics" + + for i in 1..5 do + let! diags = doc |> Document.changeTextTo (string i) + Expect.isEmpty diags "There should be no diagnostics" + }) + testCaseAsync "can get all diags" (async { + let source = "open System\nlet foo = bar\nSystem.String.Empty |> ignore" + let! (doc, diags) = server |> Server.createUntitledDocument source + use doc = doc + + Expect.hasLength diags 4 "" + Expect.exists diags (fun d -> d.Message = "Unused open statement" && d.Range.Start.Line = 0) "" + Expect.exists diags (fun d -> d.Message = "This value is unused" && d.Range.Start.Line = 1) "" + Expect.exists diags (fun d -> d.Message.Contains "bar" && d.Range.Start.Line = 1) "" + Expect.exists diags (fun d -> d.Message = "This qualifier is redundant" && d.Range.Start.Line = 2) "" + + + let source = "open System.Collections\nlet baz = foo\nSystem.Collections.Generic.List() |> ignore" + let! diags = doc |> Document.changeTextTo source + + Expect.hasLength diags 4 "" + Expect.exists diags (fun d -> d.Message = "Unused open statement" && d.Range.Start.Line = 0) "" + Expect.exists diags (fun d -> d.Message = "This value is unused" && d.Range.Start.Line = 1) "" + Expect.exists diags (fun d -> d.Message.Contains "foo" && d.Range.Start.Line = 1) "" + Expect.exists diags (fun d -> d.Message = "This qualifier is redundant" && d.Range.Start.Line = 2) "" + + + let source = "open System.Diagnostics\nlet bar = baz\nSystem.Diagnostics.Debugger.IsAttached" + let! diags = doc |> Document.changeTextTo source + + Expect.hasLength diags 4 "" + Expect.exists diags (fun d -> d.Message = "Unused open statement" && d.Range.Start.Line = 0) "" + Expect.exists diags (fun d -> d.Message = "This value is unused" && d.Range.Start.Line = 1) "" + Expect.exists diags (fun d -> d.Message.Contains "baz" && d.Range.Start.Line = 1) "" + Expect.exists diags (fun d -> d.Message = "This qualifier is redundant" && d.Range.Start.Line = 2) "" + }) + ]) + ] + + testList "untitled document" [ + serverTestList "untitled counter in server for createUntitledDocument" state defaultConfigDto None (fun server -> [ + testCaseAsync "creating document increases untitled counter" (async { + let! actualServer = server + let preCounter = actualServer.UntitledCounter + let! (doc, _) = server |> Server.createUntitledDocument "" + use doc = doc + let postCounter = actualServer.UntitledCounter + + Expect.isGreaterThan postCounter preCounter "Untitled Counter should increase" + }) + testCaseAsync "creating multiple documents increases untitled counter" (async { + let getCounter server = server |> Async.map (fun s -> s.UntitledCounter) + + let! preCounter = getCounter server + let mutable preCounter = preCounter + for i in 1..5 do + let! (doc, _) = server |> Server.createUntitledDocument "" + use doc = doc + let! postCounter = getCounter server + Expect.isGreaterThan postCounter preCounter "Untitled Counter should increase" + preCounter <- postCounter + }) + ]) + + serverTestList "document version" state defaultConfigDto None (fun server -> [ + testCaseAsync "changing document text increases document version" (async { + let! (doc, _) = server |> Server.createUntitledDocument "" + let preVersion = doc.Version + let! _ = doc |> Document.changeTextTo "42" + let postVersion = doc.Version + + Expect.isGreaterThan postVersion preVersion "Document Version should increase" + }) + testCaseAsync "changing document text multiple times should always increase document version" (async { + let! (doc, _) = server |> Server.createUntitledDocument "" + let mutable preVersion = doc.Version + for _ in 1..5 do + let! _ = doc |> Document.changeTextTo "" + let postVersion = doc.Version + Expect.isGreaterThan postVersion preVersion "Document Version should increase" + preVersion <- postVersion + }) + ]) + ] + ] + + testList "with root path" [ + let inTestCases name = + System.IO.Path.Combine(__SOURCE_DIRECTORY__, "..", "TestCases", "ServerTests", name) + |> Some + + let noAnalyzersConfig = + { defaultConfigDto with + UnusedOpensAnalyzer = Some false + UnusedDeclarationsAnalyzer = Some false + SimplifyNameAnalyzer = Some false + } + let allAnalyzersConfig = + { defaultConfigDto with + UnusedOpensAnalyzer = Some true + UnusedDeclarationsAnalyzer = Some true + SimplifyNameAnalyzer = Some true + } + serverTestList "dir with just a script and no analyzers" state noAnalyzersConfig (inTestCases "JustScript") (fun server -> [ + testCaseAsync "can load script file" (async { + let! (doc, diags) = server |> Server.openDocument "Script.fsx" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'bar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 0 "Error should be in line 1" + }) + testCaseAsync "can load script file again" (async { + let! (doc, diags) = server |> Server.openDocument "Script.fsx" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'bar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 0 "Error should be in line 1" + }) + ]) + serverTestList "dir with just a script and all anaylzers" state allAnalyzersConfig (inTestCases "JustScript") (fun server -> [ + testCaseAsync "can load script file" (async { + let! (doc, diags) = server |> Server.openDocument "Script.fsx" + use doc = doc + + Expect.exists diags (fun diag -> diag.Message.Contains "The value or constructor 'bar' is not defined." && diag.Range.Start.Line = 0) "Should be not defined error" + Expect.exists diags (fun diag -> diag.Message.Contains "This value is unused" && diag.Range.Start.Line = 0) "Should be unused value" + }) + testCaseAsync "can load script file again" (async { + let! (doc, diags) = server |> Server.openDocument "Script.fsx" + use doc = doc + + Expect.exists diags (fun diag -> diag.Message.Contains "The value or constructor 'bar' is not defined." && diag.Range.Start.Line = 0) "Should be not defined error" + Expect.exists diags (fun diag -> diag.Message.Contains "This value is unused" && diag.Range.Start.Line = 0) "Should be unused value" + }) + ]) + serverTestList "dir with project and no analyzers" state noAnalyzersConfig (inTestCases "Project") (fun server -> [ + testCaseAsync "can load file in project" (async { + let! (doc, diags) = server |> Server.openDocument "Other.fs" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'otherBar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 5 "Error should be in line 6" + }) + testCaseAsync "can load file in project again" (async { + let! (doc, diags) = server |> Server.openDocument "Other.fs" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'otherBar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 5 "Error should be in line 6" + }) + testCaseAsync "can load other file in project" (async { + let! (doc, diags) = server |> Server.openDocument "Program.fs" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'programBar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 4 "Error should be in line 5" + }) + ]) + serverTestList "dir with project and all analyzers" state allAnalyzersConfig (inTestCases "Project") (fun server -> [ + testCaseAsync "can load file in project" (async { + let! (doc, diags) = server |> Server.openDocument "Other.fs" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'otherBar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 5 "Error should be in line 6" + }) + testCaseAsync "can load file in project again" (async { + let! (doc, diags) = server |> Server.openDocument "Other.fs" + use doc = doc + + Expect.hasLength diags 1 "Should be one diagnostics" + let diag = diags |> Array.head + Expect.stringContains diag.Message "The value or constructor 'otherBar' is not defined." "Should be not defined error" + Expect.equal diag.Range.Start.Line 5 "Error should be in line 6" + }) + testCaseAsync "can load other file in project" (async { + let! (doc, diags) = server |> Server.openDocument "Program.fs" + use doc = doc + + Expect.exists diags (fun diag -> diag.Message.Contains "The value or constructor 'programBar' is not defined." && diag.Range.Start.Line = 4) "Should be not defined error" + // `argv` + Expect.exists diags (fun diag -> diag.Message.Contains "This value is unused" && diag.Range.Start.Line = 11) "Should be unused value" + Expect.exists diags (fun diag -> diag.Message.Contains "Unused open statement" && diag.Range.Start.Line = 2) "Should be unused open" + }) + ]) + + ] + + testList "Waiting for diagnostics" [ + let allAnalyzersConfig = + { defaultConfigDto with + UnusedOpensAnalyzer = Some true + UnusedDeclarationsAnalyzer = Some true + SimplifyNameAnalyzer = Some true + } + serverTestList "waitForLatestDiagnostics" state allAnalyzersConfig None (fun server -> [ + // `Document.waitForLatestDiagnostics` is crucial for success of tests: Must wait for newest, current Diagnostics, but ignore diags from previous parses. + // Issues: + // * must ignore old events + // * multiple `publishDiagnostics` for each parse + + // Test in here: a script with a lot of Analyzer Diagnostics: + // Analyzers are checked after F# Compiler Checking is done (-> already one `publishDiagnostics`) + // After analyzers `documentAnalyzed` gets sent. But might arrive before analyzer diags. + + let genSource nCompilerErrorsPerRepeat nUnusedOpensPerRepeat nUnusedDeclsPerRepeat nSimplifyNamesPerRepeat repeats identifier = + // generate source with lots of Analyzer Diagnostics (and F# compiler errors) + // identifier to force some textual changes + let nss = [| + "System" + "System.Diagnostics" + "System.Text" + "System.Text.RegularExpressions" + "System.Threading" + "System.Runtime" + "FSharp.Control" + "FSharp.Linq" + "FSharp.Quotations" + "FSharp.Reflection" + |] + let tys = [| + "System.String" + "System.Index" + "System.Int32" + "System.Random" + "System.Guid" + "System.Text.RegularExpressions.Regex" + "System.Text.RegularExpressions.Match" + "System.Text.StringBuilder" + "System.Diagnostics.TraceLevel" + "System.Diagnostics.Stopwatch" + |] + + let lines = [ + $"// {identifier}" + for i in 1..repeats do + $"// Rep {i}" + for j in 1..nUnusedOpensPerRepeat do + let o = Array.get nss ((j-1) % nss.Length) + $"open {o}" + + for j in 1..nUnusedDeclsPerRepeat do + $"let {identifier}Rep{i}Val{j} = 0" + + // note: requires at least 4 UnusedOpens (to `open ...` required for Simplify Name) + for j in 1..nSimplifyNamesPerRepeat do + let ty = Array.get tys ((j-1) % tys.Length ) + $"let {identifier}Rep{i}F{j} (v: {ty}) = v" + + // `let _identifier = value`: + // * value not defined + // * no unused warning because `_` + for j in 1..nCompilerErrorsPerRepeat do + $"let _{identifier}ErrorRep{i}Val{j} = valueRep{i}Val{j}" + + "" + ] + + String.concat "\n" lines + + testCaseAsync "lots of diagnostics for all analyzers" (async { + // count for each: n * repeats + let nCompilerErrorsPerRepeat = 3 + let nUnusedOpensPerRepeat = 7 + let nUnusedDeclsPerRepeat = 5 + let nSimplifyNamesPerRepeat = 9 + let calcExpected repeats = + {| + UnusedOpens = nUnusedOpensPerRepeat * repeats + UnusedDecls = nUnusedDeclsPerRepeat * repeats + SimplifyNames = nSimplifyNamesPerRepeat * repeats + CompilerErrors = nCompilerErrorsPerRepeat * repeats + |} + + let repeats = 2 + let source = genSource nCompilerErrorsPerRepeat nUnusedOpensPerRepeat nUnusedDeclsPerRepeat nSimplifyNamesPerRepeat repeats "init" + let! (doc, diags) = server |> Server.createUntitledDocument source + use doc = doc + + let checkDiags repeats loop diags = + let expected = calcExpected repeats + let groups = + diags + |> Array.map (fun d -> + // simplify `The value or constructor 'value' is not defined.` error (contains names and recommendations) + if d.Code = Some "39" then + "The value or constructor is not defined" + else + d.Message + ) + |> Array.countBy id + |> Map.ofArray + let actual = {| + UnusedOpens = groups.["Unused open statement"] + UnusedDecls = groups.["This value is unused"] + SimplifyNames = groups.["This qualifier is redundant"] + CompilerErrors = groups.["The value or constructor is not defined"] + |} + + // exact count isn't actually that important because each analyzers sends all its diags together. + // important part is just: has arrived -> `waitForLatestDiagnostics` waited long enough for all diags + Expect.equal actual expected $"Incorrect dags in loop {loop}" + + checkDiags repeats 0 diags + + for i in 1..5 do + let repeats = repeats + i // to get different numbers of diagnostics + let source = genSource nCompilerErrorsPerRepeat nUnusedOpensPerRepeat nUnusedDeclsPerRepeat nSimplifyNamesPerRepeat repeats $"loop{i}" + let! diags = doc |> Document.changeTextTo source + checkDiags repeats i diags + }) + + testCaseAsync "diagnostics for some analyzers" (async { + let checkDiags (unusedOpen, unusedValue, simplifyName) diags = + let actual = {| + UnusedOpen = diags |> Array.exists (fun d -> d.Message = "Unused open statement") + UnusedDecl = diags |> Array.exists (fun d -> d.Message = "This value is unused") + SimplifyName = diags |> Array.exists (fun d -> d.Message = "This qualifier is redundant") + |} + let expected = {| + UnusedOpen = unusedOpen + UnusedDecl = unusedValue + SimplifyName = simplifyName + |} + + Expect.equal actual expected "Should contain correct diagnostics" + + let source = Text.trimTripleQuotation """ +open System +open System.Diagnostics +open System.Text + +let x = 1 +let y = 2 +let z = 3 + """ + let! (doc, diags) = server |> Server.createUntitledDocument source + use doc = doc + checkDiags (true, true, false) diags + + let source = Text.trimTripleQuotation """ +let x = 1 +let y = 2 +let z = 3 + """ + let! diags = doc |> Document.changeTextTo source + checkDiags (false, true, false) diags + + let source = Text.trimTripleQuotation """ +open System +open System.Diagnostics +open System.Text + +() + """ + let! diags = doc |> Document.changeTextTo source + checkDiags (true, false, false) diags + + let source = Text.trimTripleQuotation """ +open System +open System.Diagnostics +open System.Text + +let f (v: System.String) = v + """ + let! diags = doc |> Document.changeTextTo source + checkDiags (true, false, true) diags + + let source = Text.trimTripleQuotation """ +open System +open System.Diagnostics +open System.Text + +let f (v: System.String) = () + + """ + let! diags = doc |> Document.changeTextTo source + checkDiags (true, true, true) diags + + let source = "()" + let! diags = doc |> Document.changeTextTo source + checkDiags (false, false, false) diags + }) + ]) + ] + + testList "timing" [ + let allAnalyzersConfig = + { defaultConfigDto with + UnusedOpensAnalyzer = Some true + UnusedDeclarationsAnalyzer = Some true + SimplifyNameAnalyzer = Some true + } + let mkSource (msg: string) = Text.trimTripleQuotation $""" +open System + +// {msg} +let foo = "bar" +let bar = 42 +let (x,y,z) = (1,2,3) // {msg} + +let f1 (v: string) = sprintf "Hello %%s" v +let f2 v = sprintf "Hello %%s" // {msg} + +f1 foo +// {msg} +f2 "bar" |> ignore + """ + serverTestList "server" state allAnalyzersConfig None (fun server -> [ + testList "single parse" [ + testCaseAsync "single parse" <| async { + let! (doc, _) = server |> Server.createUntitledDocument (mkSource "single parse") + use doc = doc + () + } + ] + testList "parse of same document" [ + testCaseAsync "single doc" <| async { + let! (doc, _) = server |> Server.createUntitledDocument (mkSource "0 parse") + use doc = doc + + for i in 1..5 do + let! _ = doc |> Document.changeTextTo (mkSource $"Parse {i}") + () + () + } + ] + testList "parse in different documents" [ + for i in 0..5 do + testCaseAsync $"doc {i}" <| async { + let! (doc, _) = server |> Server.createUntitledDocument (mkSource "parse {i}") + use doc = doc + () + } + ] + ]) + ] + + testList "Document" [ + serverTestList "no root path without analyzers" state defaultConfigDto None (fun server -> [ + testCaseAsync "can create Document by absolute path without root path" <| async { + let relativePath = "../TestCases/ServerTests/JustScript/Script.fsx" + let absolutePath = System.IO.Path.GetFullPath(System.IO.Path.Combine(__SOURCE_DIRECTORY__, relativePath)) + let! (doc, _) = server |> Server.openDocument absolutePath + use doc = doc + () + } + + let mutable docState = {| Uri = ""; Version = -1; CallCounter = 0 |} + let getDoc server = async { + let text = Text.trimTripleQuotation """ + let bar = "hello world" + let foo = System.String. + """ + let! (doc, diags) = server |> Server.createUntitledDocument text + docState <- {| + Uri = doc.Uri + Version = doc.Version + // tracks how often `getDoc` was called + CallCounter = docState.CallCounter + 1 + |} + return (doc, diags) + } + documentTestList "multiple actions on single document" server getDoc (fun doc -> [ + testCaseAsync "doc is doc returned from getDocument" <| async { + let! (doc,_) = doc + Expect.equal (doc.Uri, doc.Version) (docState.Uri, docState.Version) "Should be same doc" + Expect.equal docState.CallCounter 1 "getDocument should only be called once" + } + testCaseAsync "doc stays same" <| async { + let! (doc,_) = doc + Expect.equal (doc.Uri, doc.Version) (docState.Uri, docState.Version) "Should be same doc" + Expect.equal docState.CallCounter 1 "getDocument should only be called once" + } + let completionAt pos (doc: Document) = async { + let ps: CompletionParams = { + TextDocument = doc.TextDocumentIdentifier + Position = pos + Context = None + } + let! res = doc.Server.Server.TextDocumentCompletion ps + Expect.isOk res "Should be ok result" + return res |> Result.defaultWith (fun _ -> failtest "unreachable") + } + testCaseAsync "can get completions" <| async { + let! (doc,_) = doc + let! completions = doc |> completionAt { Line = 1; Character = 24 } + Expect.isSome completions "Should be some completions" + let completions = completions.Value + Expect.isNonEmpty completions.Items "Should be completions" + Expect.exists completions.Items (fun i -> i.Label = "IsNullOrWhiteSpace") "Should have `IsNullOrWhiteSpace` completion" + } + testCaseAsync "can get completions again" <| async { + let! (doc,_) = doc + let! completions = doc |> completionAt { Line = 1; Character = 24 } + Expect.isSome completions "Should be some completions" + let completions = completions.Value + Expect.isNonEmpty completions.Items "Should be completions" + Expect.exists completions.Items (fun i -> i.Label = "IsNullOrWhiteSpace") "Should have `IsNullOrWhiteSpace` completion" + } + testCaseAsync "can get signature help" <| async { + let! (doc,_) = doc + let ps: TextDocumentPositionParams = { + TextDocument = doc.TextDocumentIdentifier + Position = { Line = 0; Character = 6 } + } + let! res = doc.Server.Server.TextDocumentHover ps + Expect.isOk res "Should have hover data" + } + testCaseAsync "doc is still same" <| async { + let! (doc,_) = doc + Expect.equal (doc.Uri, doc.Version) (docState.Uri, docState.Version) "Should be same doc" + Expect.equal docState.CallCounter 1 "getDocument should only be called once" + } + ]) + ]) + ] +] diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs new file mode 100644 index 000000000..62e635ef8 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs @@ -0,0 +1,309 @@ +module rec Utils.Server +open System +open System.IO +open FsAutoComplete.Lsp +open FsAutoComplete +open FsToolkit.ErrorHandling +open Helpers +open Ionide.LanguageServerProtocol.Types +open Ionide.LanguageServerProtocol +open FsAutoComplete.LspHelpers +open FSharp.Control.Reactive +open FSharpx.Control +open Expecto +open Utils +open Ionide.ProjInfo.Logging + +let private logger = LogProvider.getLoggerByName "Utils.Server" + +type Server = { + RootPath: string option + Server: FSharpLspServer + Events: ClientEvents + mutable UntitledCounter: int +} +/// `Server` cached with `Async.Cache` +type CachedServer = Async +type Document = + { + Server: Server + Uri: DocumentUri + mutable Version: int + } + member doc.TextDocumentIdentifier = + { Uri = doc.Uri } + member doc.VersionedTextDocumentIdentifier = + { Uri = doc.Uri; Version = Some doc.Version } + + interface IDisposable with + override doc.Dispose(): unit = + doc + |> Document.close + |> Async.RunSynchronously + + +module Server = + let private initialize path (config: FSharpConfigDto) state = async { + logger.trace ( + Log.setMessage "Initialize Server in {path}" + >> Log.addContextDestructured "path" path + ) + + match path with + | None -> () + | Some path -> + dotnetCleanup path + if + System.IO.Directory.EnumerateFiles(path, "*.fsproj") + |> Seq.isEmpty + |> not + then + do! dotnetRestore path + + let (server, events) = createServer state + events + |> Observable.add logEvent + + let p: InitializeParams = { + ProcessId = Some 1 + RootPath = path + RootUri = path |> Option.map (sprintf "file://%s") + InitializationOptions = Some (Server.serialize config) + Capabilities = Some clientCaps + trace = None + } + match! server.Initialize p with + | Ok _ -> + return { + RootPath = path + Server = server + Events = events + UntitledCounter = 0 + } + | Result.Error error -> + return failwith $"Initialization failed: %A{error}" + } + + let create path config state : CachedServer = + async { + let! server = initialize path config state + + if path |> Option.isSome then + do! waitForWorkspaceFinishedParsing server.Events + + return server + } + |> Async.Cache + + let shutdown (server: CachedServer) = async { + let! server = server + do! server.Server.Shutdown () + } + + let private createDocument uri server = { + Server = server + Uri = uri + Version = 0 + } + + let private untitledDocUrif = sprintf "untitled:Untitled-%i" + /// Note: mutates passed `server`: increments `server.UntitledCounter` + let private nextUntitledDocUri (server: Server) = + let next = System.Threading.Interlocked.Increment(&server.UntitledCounter) + untitledDocUrif (next-1) + + let createUntitledDocument initialText (server: CachedServer) = async { + let! server = server + + let doc = server |> createDocument (server |> nextUntitledDocUri) + let! diags = doc |> Document.openWith initialText + + return (doc, diags) + } + + /// `path` can be absolute or relative. + /// For relative path `server.RootPath` must be specified! + /// + /// Note: When `path` is relative: relative to `server.RootPath`! + let openDocument (path: string) (server: CachedServer) = async { + let! server = server + // two possibilities: + // * relative path -> relative to `server.RootPath` (-> failure when no `RootPath`) + // * absolute path + let fullPath = + if Path.IsPathRooted path then + path + else + Expect.isSome server.RootPath "relative path is only possible when `server.RootPath` is specified!" + Path.Combine(server.RootPath.Value, path) + let doc = + server + |> createDocument ( + fullPath + // normalize path is necessary: otherwise might be different lower/upper cases in uri for tests and LSP server: + // on windows `E:\...`: `file:///E%3A/...` (before normalize) vs. `file:///e%3A/..` (after normalize) + |> normalizePath + |> Path.LocalPathToUri + ) + let! diags = doc |> Document.openWith (File.ReadAllText fullPath) + + return (doc, diags) + } + + /// Like `Server.openDocument`, but instead of reading source text from `path`, + /// this here instead uses `initialText` (which can be different from content of `path`!). + /// + /// This way an existing file with different text can be faked. + /// Logically equal to `Server.openDocument`, and later changing its text via `Document.changeTextTo`. + /// But this here doesn't have to parse and check everything twice (once for open, once for changed) + /// and is WAY faster than `Server.openDocument` followed by `Document.changeTextTo` when involving multiple documents. + /// (For example with CodeFix tests using `fsi` file and corresponding `fs` file) + let openDocumentWithText path (initialText: string) (server: CachedServer) = async { + let! server = server + assert(server.RootPath |> Option.isSome) + + let fullPath = Path.Combine(server.RootPath.Value, path) + let doc = server |> createDocument (Path.FilePathToUri fullPath) + let! diags = doc |> Document.openWith initialText + + return (doc, diags) + } + +module Document = + let private typedEvents<'t> typ : _ -> System.IObservable<'t> = + Observable.choose (fun (typ', _o) -> if typ' = typ then Some (unbox _o) else None) + + /// `textDocument/publishDiagnostics` + /// + /// Note: for each analyzing round there are might be multiple `publishDiagnostics` events (F# compiler, for each built-in Analyzer, for Custom Analyzers) + /// + /// Note: Because source `doc.Server.Events` is `ReplaySubject`, subscribing to Stream returns ALL past diagnostics too! + let diagnosticsStream (doc: Document) = + doc.Server.Events + |> typedEvents "textDocument/publishDiagnostics" + |> Observable.choose (fun n -> if n.Uri = doc.Uri then Some n.Diagnostics else None) + /// `fsharp/documentAnalyzed` + let analyzedStream (doc: Document) = + doc.Server.Events + |> typedEvents "fsharp/documentAnalyzed" + |> Observable.filter (fun n -> n.TextDocument.Uri = doc.Uri) + + /// Waits (if necessary) and gets latest diagnostics. + /// + /// To detect newest diags: + /// * Waits for `fsharp/documentAnalyzed` for passed `doc` and its `doc.Version`. + /// * Then waits a but more for potential late diags. + /// * Then returns latest diagnostics. + /// + /// + /// ### Explanation: Get latest & correct diagnostics + /// Diagnostics aren't collected and then sent once, but instead sent after each parsing/analyzing step. + /// -> There are multiple `textDocument/publishDiagnostics` sent for each parsing/analyzing round: + /// * one when file parsed by F# compiler + /// * one for each built-in (enabled) Analyzers (in `src\FsAutoComplete\FsAutoComplete.Lsp.fs` > `FsAutoComplete.Lsp.FSharpLspServer.analyzeFile`), + /// * for linter (currently disabled) + /// * for custom analyzers + /// + /// -> To receive ALL diagnostics: use Diagnostics of last `textDocument/publishDiagnostics` event. + /// + /// Issue: What is the last `publishDiagnostics`? Might already be here or arrive in future. + /// -> `fsharp/documentAnalyzed` was introduced. Notification when a doc was completely analyzed + /// -> wait for `documentAnalyzed` + /// + /// But issue: last `publishDiagnostics` might be received AFTER `documentAnalyzed` (because of async notifications & sending) + /// -> after receiving `documentAnalyzed` wait a bit for late `publishDiagnostics` + /// + /// But issue: Wait for how long? Too long: extends test execution time. Too short: Might miss diags. + /// -> unresolved. Current wait based on testing on modern_ish PC. Seems to work on CI too. + /// + /// + /// *Inconvenience*: Only newest diags can be retrieved this way. Diags for older file versions cannot be extracted reliably: + /// `doc.Server.Events` is a `ReplaySubject` -> returns ALL previous events on new subscription + /// -> All past `documentAnalyzed` events and their diags are all received at once + /// -> waiting a bit after a version-specific `documentAnalyzed` always returns latest diags. + //ENHANCEMENT: Send `publishDiagnostics` with Doc Version (LSP `3.15.0`) -> can correlate `documentAnalyzed` and `publishDiagnostics` + let waitForLatestDiagnostics timeout (doc: Document) : Async = async { + logger.trace ( + Log.setMessage "Waiting for diags for {uri} at version {version}" + >> Log.addContext "uri" doc.Uri + >> Log.addContext "version" doc.Version + ) + + return! + doc + |> diagnosticsStream + |> Observable.takeUntilOther ( + doc + // `fsharp/documentAnalyzed` signals all checks & analyzers done + |> analyzedStream + |> Observable.filter (fun n -> n.TextDocument.Version = Some doc.Version) + // wait for late diagnostics + |> Observable.delay 5 + ) + |> Observable.last + |> Observable.timeoutSpan timeout + |> Async.AwaitObservable + } + let private defaultTimeout = TimeSpan.FromSeconds 5.0 + + /// Note: Mutates passed `doc` + let private incrVersion (doc: Document) = + System.Threading.Interlocked.Increment(&doc.Version) + /// Note: Mutates passed `doc` + let private incrVersionedTextDocumentIdentifier (doc: Document) = + { Uri = doc.Uri; Version = Some (doc |> incrVersion) } + + + let openWith initialText (doc: Document) = async { + let p: DidOpenTextDocumentParams = { + TextDocument = { + Uri = doc.Uri + LanguageId = "fsharp" + Version = doc.Version + Text = initialText + } + } + do! doc.Server.Server.TextDocumentDidOpen p + return! + doc + |> waitForLatestDiagnostics defaultTimeout + } + + let close (doc: Document) = async { + let p: DidCloseTextDocumentParams = { + TextDocument = doc.TextDocumentIdentifier + } + do! doc.Server.Server.TextDocumentDidClose p + } + + let changeTextTo (text: string) (doc: Document) = async { + let p: DidChangeTextDocumentParams = { + TextDocument = doc |> incrVersionedTextDocumentIdentifier + ContentChanges = [| + { + Range = None + RangeLength = None + Text = text + } + |] + } + do! doc.Server.Server.TextDocumentDidChange p + return! + doc + |> waitForLatestDiagnostics defaultTimeout + } + + let private assertOk result = + Expect.isOk result "Expected success" + result |> Result.defaultWith (fun _ -> failtest "not reachable") + + /// Note: diagnostics aren't filtered to match passed range in here + let codeActionAt (diagnostics: Diagnostic[]) (range: Range) (doc: Document) = async { + let ps: CodeActionParams = { + TextDocument = doc.TextDocumentIdentifier + Range = range + Context = { Diagnostics = diagnostics } + } + let! res = doc.Server.Server.TextDocumentCodeAction ps + return res |> assertOk + } diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/ServerTests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/ServerTests.fs new file mode 100644 index 000000000..e97b3f9ca --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/ServerTests.fs @@ -0,0 +1,118 @@ +module Utils.ServerTests + +open FsAutoComplete.Utils +open Helpers +open Utils.Server +open Expecto +open Ionide.LanguageServerProtocol.Types + +/// TestList which creates (in `initialize`) and caches (if `cacheValue`) a value, and runs cleanup after all tests were run (in `cleanup`) +/// +/// Note: TestCase for `cleanup` is called `cleanup` +/// +/// Note: no value is created when there are no `tests`, and neither gets `cleanup` executed +/// +/// Note: Result of `initialize` is only cached when `cacheValue` is `true`. But `cleanup` is called regardless. +/// Use `false` when `initialize` returns an already cached value, otherwise `false`. +/// Then in here `Async.Cache` is used to cache value. +let cleanableTestList + runner + (name: string) + (initialize: Async<'a>) + (cacheValue: bool) + (cleanup: Async<'a> -> Async) + (tests: Async<'a> -> Test list) + = + let value = + if cacheValue then + initialize |> Async.Cache + else + initialize + let tests = tests value + + testSequenced <| runner name [ + yield! tests + + if not (tests |> List.isEmpty) then + testCaseAsync "cleanup" (cleanup value) + ] + +let private serverTestList' + runner + name + state + config + path + tests + = + // path must be "absolutely normalized". `..` (parent) isn't valid -> Uri in FSAC and uri in doc are otherwise different, which leads to infinte waiting or timeouts. + let path = path |> Option.map (System.IO.Path.GetFullPath) + + let init = Server.create path config state + let cleanup = Server.shutdown + + cleanableTestList + runner + name + init + false + cleanup + tests + +/// ## Example +/// ```fsharp +/// let tests state = serverTestList "Simple Test" state defaultConfigDto None (fun server -> [ +/// testCaseAsync "can get diagnostics" <| async { +/// let! (doc, diags) = server |> Server.createUntitledDocument "let foo = bar" +/// use doc = doc // ensure doc gets closed (disposed) after test +/// +/// Expect.exists diags (fun d -> d.Message = "The value or constructor 'bar' is not defined.") "Should have `bar not defined` error" +/// } +/// ]) +/// ``` +let serverTestList = serverTestList' testList +let fserverTestList = serverTestList' ftestList +let pserverTestList = serverTestList' ptestList + +let private documentTestList' + runner + name + (server: CachedServer) + (getDocument: CachedServer -> Async) + tests + = + let doc = + server + |> getDocument + |> Async.Cache + let init = doc + let cleanup = Async.map fst >> Async.bind Document.close + + cleanableTestList + runner + name + init + false + cleanup + tests + +/// Note: Not intended for changing document: always same (initial) diags +/// +/// ## Example +/// ```fsharp +/// let tests state = serverTestList "Simple Server Test" state defaultConfigDto None (fun server -> [ +/// let initialText = "let foo = bar" +/// let getDoc = Server.createUntitledDocument initialText +/// documentTestList "Simple Doc Test" server getDoc (fun doc -> [ +/// testCaseAsync "doc has correct diagnostics" <| async { +/// let! (doc, diags) = doc +/// // Note: don't `use doc = doc` here (vs. in single case -> see `Example` in `documentTestList`): +/// // `doc` should stay open and should not be closed/disposed! +/// Expect.exists diags (fun d -> d.Message = "The value or constructor 'bar' is not defined.") "Should have `bar not defined` error" +/// } +/// ]) +/// ]) +/// ``` +let documentTestList = documentTestList' testList +let fdocumentTestList = documentTestList' ftestList +let pdocumentTestList = documentTestList' ptestList diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs new file mode 100644 index 000000000..bf71ba69a --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs @@ -0,0 +1,2306 @@ +module Utils.Tests.TextEdit +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open FsToolkit.ErrorHandling +open Ionide.LanguageServerProtocol.Types +open Utils.TextEdit +open Utils.Utils + +let private logger = Expecto.Logging.Log.create (sprintf "%s.%s" (nameof Utils.Tests) (nameof Utils.TextEdit)) +let inline private pos line column: Position = { Line = line; Character = column } +let inline private (!-) text = Text.trimTripleQuotation text + +module private Cursor = + open Expecto.Flip + + let private tryExtractIndexTests = testList (nameof Cursor.tryExtractIndex) [ + testList "no cursor" [ + let assertNoCursor = + Cursor.tryExtractPosition + >> Expect.isNone "should have found no cursor" + testCase "empty string" <| fun _ -> + let text = "" + assertNoCursor text + testCase "single line" <| fun _ -> + let text = "Foo Bar Baz" + assertNoCursor text + testCase "two lines" <| fun _ -> + let text = "Foo Bar Baz\nLorem ipsum dolor sit" + assertNoCursor text + testCase "multiple lines" <| fun _ -> + let text = "Foo\nBar\nBaz\nLorem\nimpsum\ndolor\nsit" + assertNoCursor text + testCase "just spaces" <| fun _ -> + let text = " " + assertNoCursor text + testCase "just spaces and new lines" <| fun _ -> + let text = " \n \n\n \n\n\n\n \n \n \n" + assertNoCursor text + testCase "triple quoted string without processing" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + assertNoCursor text + testCase "triple quoted string with processing (starting new line, no indentation)" <| fun _ -> + let text = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + assertNoCursor text + testCase "triple quoted string with processing (starting new line, indentation)" <| fun _ -> + let text = !- """ + module Foo + + let a = 42 + let b = + a + 5 + printfn "Result=%i" b + """ + assertNoCursor text + ] + testList "with cursor" [ + let assertAndGetIndex = + Text.trimTripleQuotation + >> Cursor.tryExtractIndex + >> Option.defaultWith (fun _ -> failtest "No cursor found") + let assertResultIs (idx: int, text: string) = + assertAndGetIndex + >> Expect.equal "should be correct cursor position and text" (idx, text) + let assertCursorAt (idx: int) = + assertAndGetIndex + >> fst + >> Expect.equal "should have found cursor at correct position" idx + let assertTextIs (text: string) = + assertAndGetIndex + >> snd + >> Expect.equal "should have correct text" text + + testList "in normal string" [ + testCase "in empty string" <| fun _ -> + let text = "$0" + let expected = 0 + text |> assertCursorAt expected + testCase "start of single line" <| fun _ -> + let text = "$0Foo bar baz" + let expected = 0 + text |> assertCursorAt expected + testCase "end of single word" <| fun _ -> + let text = "foo$0" + // Note: out of string range: cursor is AFTER last character + let expected = 3 + text |> assertCursorAt expected + testCase "end of single line" <| fun _ -> + let text = "foo bar baz$0" + let expected = 11 + text |> assertCursorAt expected + testCase "removes cursor marker from single line" <| fun _ -> + let text = "foo $0bar" + let expected = "foo bar" + text |> assertTextIs expected + ] + testList "in triple quoted string" [ + testCase "in empty string unindented" <| fun _ -> + // technically incorrect: contains `\n` + let text = """ +$0 + """ + let expected = 0 + text |> assertCursorAt expected + testCase "in empty string indented" <| fun _ -> + // technically incorrect: contains `\n` + let text = """ + $0 + """ + let expected = 0 + text |> assertCursorAt expected + testCase "in F# code unindented" <| fun _ -> + let text = """ +module Foo + +let $0a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = 16 + text |> assertCursorAt expected + testCase "in F# code indented" <| fun _ -> + let text = """ + module Foo + + let $0a = 42 + let b = + a + 5 + printfn "Result=%i" b + """ + let expected = 16 + text |> assertCursorAt expected + testCase "removes cursor in F# code unindented" <| fun _ -> + let text = """ +module Foo + +let $0a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + // expected isn't trimmed in assertXXX -> do manually + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + testCase "removes cursor in F# code indented" <| fun _ -> + let text = """ + module Foo + + let $0a = 42 + let b = + a + 5 + printfn "Result=%i" b + """ + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + testCase "finds and removes only first cursor" <| fun _ -> + let text = """ + module Foo + + let $0a = 42 + let $0b = + a + 5 + printfn "Result=%i" b + """ + let expected = !- """ +module Foo + +let a = 42 +let $0b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + ] + ] + ] + + let private tryExtractPositionTests = testList (nameof Cursor.tryExtractPosition) [ + testList "no cursor" [ + let assertNoCursor = + Cursor.tryExtractPosition + >> Expect.isNone "should have found no cursor" + testCase "empty string" <| fun _ -> + let text = "" + assertNoCursor text + testCase "single line" <| fun _ -> + let text = "Foo Bar Baz" + assertNoCursor text + testCase "two lines" <| fun _ -> + let text = "Foo Bar Baz\nLorem ipsum dolor sit" + assertNoCursor text + testCase "multiple lines" <| fun _ -> + let text = "Foo\nBar\nBaz\nLorem\nimpsum\ndolor\nsit" + assertNoCursor text + testCase "just spaces" <| fun _ -> + let text = " " + assertNoCursor text + testCase "just spaces and new lines" <| fun _ -> + let text = " \n \n\n \n\n\n\n \n \n \n" + assertNoCursor text + testCase "triple quoted string without processing" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + assertNoCursor text + testCase "triple quoted string with processing (starting new line, no indentation)" <| fun _ -> + let text = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + assertNoCursor text + testCase "triple quoted string with processing (starting new line, indentation)" <| fun _ -> + let text = !- """ + module Foo + + let a = 42 + let b = + a + 5 + printfn "Result=%i" b + """ + assertNoCursor text + ] + + testList "with cursor" [ + let assertAndGetCursor = + Text.trimTripleQuotation + >> Cursor.tryExtractPosition + >> Option.defaultWith (fun _ -> failtest "No cursor found") + let assertCursorAt (pos: Position) = + assertAndGetCursor + >> fst + >> Expect.equal "should have found cursor at correct position" pos + let assertTextIs (text: string) = + assertAndGetCursor + >> snd + >> Expect.equal "should have correct text" text + let assertResultIs (pos: Position, text: string) = + assertAndGetCursor + >> Expect.equal "should be correct cursor position and text" (pos, text) + + testList "in normal string" [ + testCase "in empty string" <| fun _ -> + let text = "$0" + let expected = pos 0 0 + text |> assertCursorAt expected + testCase "start of single line" <| fun _ -> + let text = "$0Foo bar baz" + let expected = pos 0 0 + text |> assertCursorAt expected + testCase "end of single word" <| fun _ -> + let text = "foo$0" + // Note: out of string range: cursor is AFTER last character + let expected = pos 0 3 + text |> assertCursorAt expected + testCase "end of single line" <| fun _ -> + let text = "foo bar baz$0" + let expected = pos 0 11 + text |> assertCursorAt expected + testCase "removes cursor marker from single line" <| fun _ -> + let text = "foo $0bar" + let expected = "foo bar" + text |> assertTextIs expected + ] + testList "in triple quoted string" [ + testCase "in empty string unindented" <| fun _ -> + // technically incorrect: contains `\n` + let text = """ +$0 + """ + let expected = pos 0 0 + text |> assertCursorAt expected + testCase "in empty string indented" <| fun _ -> + // technically incorrect: contains `\n` + let text = """ + $0 + """ + let expected = pos 0 0 + text |> assertCursorAt expected + testCase "in F# code unindented" <| fun _ -> + let text = """ +module Foo + +let $0a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = pos 2 4 // 0-based, first line (with `"""`) is removed + text |> assertCursorAt expected + testCase "in F# code indented" <| fun _ -> + let text = """ + module Foo + + let $0a = 42 + let b = + a + 5 + printfn "Result=%i" b + """ + let expected = pos 2 4 // 0-based, first line (with `"""`) is removed, leading indentation removed + text |> assertCursorAt expected + testCase "removes cursor in F# code unindented" <| fun _ -> + let text = """ +module Foo + +let $0a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + // expected isn't trimmed in assertXXX -> do manually + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + testCase "removes cursor in F# code indented" <| fun _ -> + let text = """ + module Foo + + let $0a = 42 + let b = + a + 5 + printfn "Result=%i" b + """ + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + testCase "finds and removes only first cursor" <| fun _ -> + let text = """ + module Foo + + let $0a = 42 + let $0b = + a + 5 + printfn "Result=%i" b + """ + let expected = !- """ +module Foo + +let a = 42 +let $0b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + ] + ] + ] + + let tryExtractRangeTests = testList (nameof Cursor.tryExtractRange) [ + let assertAndGetRange = + Text.trimTripleQuotation + >> Cursor.tryExtractRange + >> Option.defaultWith (fun _ -> failtest "No cursor found") + let assertRangeIs (range: Range) = + assertAndGetRange + >> fst + >> Expect.equal "should have found correct range" range + let assertTextIs (text: string) = + assertAndGetRange + >> snd + >> Expect.equal "should have correct text" text + let assertResultIs (range: Range, text: string) = + assertAndGetRange + >> Expect.equal "should be correct range and text" (range, text) + testCase "no cursor results in no range" <| fun _ -> + let text = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text + |> Cursor.tryExtractRange + |> Expect.isNone "should have found no cursor" + testCase "can extract range in same line" <| fun _ -> + let text = """ +module Foo + +let $0a =$0 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = { Start = pos 2 4; End = pos 2 7 } + text |> assertRangeIs expected + testCase "can extract range over multiple lines" <| fun _ -> + let text = """ +module Foo + +let $0a = 42 +let b = + a + 5 +printfn "$0Result=%i" b + """ + let expected = { Start = pos 2 4; End = pos 5 9 } + text |> assertRangeIs expected + testCase "can extract position" <| fun _ -> + let text = """ +module Foo + +let a =$0 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = { Start = pos 2 7; End = pos 2 7 } + text |> assertRangeIs expected + testCase "removes cursor markers from line" <| fun _ -> + let text = """ +module Foo + +let $0a = 42 +let b = + a + 5 +printfn "$0Result=%i" b + """ + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertTextIs expected + testCase "finds and removes only first range and its two markers" <| fun _ -> + let text = """ +module $0Foo + +let a = $042 +let b = + a + $05 +printfn "$0Result$0=%i$0" b$0 + """ + let expectedRange = { Start = pos 0 7; End = pos 2 8 } + let expectedText = !- """ +module Foo + +let a = 42 +let b = + a + $05 +printfn "$0Result$0=%i$0" b$0 + """ + text |> assertResultIs (expectedRange, expectedText) + ] + + let beforeIndexTests = testList (nameof Cursor.beforeIndex) [ + let assertBeforeIndex expected textWithCursor = + let textWithCursor = Text.trimTripleQuotation textWithCursor + let idx = textWithCursor.IndexOf Cursor.Marker + Expect.isGreaterThanOrEqual "Text has no cursor" (idx, 0) + let text = textWithCursor.Remove(idx, Cursor.Marker.Length) + + text + |> Cursor.beforeIndex idx + |> Expect.equal "Should be correct position" expected + + + testList "single line" [ + testCase "empty string" <| fun _ -> + let text = "" + let idx = 0 + let expected = pos 0 0 + + text + |> Cursor.beforeIndex idx + |> Expect.equal "Position should be at start of string" expected + + testCase "empty string with cursor" <| fun _ -> + let text = "$0" + let expected = pos 0 0 + assertBeforeIndex expected text + + testCase "single line string - start" <| fun _ -> + let text = "$0let foo = 42" + let expected = pos 0 0 + assertBeforeIndex expected text + testCase "single line string - middle" <| fun _ -> + let text = "let foo $0= 42" + let expected = pos 0 8 + assertBeforeIndex expected text + testCase "single line string - end" <| fun _ -> + let text = "let foo = 42$0" + let expected = pos 0 12 + assertBeforeIndex expected text + ] + testList "multi line" [ + testCase "start of first line" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = pos 0 0 + assertBeforeIndex expected text + testCase "middle of first line" <| fun _ -> + let text = """ +module $0Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = pos 0 7 + assertBeforeIndex expected text + testCase "end of first line" <| fun _ -> + let text = """ +module Foo$0 + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = pos 0 10 + assertBeforeIndex expected text + testCase "start of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +$0let b = + a + 5 +printfn "Result=%i" b + """ + let expected = pos 3 0 + assertBeforeIndex expected text + testCase "middle of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let $0b = + a + 5 +printfn "Result=%i" b + """ + let expected = pos 3 4 + assertBeforeIndex expected text + testCase "end of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b =$0 + a + 5 +printfn "Result=%i" b + """ + let expected = pos 3 7 + assertBeforeIndex expected text + testCase "start of last line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +$0printfn "Result=%i" b""" + let expected = pos 5 0 + assertBeforeIndex expected text + testCase "middle of last line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "$0Result=%i" b""" + let expected = pos 5 9 + assertBeforeIndex expected text + testCase "end of last line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0""" + let expected = pos 5 21 + assertBeforeIndex expected text + ] + ] + + let tryIndexOfTests = testList (nameof Cursor.tryIndexOf) [ + let assertAndGetTextAndCursor = + Text.trimTripleQuotation + >> Cursor.tryExtractPosition + >> Option.defaultWith (fun _ -> failtest "should have found cursor") + let indexOf = + assertAndGetTextAndCursor + >> fun (pos, text) -> Cursor.tryIndexOf pos text + let assertAndGetIndexOf = + indexOf + >> function + | Ok i -> i + | Result.Error msg -> failtest $"should have found index. But was error: {msg}" + let assertIndexOf expectedIndex = + assertAndGetIndexOf + >> Expect.equal "wrong index" expectedIndex + let assertIndexOf expectedIndex textWithCursor = + let (pos, text) = assertAndGetTextAndCursor textWithCursor + match Cursor.tryIndexOf pos text with + | Ok actualIndex -> + let idxInText = textWithCursor.IndexOf Cursor.Marker + let errorMsg = $"wrong index. Cursor at Postion={{Line={pos.Line};Char={pos.Character}}} or Index={idxInText}" + Expect.equal errorMsg expectedIndex actualIndex + | Result.Error msg -> failtest $"should have found index. But was error: {msg}" + let assertNoIndexAt pos = + Text.trimTripleQuotation + >> Cursor.tryIndexOf pos + >> function + | Ok i -> failtest $"Expected Error, but was OK with index {i}" + | Result.Error _ -> () + + testList "empty string" [ + testCase "inside" <| fun _ -> + let text = "$0" + let expected = 0 + text |> assertIndexOf expected + testCase "out of char range in empty string" <| fun _ -> + let text = "" + let pos = pos 0 1 + text |> assertNoIndexAt pos + testCase "out of line range in empty string" <| fun _ -> + let text = "" + let pos = pos 1 0 + text |> assertNoIndexAt pos + ] + + testList "single line" [ + testCase "out of char range" <| fun _ -> + let text = "foo bar baz" + let pos = pos 0 (11 + 1) + text |> assertNoIndexAt pos + testCase "out of line range" <| fun _ -> + let text = "foo bar baz" + let pos = pos 1 0 + text |> assertNoIndexAt pos + testCase "start" <| fun _ -> + let text = "$0foo bar baz" + let expected = 0 + text |> assertIndexOf expected + testCase "middle" <| fun _ -> + let text = "foo b$0ar baz" + let expected = 5 + text |> assertIndexOf expected + testCase "end" <| fun _ -> + let text = "foo bar baz$0" + let expected = 11 + text |> assertIndexOf expected + ] + + testList "two lines" [ + testCase "start of 1st line" <| fun _ -> + // chars: 11 + `\n` + 17 + let text = "$0foo bar baz\nlorem ipsum dolor" + let expected = 0 + text |> assertIndexOf expected + testCase "middle of 1st line" <| fun _ -> + let text = "foo b$0ar baz\nlorem ipsum dolor" + let expected = 5 + text |> assertIndexOf expected + testCase "end of 1st line" <| fun _ -> + let text = "foo bar baz$0\nlorem ipsum dolor" + let expected = 10 (*1st line; 0-based*) + 1 (*\n*) // on `\n`; 10: Index is 0-based: string with length=11 -> max index = 10 + text |> assertIndexOf expected + testCase "start of 2nd line" <| fun _ -> + let text = "foo bar baz\n$0lorem ipsum dolor" + let expected = 10 (*1st line; 0-based*) + 1 (*\n*) + 0 (*2nd line*) + 1 (*index after cursor*) + text |> assertIndexOf expected + testCase "middle of 2nd line" <| fun _ -> + let text = "foo bar baz\nlorem ip$0sum dolor" + let expected = 10 (*1st line; 0-based*) + 1 (*\n*) + 8 (*2nd line*) + 1 (*index after cursor*) + text |> assertIndexOf expected + testCase "end of 2nd line" <| fun _ -> + let text = "foo bar baz\nlorem ipsum dolor$0" + let expected = 10 (*1st line; 0-based*) + 1 (*\n*) + 17 (*2nd line*) + 1 (*index afrer cursor*) + text |> assertIndexOf expected + testCase "out of char range in 1st line" <| fun _ -> + let text = "foo bar baz\nlorem ipsum dolor" + let pos = pos 0 (11 + 1) + text |> assertNoIndexAt pos + testCase "out of char range in 2nd line" <| fun _ -> + let text = "foo bar baz\nlorem ipsum dolor" + let pos = pos 1 (17 + 1) + text |> assertNoIndexAt pos + testCase "out of line range" <| fun _ -> + let text = "foo bar baz\nlorem ipsum dolor" + let pos = pos 2 0 + text |> assertNoIndexAt pos + ] + + testList "F# code" [ + testCase "start of text" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertIndexOf 0 + testCase "end of text" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b +$0""" + text |> assertIndexOf 62 + testCase "middle of 1st line" <| fun _ -> + let text = """ +module$0 Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertIndexOf 6 + testCase "end of 1st line" <| fun _ -> + let text = """ +module Foo$0 + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertIndexOf 10 + testCase "start of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +$0let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertIndexOf 23 + testCase "middle of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let $0b = + a + 5 +printfn "Result=%i" b + """ + text |> assertIndexOf 27 + testCase "end of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = $0 + a + 5 +printfn "Result=%i" b + """ + text |> assertIndexOf 31 + ] + ] + + let identityTests = testList "identities" [ + // * idx |> beforeIndex |> tryIndexOf = idx + // * pos |> tryIndexOf |> beforeIndex = pos + // * tryExtractIndex >> beforeIndex = tryExtractPosition + // * tryExtractPosition >> tryIndexOf = tryExtractIndex + + // assert: `lhs = rhs` + let assertEquality lhs rhs textWithCursor = + let textWithCursor = textWithCursor |> Text.trimTripleQuotation + let lhs = textWithCursor |> lhs + let rhs = textWithCursor |> rhs + Expect.equal "Should hold: lhs = rhs (expected = actual)" lhs rhs + let testEquality lhs rhs name textWithCursor = + testCase name <| fun _ -> assertEquality lhs rhs textWithCursor + let testEqualityForAllCursors lhs rhs textWithCursors = + textWithCursors + |> Text.trimTripleQuotation + |> Cursors.iter + |> List.mapi (fun i t -> testEquality lhs rhs $"Cursor {i}" t) + + /// assert: `value |> roundTrip = value` + let assertThereAndBackAgain value roundTrip textWithCursor = + let textWithCursor = textWithCursor |> Text.trimTripleQuotation + let (value,text) = textWithCursor |> value + let roundTripped = (value, text) ||> roundTrip + Expect.equal "Should hold: value |> roundTrip = value (expected |> roundTrip = actual)" value roundTripped + let testThereAndBackAgain value roundTrip name textWithCursor = + testCase name <| fun _ -> assertThereAndBackAgain value roundTrip textWithCursor + let testThereAndBackAgainForAllCursors value roundTrip textWithCursors = + textWithCursors + |> Text.trimTripleQuotation + |> Cursors.iter + |> List.mapi (fun i -> testThereAndBackAgain value roundTrip $"Cursor {i}") + + testList "idx |> beforeIndex |> tryIndexOf = idx" [ + let value (textWithCursor: string) = + let idx = textWithCursor.IndexOf Cursor.Marker + if idx < 0 then + failtest "No cursor" + let text = textWithCursor.Replace(Cursor.Marker, "") + (idx, text) + let roundTrip idx text = + let pos = Cursor.beforeIndex idx text + Cursor.tryIndexOf pos text + |> Result.defaultWith (fun error -> failtest $"Error while IndexOf: {error}") + testList "F# Code 1" ( + let text = """ +$0module$0 Foo$0 + +$0let $0a = 42$0 +let b = + $0a $0+ 5$0 +$0printfn "$0Result=%i" b$0 + """ + text |> testThereAndBackAgainForAllCursors value roundTrip + ) + ] + testList "pos |> tryIndexOf |> beforeIndex = pos" [ + let value (textWithCursor: string) = + textWithCursor + |> Cursor.tryExtractPosition + |> Option.defaultWith (fun _ -> failtest "No cursor") + let roundTrip pos text = + let idx = + text + |> Cursor.tryIndexOf pos + |> Result.defaultWith (fun error -> failtest $"Error while IndexOf: {error}") + Cursor.beforeIndex idx text + testList "F# Code 1" ( + let text = """ +$0module$0 Foo$0 + +$0let $0a = 42$0 +let b = + $0a $0+ 5$0 +$0printfn "$0Result=%i" b$0 + """ + text |> testThereAndBackAgainForAllCursors value roundTrip + ) + ] + testList "tryExtractIndex >> beforeIndex = tryExtractPosition" [ + let lhs = + Cursor.tryExtractIndex + >> Option.defaultWith (fun _ -> failtest "No cursor") + >> fun (idx, text) -> Cursor.beforeIndex idx text + let rhs = + Cursor.tryExtractPosition + >> Option.defaultWith (fun _ -> failtest "No cursor") + >> fst + testList "F# Code 1" ( + let text = """ +$0module$0 Foo$0 + +$0let $0a = 42$0 +let b = + $0a $0+ 5$0 +$0printfn "$0Result=%i" b$0 + """ + text |> testEqualityForAllCursors lhs rhs + ) + ] + testList "tryExtractPosition >> tryIndexOf = tryExtractIndex" [ + let lhs = + Cursor.tryExtractPosition + >> Option.defaultWith (fun _ -> failtest "No cursor") + >> fun (pos, text) -> Cursor.tryIndexOf pos text + >> Result.defaultWith (fun error -> failtest $"No index: {error}") + let rhs = + Cursor.tryExtractIndex + >> Option.defaultWith (fun _ -> failtest "No cursor") + >> fst + testList "F# Code 1" ( + let text = """ +$0module$0 Foo$0 + +$0let $0a = 42$0 +let b = + $0a $0+ 5$0 +$0printfn "$0Result=%i" b$0 + """ + text |> testEqualityForAllCursors lhs rhs + ) + ] + ] + + let tests = testList (nameof Cursor) [ + tryExtractIndexTests + tryExtractPositionTests + tryExtractRangeTests + beforeIndexTests + tryIndexOfTests + identityTests + ] + +module private Cursors = + open Expecto.Flip + + let private iterTests = testList (nameof Cursors.iter) [ + testCase "no cursor" <| fun _ -> + let text = "foo bar baz" + let expected = [] + text + |> Cursors.iter + |> Expect.equal "should be empty because no cursors" expected + testCase "one cursor" <| fun _ -> + let text = "foo $0bar baz" + let expected = [text] + text + |> Cursors.iter + |> Expect.equal "should have returned one strings with cursor" expected + testCase "two cursors" <| fun _ -> + let text = "foo $0bar baz$0" + let expected = [ + "foo $0bar baz" + "foo bar baz$0" + ] + text + |> Cursors.iter + |> Expect.equal "should have returned two strings with cursor" expected + testCase "three cursors" <| fun _ -> + let text = "$0foo $0bar baz$0" + let expected = [ + "$0foo bar baz" + "foo $0bar baz" + "foo bar baz$0" + ] + text + |> Cursors.iter + |> Expect.equal "should have returned three strings with cursor" expected + testCase "four cursors" <| fun _ -> + let text = "$0foo $0ba$0r baz$0" + let expected = [ + "$0foo bar baz" + "foo $0bar baz" + "foo ba$0r baz" + "foo bar baz$0" + ] + text + |> Cursors.iter + |> Expect.equal "should have returned three strings with cursor" expected + testCase "cursors in triple quoted string" <| fun _ -> + let text = !- """ +module $0Foo + +let a = 42 +$0let b = + a + 5$0 +printfn "Result=%i$0" b$0 + """ + let expected = [ + !- """ +module $0Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + !- """ +module Foo + +let a = 42 +$0let b = + a + 5 +printfn "Result=%i" b + """ + !- """ +module Foo + +let a = 42 +let b = + a + 5$0 +printfn "Result=%i" b + """ + !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i$0" b + """ + !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0 + """ + ] + text + |> Cursors.iter + |> Expect.equal "should have returned all strings with single cursor" expected + ] + let tests = testList (nameof Cursors) [ + iterTests + ] + + +module private Text = + open Expecto.Flip + let inline private range start fin = { Start = start; End = fin} + + let private removeTests = testList (nameof Text.remove) [ + testList "start=end should remove nothing" [ + let assertNothingChanged textWithCursor = + let (range, text) = + textWithCursor + |> Text.trimTripleQuotation + |> Cursor.tryExtractRange + |> Option.defaultWith (fun _ -> failtest $"no cursor found") + let expected = Ok text + text + |> Text.remove range + |> Expect.equal "shouldn't have changed input string" expected + + let just pos = range pos pos + testCase "empty string" <| fun _ -> + let text = "" + let range = just <| pos 0 0 + let expected = "" + text + |> Text.remove range + |> Expect.equal "shouldn't have change input string" (Ok expected) + testCase "empty string with two cursors" <| fun _ -> + "$0$0" + |> assertNothingChanged + testList "single line string" [ + testCase "start" <| fun _ -> + "$0foo bar baz" + |> assertNothingChanged + testCase "middle" <| fun _ -> + "foo b$0ar baz" + |> assertNothingChanged + testCase "end" <| fun _ -> + "foo bar baz$0" + |> assertNothingChanged + testCase "two cursors in middle" <| fun _ -> + "foo $0$0bar baz" + |> assertNothingChanged + ] + testList "two line string" [ + testCase "start" <| fun _ -> + "$0foo bar\n baz" + |> assertNothingChanged + testCase "end 1st line" <| fun _ -> + "foo bar$0\n baz" + |> assertNothingChanged + testCase "start 2nd line" <| fun _ -> + "foo bar\n$0 baz" + |> assertNothingChanged + testCase "middle 2nd line" <| fun _ -> + "foo bar\n ba$0z" + |> assertNothingChanged + testCase "end" <| fun _ -> + "foo bar\n baz$0" + |> assertNothingChanged + ] + testList "F# Code" ( + let text = """ +$0module$0 Foo$0 + +$0let $0a = 42$0 +let b = + $0a $0+ 5$0 +$0printfn "$0Result=%i" b$0 + """ + text + |> Cursors.iter + |> List.mapi (fun i t -> + testCase $"Cursor {i}" <| fun _ -> + t |> assertNothingChanged + ) + ) + ] + + let assertRemoveRange range expected text = + text + |> Text.remove range + |> Expect.equal "incorrect string after removing" (Ok expected) + let assertAfterRemovingIs expected textWithRangeCursors = + let (range, text) = + textWithRangeCursors + |> Text.trimTripleQuotation + |> Cursor.tryExtractRange + |> Option.defaultWith (fun _ -> failtest "No cursors") + assertRemoveRange range expected text + testList "remove inside single line" [ + testList "single line string" [ + testCase "remove everything" <| fun _ -> + let text = "$0foo bar baz$0" + let expected = "" + text |> assertAfterRemovingIs expected + testCase "remove start to end of first word" <| fun _ -> + let text = "$0foo$0 bar baz" + let expected = " bar baz" + text |> assertAfterRemovingIs expected + testCase "remove last word to end of string" <| fun _ -> + let text = "foo bar $0baz$0" + let expected = "foo bar " + text |> assertAfterRemovingIs expected + testCase "remove word in middle" <| fun _ -> + let text = "foo $0bar$0 baz" + let expected = "foo baz" + text |> assertAfterRemovingIs expected + testCase "remove a lot in middle" <| fun _ -> + let text = "f$0oo bar ba$0z" + let expected = "fz" + text |> assertAfterRemovingIs expected + ] + testList "three line string" [ + testCase "remove everything" <| fun _ -> + let text = "$0foo bar\nbaz\nlorem ipsum$0" + let expected = "" + text |> assertAfterRemovingIs expected + testCase "remove first line without line break" <| fun _ -> + // let text = "$0foo bar$0\nbaz\nlorem ipsum" + let expected = "\nbaz\nlorem ipsum" + // text |> assertAfterRemovingIs expected + let text = "foo bar\nbaz\nlorem ipsum" + let range = range (pos 0 0) (pos 0 7) + text |> assertRemoveRange range expected + testCase "remove first line with line break" <| fun _ -> + // strictly speaking this removes over two lines... + // let text = "$0foo bar\n$0baz\nlorem ipsum" + let expected = "baz\nlorem ipsum" + // text |> assertAfterRemovingIs expected + let text = "foo bar\nbaz\nlorem ipsum" + let range = range (pos 0 0) (pos 1 0) + text |> assertRemoveRange range expected + testCase "remove 2nd line without line breaks" <| fun _ -> + let text = "foo bar\n$0baz$0\nlorem ipsum" + let expected = "foo bar\n\nlorem ipsum" + text |> assertAfterRemovingIs expected + testCase "remove 2nd line with line breaks" <| fun _ -> + let text = "foo bar$0\nbaz\n$0lorem ipsum" + let expected = "foo barlorem ipsum" + text |> assertAfterRemovingIs expected + testCase "remove 3rd line without line break" <| fun _ -> + let text = "foo bar\nbaz\n$0lorem ipsum$0" + let expected = "foo bar\nbaz\n" + text |> assertAfterRemovingIs expected + testCase "remove 3rd line with line break" <| fun _ -> + let text = "foo bar\nbaz$0\nlorem ipsum$0" + let expected = "foo bar\nbaz" + text |> assertAfterRemovingIs expected + ] + testList "F# Code" [ + testCase "Remove empty line" <| fun _ -> + let text = """ +module Foo +$0 +$0let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = !- """ +module Foo +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertAfterRemovingIs expected + testCase "remove word" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let $0b$0 = + a + 5 +printfn "Result=%i" b + """ + let expected = !- """ +module Foo + +let a = 42 +let = + a + 5 +printfn "Result=%i" b + """ + text |> assertAfterRemovingIs expected + testCase "remove end" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "$0Result=%i" b$0 + """ + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn " + """ + text |> assertAfterRemovingIs expected + testCase "remove start" <| fun _ -> + let text = """ +$0module $0Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let expected = !- """ +Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + text |> assertAfterRemovingIs expected + ] + ] + testList "remove over multiple lines" [ + testList "F# Code" [ + testCase "remove everything" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0""" + let expected = "" + text |> assertAfterRemovingIs expected + testCase "remove everything except last line break" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0 + """ + let expected = "\n" + text |> assertAfterRemovingIs expected + testCase "remove lines 3-5" <| fun _ -> + let text = """ +module Foo + +$0let a = 42 +let b = + a + 5 +$0printfn "Result=%i" b + """ + let expected = !-""" +module Foo + +printfn "Result=%i" b + """ + text |> assertAfterRemovingIs expected + testCase "remove lines from inside line 3 to inside line 5" <| fun _ -> + let text = """ +module Foo + +let a = $042 +let b = + a + $05 +printfn "Result=%i" b + """ + let expected = !-""" +module Foo + +let a = 5 +printfn "Result=%i" b + """ + text |> assertAfterRemovingIs expected + testCase "remove start to inside line 4" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b $0= + a + 5 +printfn "Result=%i" b + """ + let expected = !-""" += + a + 5 +printfn "Result=%i" b + """ + text |> assertAfterRemovingIs expected + testCase "remove inside line 4 to end" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b $0= + a + 5 +printfn "Result=%i" b$0""" + let expected = !-""" +module Foo + +let a = 42 +let b """ + text |> assertAfterRemovingIs expected + ] + ] + ] + + let private insertTests = testList (nameof Text.insert) [ + testList "empty insert should insert nothing" [ + let assertNothingChanged textWithCursor = + let (pos, text) = + textWithCursor + |> Text.trimTripleQuotation + |> Cursor.tryExtractPosition + |> Option.defaultWith (fun _ -> failtest $"no cursor found") + let expected = Ok text + text + |> Text.insert pos "" + |> Expect.equal "shouldn't have changed input string" expected + + testCase "into empty string" <| fun _ -> + "$0" + |> assertNothingChanged + testList "into single line" [ + testCase "start" <| fun _ -> + "$0foo bar baz" + |> assertNothingChanged + testCase "middle" <| fun _ -> + "foo ba$0r baz" + |> assertNothingChanged + testCase "end" <| fun _ -> + "foo bar baz$0" + |> assertNothingChanged + ] + testList "into three lines" [ + testCase "start" <| fun _ -> + "$0foo\nbar\nbaz" + |> assertNothingChanged + testCase "start 2nd line" <| fun _ -> + "foo\n$0bar\nbaz" + |> assertNothingChanged + testCase "middle 2nd line" <| fun _ -> + "foo\nba$0r\nbaz" + |> assertNothingChanged + testCase "end 2nd line" <| fun _ -> + "foo\nbar$0\nbaz" + |> assertNothingChanged + testCase "end" <| fun _ -> + "foo\nbar\nbaz$0" + |> assertNothingChanged + ] + testList "into F# Code" ( + let text = """ +$0module$0 Foo$0 + +$0let $0a = 42$0 +let b = + $0a $0+ 5$0 +$0printfn "$0Result=%i" b$0 + """ + text + |> Cursors.iter + |> List.mapi (fun i t -> + testCase $"Cursor {i}" <| fun _ -> + t |> assertNothingChanged + ) + ) + ] + + let assertAfterInsertingIs expected (textWithCursor, insert) = + let (pos, text) = + textWithCursor + |> Text.trimTripleQuotation + |> Cursor.tryExtractPosition + |> Option.defaultWith (fun _ -> failtest "No cursor") + text + |> Text.insert pos insert + |> Expect.equal "incorrect string after inserting" (Ok expected) + testList "insert without linebreak" [ + testCase "into empty string" <| fun _ -> + let text = "$0" + let insert = "some text" + let expected = insert + (text,insert) + |> assertAfterInsertingIs expected + testList "into single line string" [ + testCase "start" <| fun _ -> + let text = "$0foo bar baz" + let insert = "some text" + let expected = $"{insert}foo bar baz" + (text,insert) + |> assertAfterInsertingIs expected + testCase "middle" <| fun _ -> + let text = "foo b$0ar baz" + let insert = "some text" + let expected = "foo bsome textar baz" + (text,insert) + |> assertAfterInsertingIs expected + testCase "end" <| fun _ -> + let text = "foo bar baz$0" + let insert = "some text" + let expected = $"foo bar baz{insert}" + (text,insert) + |> assertAfterInsertingIs expected + ] + testList "into F# Code" [ + testCase "start of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +$0let b = + a + 5 +printfn "Result=%i" b + """ + let insert = "some text" + let expected = !- """ +module Foo + +let a = 42 +some textlet b = + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + testCase "middle of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b$0 = + a + 5 +printfn "Result=%i" b + """ + let insert = "some text" + let expected = !- """ +module Foo + +let a = 42 +let bsome text = + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + testCase "end of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b =$0 + a + 5 +printfn "Result=%i" b + """ + let insert = "some text" + let expected = !- """ +module Foo + +let a = 42 +let b =some text + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + ] + ] + + testList "insert with line break" [ + testCase "into empty string" <| fun _ -> + let text = "$0" + let insert = "lorem\nipsum" + let expected = insert + (text, insert) + |> assertAfterInsertingIs expected + testList "into single line string" [ + testCase "start" <| fun _ -> + let text = "$0foo bar baz" + let insert = "lorem\nipsum" + let expected = "lorem\nipsumfoo bar baz" + (text, insert) + |> assertAfterInsertingIs expected + testCase "middle" <| fun _ -> + let text = "foo b$0ar baz" + let insert = "lorem\nipsum" + let expected = "foo blorem\nipsumar baz" + (text, insert) + |> assertAfterInsertingIs expected + testCase "end" <| fun _ -> + let text = "foo bar baz$0" + let insert = "lorem\nipsum" + let expected = "foo bar bazlorem\nipsum" + (text, insert) + |> assertAfterInsertingIs expected + ] + testList "into F# Code" [ + testCase "start" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + let insert = "lorem\nipsum" + let expected = !- """ +lorem +ipsummodule Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + testCase "end" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0""" + let insert = "lorem\nipsum" + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" blorem +ipsum""" + (text, insert) + |> assertAfterInsertingIs expected + testCase "end before line break" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0 + """ + let insert = "lorem\nipsum" + let expected = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" blorem +ipsum + """ + (text, insert) + |> assertAfterInsertingIs expected + testCase "start of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +$0let b = + a + 5 +printfn "Result=%i" b + """ + let insert = "lorem\nipsum" + let expected = !- """ +module Foo + +let a = 42 +lorem +ipsumlet b = + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + testCase "middle of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b$0 = + a + 5 +printfn "Result=%i" b + """ + let insert = "lorem\nipsum" + let expected = !- """ +module Foo + +let a = 42 +let blorem +ipsum = + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + testCase "end of 4th line" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b =$0 + a + 5 +printfn "Result=%i" b + """ + let insert = "lorem\nipsum" + let expected = !- """ +module Foo + +let a = 42 +let b =lorem +ipsum + a + 5 +printfn "Result=%i" b + """ + (text, insert) + |> assertAfterInsertingIs expected + ] + ] + ] + + let private replaceTests = testList (nameof Text.replace) [ + testList "neither change nor insert" [ + let assertNothingChanged (textWithCursors, replacement) = + let (range, text) = + textWithCursors + |> Text.trimTripleQuotation + |> Cursor.tryExtractRange + |> Option.defaultWith (fun _ -> failtest $"no cursor(s) found") + let expected = Ok text + text + |> Text.replace range replacement + |> Expect.equal "shouldn't have changed input string" expected + testCase "insert empty string into empty string" <| fun _ -> + let text = "$0" + let replacement = "" + (text, replacement) + |> assertNothingChanged + testCase "replace single line text with same text" <| fun _ -> + let text = "$0foo bar baz$0" + let replacement = "foo bar baz" + (text, replacement) + |> assertNothingChanged + testCase "replace inside single line text with same text" <| fun _ -> + let text = "foo$0 bar$0 baz" + let replacement = " bar" + (text, replacement) + |> assertNothingChanged + testCase "insert empty string into single line string" <| fun _ -> + let text = "foo $0bar baz" + let replacement = "" + (text, replacement) + |> assertNothingChanged + testList "F# Code" [ + testCase "insert empty string" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let b$0 = + a + 5 +printfn "Result=%i" b + """ + let replacement = "" + (text, replacement) + |> assertNothingChanged + testCase "replace everything with itself" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b$0""" + let replacement = !- """ +module Foo + +let a = 42 +let b = + a + 5 +printfn "Result=%i" b""" + (text, replacement) + |> assertNothingChanged + testCase "replace inside with same string" <| fun _ -> + let text = """ +module Foo + +let a = 42 +let $0b = + a +$0 5 +printfn "Result=%i" b + """ + let replacement = "b =\n a +" + (text, replacement) + |> assertNothingChanged + ] + ] + let assertAfterChangingIs expected (textWithCursors, replacement) = + let (range, text) = + textWithCursors + |> Text.trimTripleQuotation + |> Cursor.tryExtractRange + |> Option.defaultWith (fun _ -> failtest $"no cursor(s) found") + let expected = Ok expected + text + |> Text.replace range replacement + |> Expect.equal "unexpected change" expected + + testList "replace in F# Code" [ + testCase "delete everything" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = +a + 5 +printfn "Result=%i" b$0""" + let replacement = "" + let expected = "" + (text, replacement) + |> assertAfterChangingIs expected + testCase "replace everything" <| fun _ -> + let text = """ +$0module Foo + +let a = 42 +let b = +a + 5 +printfn "Result=%i" b$0""" + let replacement = !- """ +module Blub + +42 +|> (+) 5 +|> printfn "Result = %i" + """ + let expected = replacement + (text, replacement) + |> assertAfterChangingIs expected + + testCase "insert some lines" <| fun _ -> + let text = """ +module Foo + +$0let a = 42 +let b = +a + 5 +printfn "Result=%i" b + """ + let replacement = !- """ +let pi = 3.14 +let pi2 = pi * pi + """ + let expected = !- """ +module Foo + +let pi = 3.14 +let pi2 = pi * pi +let a = 42 +let b = +a + 5 +printfn "Result=%i" b + """ + (text, replacement) + |> assertAfterChangingIs expected + ] + ] + + let tests = testList (nameof Text) [ + removeTests + insertTests + replaceTests + ] + +module private TextEdit = + + /// FSAC might return TextEdits with NewLine matching the OS + /// but tests here only handle `\n` not `\r` + /// -> test `TextEdit.apply` replaces/removes `\r` + let private eolTests = testList "EOL" [ + let testEOLs baseName textWithRange (newTextWithN: string) expected = + testList baseName [ + let expected = !- expected + for eol in ["\n"; "\r\n"; "\r"] do + let eolStr = System.Text.RegularExpressions.Regex.Escape eol + testCase $"with {eolStr}" <| fun _ -> + let (range, text) = Cursor.assertExtractRange <| !- textWithRange + let newText = newTextWithN.Replace("\n", eol) + let edit: TextEdit = { + NewText = newText + Range = range + } + + let actual = + text + |> TextEdit.apply edit + |> Flip.Expect.wantOk "Apply should not fail" + + Expect.equal actual expected "Apply should produce correct text" + Expect.isFalse (actual.Contains '\r') "Should not contain \\r" + ] + + testEOLs + "can apply insert edit" + """ +let foo = 42$0 +let bar = 2 + """ + "\nlet baz = 4" + """ +let foo = 42 +let baz = 4 +let bar = 2 + """ + testEOLs + "can apply delete edit" + """ +let foo = $042 +let bar = $02 + """ + "" // kinda pointless: no new line in insert -> no new lines to replace... + """ +let foo = 2 + """ + testEOLs + "can apply replace edit" + """ +let foo = $042 +let bar =$0 2 + """ + "3\nlet a = 1\nlet baz =" + """ +let foo = 3 +let a = 1 +let baz = 2 + """ + ] + let private applyTests = testList (nameof TextEdit.apply) [ + eolTests + ] + + let private tryFindErrorTests = testList (nameof TextEdit.tryFindError) [ + testCase "valid delete edit should should be ok" <| fun _ -> + { + Range = { Start = pos 2 2; End = pos 3 3 } + NewText = "" + } + |> TextEdit.tryFindError + |> Flip.Expect.isNone "Valid delete should be ok" + testCase "valid insert edit should should be ok" <| fun _ -> + { + Range = { Start = pos 2 3; End = pos 2 3 } + NewText = "foo" + } + |> TextEdit.tryFindError + |> Flip.Expect.isNone "Valid delete should be ok" + testCase "valid replace edit should should be ok" <| fun _ -> + { + Range = { Start = pos 2 3; End = pos 4 9 } + NewText = "foo" + } + |> TextEdit.tryFindError + |> Flip.Expect.isNone "Valid delete should be ok" + testCase "empty edit should fail" <| fun _ -> + { + Range = { Start = pos 2 4; End = pos 2 4 } + NewText = "" + } + |> TextEdit.tryFindError + |> Flip.Expect.isSome "Empty edit should fail" + testCase "edit with End before Start should fail" <| fun _ -> + { + Range = { Start = pos 3 4; End = pos 2 2 } + NewText = "" + } + |> TextEdit.tryFindError + |> Flip.Expect.isSome "End before Start should fail" + ] + + let tests = testList (nameof TextEdit) [ + applyTests + tryFindErrorTests + ] + + +module private TextEdits = + let sortByRangeTests = testList (nameof TextEdits.sortByRange) [ + let test (edits: TextEdit list) = + let sorted = edits |> TextEdits.sortByRange + Expect.equal (sorted.Length) (edits.Length) "Sorted edits should have same length as input edits" + + // must hold for all in sorted: + // * r <= succ(r) + // -> sorted + // * r = succ(r) -> Index(edits, r) < Index(edits, succ(r)) + // -> preserve order + let unsorted = + sorted + |> List.pairwise + |> List.filter (fun (r, succ) -> not <| Position.leq r.Range.Start succ.Range.Start) + // isEmpty doesn't print list when failure... + if not (unsorted |> List.isEmpty) then + logger.error ( + eventX "Unsorted: {list}" + >> setField "list" unsorted + ) + Expect.isEmpty unsorted "All edits should be sorted" + + // Note: for this to work edits must be different (-> different NewText) + let idxInEdits (edit: TextEdit) = + edits |> List.findIndex ((=) edit) + + let unordered = + sorted + |> List.indexed + |> List.pairwise + |> List.filter (fun ((_, r), (_, succ)) -> r.Range.Start = succ.Range.Start) + |> List.choose (fun ((i1, e1), (i2, e2)) -> + let iSrc1, iSrc2 = (idxInEdits e1, idxInEdits e2) + assert(iSrc1 <> iSrc2) + if iSrc1 < iSrc2 then + None + else + {| + Edits = (e1, e2) + SourceIndicies = (iSrc1, iSrc2) + SortedIndices = (i1, i2) + |} + |> Some + ) + // isEmpty doesn't print list when failure... + if not (unordered |> List.isEmpty) then + logger.error ( + eventX "Unordered: {list}" + >> setField "list" unordered + ) + Expect.isEmpty unordered "Edits with same start should keep order" + + testCase "can sort distinct ranges" <| fun _ -> + [ + (1,5) + (1,1) + (3, 2) + (8, 5) + (5, 4) + (5, 6) + (4, 11) + (1,7) + ] + |> List.mapi (fun i (l,c) -> + // end doesn't really matter (no overlap allowed) + let start = { Line = l; Character = c } + { + Range = { Start = start; End = start } + NewText = $"{i}=({l},{c})" + } + ) + |> test + + testCase "can sort all same position ranges" <| fun _ -> + List.replicate 10 (2,4) + |> List.mapi (fun i (l,c) -> + // end doesn't really matter (no overlap allowed) + let start = { Line = l; Character = c } + { + Range = { Start = start; End = start } + NewText = $"{i}=({l},{c})" + } + ) + |> test + + testCase "can sort mix of same and different positions" <| fun _ -> + [ + (1,5) + (1,1) + (3, 2) + (5, 4) + (1,5) + (8, 5) + (5, 4) + (5, 6) + (4, 11) + (4, 11) + (1,7) + ] + |> List.mapi (fun i (l,c) -> + // end doesn't really matter (no overlap allowed) + let start = { Line = l; Character = c } + { + Range = { Start = start; End = start } + NewText = $"{i}=({l},{c})" + } + ) + |> test + ] + + let tryFindErrorTests = testList (nameof TextEdits.tryFindError) [ + testCase "valid single edit should succeed" <| fun _ -> + [ + { NewText = "foo"; Range = { Start = pos 1 2; End = pos 1 5 } } + ] + |> TextEdits.tryFindError + |> Flip.Expect.isNone "valid single edit should succeed" + testCase "valid multiple edits should succeed" <| fun _ -> + [ + { NewText = "foo"; Range = { Start = pos 1 2; End = pos 1 5 } } + { NewText = "bar"; Range = { Start = pos 5 2; End = pos 5 2 } } + { NewText = "baz"; Range = { Start = pos 2 2; End = pos 3 3 } } + ] + |> TextEdits.tryFindError + |> Flip.Expect.isNone "valid multiple edits should succeed" + testCase "no edit should fail" <| fun _ -> + TextEdits.tryFindError [] + |> Flip.Expect.isSome "No edit should fail" + let replace (start, fin) text : TextEdit = { + NewText = text + Range = { Start = start; End = fin } + } + let delete (start, fin) = replace (start, fin) "" + let insert pos text = replace (pos, pos) text + let empty pos = insert pos "" + /// used to mark edits that aren't main parts of the test, but instead are just used as 'surrounding' + /// -> `filler` used for tagging + let inline filler v = v + testCase "single empty edit should fail" <| fun _ -> + TextEdits.tryFindError [empty (pos 2 3)] + |> Flip.Expect.isSome "Empty edit should fail" + testCase "multiple empty edits should fail" <| fun _ -> + TextEdits.tryFindError [empty (pos 2 3); empty (pos 3 5); empty (pos 1 1)] + |> Flip.Expect.isSome "Empty edit should fail" + testCase "empty edit in list with valid edits should fail" <| fun _ -> + [ + filler <| replace (pos 1 2, pos 1 5) "0" + filler <| replace (pos 5 2, pos 5 2) "1" + empty (pos 1 7) + filler <| replace (pos 2 2, pos 3 3) "1" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Empty edit should fail" + testCase "two overlapping edits (Back/Front) on one line should fail" <| fun _ -> + [ + replace (pos 1 2, pos 1 5) "front overlap" + replace (pos 1 3, pos 1 7) "back overlap" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Overlapping edits should fail" + testCase "two overlapping edits (Front/Back) on one line should fail" <| fun _ -> + [ + replace (pos 1 3, pos 1 7) "back overlap" + replace (pos 1 2, pos 1 5) "front overlap" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Overlapping edits should fail" + testCase "two overlapping edits (Back/Front) over multiple lines should fail" <| fun _ -> + [ + replace (pos 1 2, pos 3 5) "front overlap" + replace (pos 2 3, pos 5 7) "back overlap" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Overlapping edits should fail" + testCase "two touching edits should succeed" <| fun _ -> + // valid because: cursor is between characters + // -> replace prior to (3,5); replace after (3,5) + // -> do not interfere with each other + [ + replace (pos 1 2, pos 3 5) "front" + replace (pos 3 5, pos 5 7) "back" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isNone "Touching edits should succeed" + testCase "two overlapping edits (Front/Back) over multiple lines should fail" <| fun _ -> + [ + replace (pos 2 3, pos 5 7) "back overlap" + replace (pos 1 2, pos 3 5) "front overlap" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Overlapping edits should fail" + testCase "overlapping edits (Back/Front) in list with valid edits should fail" <| fun _ -> + [ + filler <| replace (pos 1 1, pos 1 1) "0" + filler <| replace (pos 17 8, pos 19 8) "1" + replace (pos 1 2, pos 3 5) "front overlap" + filler <| replace (pos 7 5, pos 8 9) "2" + replace (pos 2 3, pos 5 7) "back overlap" + filler <| replace (pos 11 1, pos 15 9) "3" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Overlapping edits should fail" + testCase "replace inside another replace should fail" <| fun _ -> + [ + replace (pos 2 3, pos 4 1) "inside" + replace (pos 1 2, pos 5 7) "outside" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Inside edits should fail" + testCase "replace with another replace inside should fail" <| fun _ -> + [ + replace (pos 1 2, pos 5 7) "outside" + replace (pos 2 3, pos 4 1) "inside" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Inside edits should fail" + testCase "inserts with same position should succeed" <| fun _ -> + [ + insert (pos 2 4) "insert 1" + insert (pos 2 4) "insert 2" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isNone "Same position inserts should succeed" + testCase "inserts with same position followed by replace starting at same position should succeed" <| fun _ -> + [ + insert (pos 2 4) "insert 1" + insert (pos 2 4) "insert 2" + replace (pos 2 4, pos 4 7) "replace" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isNone "Same position inserts followed by replace should succeed" + testCase "replace before insert on same position should fail" <| fun _ -> + [ + replace (pos 2 4, pos 4 7) "replace" + insert (pos 2 4) "a" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Replace before insert on same position should fail" + testCase "inserts with same position followed by replace at same position intermingled with other valid edits should succeed" <| fun _ -> + [ + filler <| replace (pos 6 7, pos 7 9) "0" + insert (pos 2 4) "insert 1" + filler <| replace (pos 1 4, pos 2 1) "1" + filler <| replace (pos 11 17, pos 18 19) "2" + insert (pos 2 4) "insert 2" + filler <| replace (pos 6 1, pos 6 2) "3" + replace (pos 2 4, pos 4 7) "replace" + filler <| replace (pos 9 2, pos 9 7) "4" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isNone "Same position inserts followed by replace should succeed" + testCase "replace before insert on same position intermingled with other valid edits should fail" <| fun _ -> + [ + filler <| replace (pos 6 7, pos 7 9) "0" + insert (pos 2 4) "insert 1" + filler <| replace (pos 1 4, pos 2 1) "1" + filler <| replace (pos 11 17, pos 18 19) "2" + replace (pos 2 4, pos 4 7) "replace" + filler <| replace (pos 6 1, pos 6 2) "3" + insert (pos 2 4) "insert 2" + filler <| replace (pos 9 2, pos 9 7) "4" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Replace before insert on same position should fail" + testCase "two replaces in same position should fail" <| fun _ -> + [ + replace (pos 2 4, pos 5 9) "replace 1" + replace (pos 2 4, pos 4 7) "replace 2" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Two replaces in same position should fail" + testCase "two replaces in same position intermingled with other valid edits should fail should fail" <| fun _ -> + [ + filler <| replace (pos 6 7, pos 7 9) "0" + replace (pos 2 4, pos 5 9) "replace 1" + filler <| replace (pos 1 4, pos 2 1) "1" + replace (pos 2 4, pos 4 7) "replace 2" + filler <| replace (pos 6 1, pos 6 2) "2" + ] + |> TextEdits.tryFindError + |> Flip.Expect.isSome "Two replaces in same position should fail" + ] + + let applyTests = testList (nameof TextEdits.apply) [ + testList "single edit" [ + testCase "insert" <| fun _ -> + let (range, text) = Cursor.assertExtractRange !- """ + let foo = 42$0 + let bar = 2 + """ + let edit: TextEdit = { + NewText = "\nlet baz = 4" + Range = range + } + let expected = !- """ + let foo = 42 + let baz = 4 + let bar = 2 + """ + let actual = + text + |> TextEdit.apply edit + |> Flip.Expect.wantOk "Apply should not fail" + Expect.equal actual expected "Apply should produce correct text" + testCase "remove" <| fun _ -> + let (range, text) = Cursor.assertExtractRange !- """ + let foo = $042 + let bar = $02 + """ + let edit: TextEdit = { + NewText = "" + Range = range + } + let expected = !- """ + let foo = 2 + """ + let actual = + text + |> TextEdit.apply edit + |> Flip.Expect.wantOk "Apply should not fail" + Expect.equal actual expected "Apply should produce correct text" + testCase "replace" <| fun _ -> + let (range, text) = Cursor.assertExtractRange !- """ + let foo = $042 + let bar$0 = 2 + """ + let edit: TextEdit = { + NewText = "1\nlet baz" + Range = range + } + let expected = !- """ + let foo = 1 + let baz = 2 + """ + let actual = + text + |> TextEdit.apply edit + |> Flip.Expect.wantOk "Apply should not fail" + Expect.equal actual expected "Apply should produce correct text" + ] + ] + let tests = testList (nameof TextEdits) [ + sortByRangeTests + tryFindErrorTests + applyTests + ] + +let tests = testList (nameof TextEdit) [ + Cursor.tests + Cursors.tests + Text.tests + TextEdit.tests + TextEdits.tests +] diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs new file mode 100644 index 000000000..860010a1f --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs @@ -0,0 +1,402 @@ +module Utils.TextEdit +open Ionide.LanguageServerProtocol.Types +open Utils.Utils +open Expecto +open FsToolkit.ErrorHandling + +/// Functions to extract Cursor or Range from a given string. +/// Cursor is marked in string with `$0` (`Cursor.Marker`) +/// +/// Note: Only `\n` is supported. Neither `\r\n` nor `\r` produce correct results. +module Cursor = + /// 0-based + let inline private pos line column: Position = { Line = line; Character = column } + + /// Cursor Marker in text. + /// Single marker: Position + /// Two markers: Range + let [] Marker = "$0" + + (* + Identities: + * idx |> beforeIndex |> tryIndexOf = idx + * pos |> tryIndexOf |> beforeIndex = pos + * tryExtractIndex >> beforeIndex = tryExtractPosition + * tryExtractPosition >> tryIndexOf = tryExtractIndex + Note: Even though it's enough to only implement one side, + here all functions are implemented independent of each other. + Reason: For testing. One function wrong -> equality unit tests should fail + *) + + /// Returns Cursor Position BEFORE index + /// + /// Index might be `text.Length` (-> cursor AFTER last character). + /// All other out of text range indices throw exception. + let beforeIndex (i: int) (text: string) : Position = + assert(i >= 0) + assert(i <= text.Length) + + let linesBefore = + text.Substring(0, i) + |> Text.lines + // line & char are 0-based + let line = linesBefore.Length - 1 + let char = linesBefore |> Array.last |> String.length + pos line char + + /// Returns index of first `$0` (`Cursor.Marker`) and the updated input text without the cursor marker. + /// + /// Note: Cursor Position is BEFORE index. + /// Note: Index might be `text.Length` (-> Cursor AFTER last char in text) + let tryExtractIndex (text: string) = + match text.IndexOf Marker with + | -1 -> None + | i -> + (i, text.Remove(i, Marker.Length)) + |> Some + /// `tryExtractIndex`, but fails when there's no cursor + let assertExtractIndex = + tryExtractIndex + >> Option.defaultWith (fun _ -> failtest "No cursor") + + /// Returns Position of first `$0` (`Cursor.Marker`) and the updated input text without the cursor marker. + /// Only the first `$0` is processed. + /// + /// Note: Cursor Position is BETWEEN characters and might be outside of text range (cursor AFTER last character) + let tryExtractPosition (text: string) = + let tryFindCursorInLine (line: string) = + match line.IndexOf Marker with + | -1 -> None + | column -> + let line = line.Substring(0, column) + line.Substring(column + Marker.Length) + Some (column, line) + // Note: Input `lines` gets mutated to remove cursor + let tryFindCursor (lines: string[]) = + lines + |> Seq.mapi (fun i l -> (i,l)) + |> Seq.tryPick (fun (i,line) -> tryFindCursorInLine line |> Option.map (fun (c, line) -> (pos i c, line))) + |> function + | None -> None + | Some (p,line) -> + lines.[p.Line] <- line + Some (p, lines) + + let lines = text |> Text.lines + match tryFindCursor lines with + | None -> None + | Some (p, lines) -> + let text = lines |> String.concat "\n" + Some (p, text) + /// `tryExtractPosition`, but fails when there's no cursor + let assertExtractPosition = + tryExtractPosition + >> Option.defaultWith (fun _ -> failtest "No cursor") + + /// Returns Range between the first two `$0` (`Cursor.Marker`) and the updated text without the two cursor markers. + /// + /// If there's only one cursor marker, the range covers exactly that position (`Start = End`) + let tryExtractRange (text: string) = + match tryExtractPosition text with + | None -> None + | Some (start, text) -> + let (fin, text) = tryExtractPosition text |> Option.defaultValue (start, text) + let range = { Start = start; End = fin } + Some (range, text) + /// `tryExtractRange`, but fails when there's no cursor. + let assertExtractRange = + tryExtractRange + >> Option.defaultWith (fun _ -> failtest "No cursor(s)") + + /// Position is between characters, while index is on character. + /// For Insert & Remove: character indices + /// + /// Returned index is AFTER cursor: + /// * `Column=0`: before first char; `Index=0`: on first char + /// * `Column=1`: after first char, before 2nd char; `Index=1`: on 2nd char + /// * `Column=max`: after last char; `Index=max`: AFTER last char in line (-> `\n` or end of string) + let tryIndexOf (pos: Position) (text: string) = + Position.assertPositive pos + + let lines = text |> Text.lines + + // check in range + if pos.Line >= lines.Length then + $"Line {pos.Line} is out of text range. Text has {lines.Length} lines." + |> Error + elif pos.Character > lines.[pos.Line].Length then + // `>`: character can be AFTER last char in string + $"Character {pos.Character} is out of line range {pos.Line}. Line {pos.Line} has length of {lines[pos.Line].Length}." + |> Error + else + let offsetToLine = + lines + |> Seq.take pos.Line // `Line` is 0-based -> can be used as length + |> Seq.sumBy (String.length >> (+) 1) // `+ 1`: `\n` + + offsetToLine + pos.Character + |> Ok + /// `tryIndexOf`, but fails when position is invalid + let assertIndexOf pos = + tryIndexOf pos + >> Result.valueOr (failtestf "Invalid position: %s") + +module Cursors = + /// For each cursor (`$0`) in text: return text with just that one cursor + /// + /// Note: doesn't trim input! + let iter (textWithCursors: string) = + let rec collect (textsWithSingleCursor) (textWithCursors: string) = + match textWithCursors.IndexOf Cursor.Marker with + | -1 -> textsWithSingleCursor |> List.rev + | i -> + let textWithSingleCursor = + textWithCursors.Substring(0, i + Cursor.Marker.Length) + + + textWithCursors.Substring(i + Cursor.Marker.Length).Replace(Cursor.Marker, "") + let textWithCursors = textWithCursors.Remove(i, Cursor.Marker.Length) + collect (textWithSingleCursor :: textsWithSingleCursor) textWithCursors + collect [] textWithCursors + + /// Returns all cursor (`$0`) positions and the text without any cursors. + /// + /// Unlike `iter` this extracts positions instead of reducing to texts with one cursor + let extract (textWithCursors: string) = + let tps = + textWithCursors + |> iter + |> List.map (Cursor.assertExtractPosition) + let text = tps |> List.head |> snd + let poss = tps |> List.map fst + (text, poss) + + + +module Text = + + let private indicesOf (range: Range) (text: string) = + result { + let! start = Cursor.tryIndexOf range.Start text + if range.Start = range.End then + return (start, start) + else + let! fin = Cursor.tryIndexOf range.End text + return (start, fin) + } + let remove (range: Range) (text: string) = + result { + if range.Start = range.End then + return text + else + let! (start, fin) = indicesOf range text + // Including start, excluding fin (cursor is BEFORE char) + return text.Remove(start, fin - start) + } + + let insert (pos: Position) (insert: string) (text: string) = + result { + if insert = "" then + return text + else + let! idx = Cursor.tryIndexOf pos text + // insert BEFORE idx (cursor is BEFORE char) + return text.Insert (idx, insert) + } + + let replace (range: Range) (replacement: string) (text: string) = + text + |> remove range + |> Result.bind (insert range.Start replacement) + +module TextEdit = + + let apply (edit: TextEdit) = + // `edit` is from FSAC LSP -> might contain `\r`. + // But only `\n` handled by `Text.lines` -> remove `\r` + let newText = edit.NewText |> Text.removeCarriageReturn + Text.replace edit.Range newText + + + let deletes (edit: TextEdit) = not <| Range.isPosition edit.Range + let inserts (edit: TextEdit) = not <| System.String.IsNullOrEmpty edit.NewText + let replaces (edit: TextEdit) = deletes edit && inserts edit + + let doesNothing (edit: TextEdit) = + not (edit |> deletes) + && + not (edit |> inserts) + + // **Note**: + // VS Code allows TextEdits, that might not be strictly valid according to LSP Specs [^1]: + // * inserts into not existing line (text has 2 line, insert into line 5 is ok) + // * inserts into line way after last character (line has 15 char, insert into column 1000 is ok) + // * accepts `Range.End` < `Range.Start` + // * empty text edits (neither inserts nor deletes text) + // + // LSP Specs are quite vague. So above might or might not be ok according to Specs. + // But from FSAC perspective: Any case above most likely indicates an error in CodeFix implementation + // -> TextEdit must be STRICTLY correct and all of the cases above are considered erroneous! + // + // [^1]: https://microsoft.github.io/language-server-protocol/specifications/specification-current/ + + /// Checks passed `edit` for errors: + /// * Positive Lines & Characters in Ranges + /// * Note: doesn't test if range is inside text! Just simple positive test. + /// * Start Range must be before or equal End Range + /// * Does something (-> must insert or delete (or both -> replace) something) + /// * Note: empty edit is technically valid, but in practice it's most likely an error + let tryFindError (edit: TextEdit) = + if edit.Range.Start.Line < 0 then + Some "Expected positive Start.Line, but was negative" + else if edit.Range.Start.Character < 0 then + Some "Expected positive Start.Character, but was negative" + else if edit.Range.End.Line < 0 then + Some "Expected positive End.Line, but was negative" + else if edit.Range.End.Character < 0 then + Some "Expected positive End.Character, but was negative" + else if edit.Range.Start > edit.Range.End then + Some "Expected Range.Start <= Range.End, but was Start > End" + else if edit |> doesNothing then + Some "Expected change, but does nothing (neither delete nor insert)" + else + None + +module TextEdits = + + /// Checks edits for: + /// * There's at least one TextEdit + /// * All TextEdits are valid (`TextEdit.tryFindError`) + /// * Edits don't overlap + /// * For same position: All inserted before at most one replace (or delete) + /// + /// + /// [LSP Specification for `TextEdit[]`](https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textEditArray) + /// > Text edits ranges must never overlap, that means no part of the original document must be manipulated by more than one edit. + /// > However, it is possible that multiple edits have the same start position: multiple inserts, + /// > or any number of inserts followed by a single remove or replace edit. + /// > If multiple inserts have the same position, the order in the array defines the order + /// > in which the inserted strings appear in the resulting text. + let tryFindError (edits: TextEdit list) = + let rec tryFindOverlappingEditExample (edits: TextEdit list) = + match edits with + | [] | [_] -> None + | edit :: edits -> + match edits |> List.tryFind (fun e -> Range.overlapsLoosely edit.Range e.Range) with + | Some overlapping -> + Some (edit, overlapping) + | None -> + tryFindOverlappingEditExample edits + let (|Overlapping|_|) = tryFindOverlappingEditExample + let (|Invalids|_|) = + List.choose (fun edit -> edit |> TextEdit.tryFindError |> Option.map (fun err -> (edit, err))) + >> function | [] -> None | errs -> Some errs + let findSameStarts (edits: TextEdit list) = + edits + |> List.groupBy (fun e -> e.Range.Start) + |> List.filter (fun (_, es) -> List.length es > 1) + |> List.map snd + /// For same position: all inserts must be before at most one Delete/Replace + /// Note: doesn't check edits for same position + let rec replaceNotLast (edits: TextEdit list) = + match edits with + | [] | [_] -> false + | a::edits -> + assert(List.length edits >= 1) + (TextEdit.deletes a) || (replaceNotLast edits) + let (|ReplaceNotLast|_|) = + findSameStarts + >> List.filter (replaceNotLast) + >> function | [] -> None | ss -> Some ss + + match edits with + // there must be edits + | [] -> Some "Expected at least one TextEdit, but were none" + // edits should be valid + | Invalids errs -> + sprintf + "Expected all TextEdits to be valid, but there was at least one erroneous Edit. Invalid Edits: %A" + errs + |> Some + // No overlapping + | Overlapping (edit1, edit2) -> + Some $"Expected no overlaps, but at least two edits overlap: {edit1.Range} and {edit2.Range}" + // For same position: all inserts must be before at most one Delete/Replace + | ReplaceNotLast errs -> + sprintf + "Expected Inserts before at most one Delete/Replace, but there was at least one Delete/Before in invalid position: Invalid Edits: %A" + errs + |> Some + | _ -> None + + + /// Sorts edits by range (`Start`). + /// Order is preserved for edits with same `Start`. + let sortByRange (edits: TextEdit list) = + edits + |> List.sortWith (fun e1 e2 -> + match e1.Range.Start.Line.CompareTo(e2.Range.Start.Line) with + | 0 -> + e1.Range.Start.Character.CompareTo(e2.Range.Start.Character) + | r -> r + ) + + /// Applies the passed edits from last to first (sorted by range) + let apply edits text = + let edits = edits |> sortByRange |> List.rev + List.fold (fun text edit -> text |> Result.bind (TextEdit.apply edit)) (Ok text) edits + +module WorkspaceEdit = + /// Extract `TextEdit[]` from either `DocumentChanges` or `Changes`. + /// All edits MUST be for passed `textDocument`. + /// + /// Checks for errors: + /// * Either `DocumentChanges` or `Changes`, but not both + /// * FsAutoComplete sends only `DocumentChanges` + /// * All edits inside `textDocument` + /// * Version is only checked if: Version in `textDocument` and Version in `workspaceEdit.DocumentChanges.*` + /// * Using `TextEdit.tryFindError`: + /// * At least one edit + /// * No empty edit + /// * No overlaps + let tryExtractTextEditsInSingleFile (textDocument: VersionedTextDocumentIdentifier) (workspaceEdit: WorkspaceEdit) = + + let checkDocument (uri) (version) = + if uri <> textDocument.Uri then + Some $"Edit should be for document `{textDocument.Uri}`, but was for `{uri}`" + else + match textDocument.Version, version with + // only compare `Version` when `textDocument` and `version` has a Version. Otherwise ignore + | Some textDocVersion, Some version when textDocVersion <> version -> + Some $"Edit should be for document version `{textDocVersion}`, but version was `{version}`" + | _ -> None + + match (workspaceEdit.DocumentChanges, workspaceEdit.Changes) with + | None, None -> + Error "Expected changes, but `DocumentChanges` and `Changes` were both `None`." + | Some _, Some _ -> + Error "Expected either `DocumentChanges` or `Changes`, but was both." + | Some [||], None -> + Error "Expected changes, but `DocumentChanges` was empty." + | Some changes, None -> + match changes |> Array.tryPick (fun c -> checkDocument c.TextDocument.Uri c.TextDocument.Version) with + | Some error -> Error error + | _ -> + changes + |> Seq.map (fun c -> c.Edits) + |> Seq.collect id + |> Seq.toList + |> Ok + | None, Some changes when changes.IsEmpty -> + Error "Expected changes, but `Changes` was empty." + | None, Some changes -> + match changes |> Seq.tryPick (fun c -> checkDocument c.Key None) with + | Some error -> Error error + | _ -> + changes.Values + |> Seq.collect id + |> Seq.toList + |> Ok + |> Result.bind (fun edits -> + match TextEdits.tryFindError edits with + | Some error -> Error error + | None -> Ok edits + ) diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Utils.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Utils.Tests.fs new file mode 100644 index 000000000..1ece5d58e --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/Utils.Tests.fs @@ -0,0 +1,575 @@ +module Utils.Tests.Utils + +open Utils.Utils +open Expecto + +module private Expect = + let private failureTests = testList (nameof Expect.failure) [ + testCaseAsync "failtest should be success" (Expect.failure <| async { + failtest "some error" + }) + testCaseAsync "equal failure should be success" (Expect.failure <| async { + Expect.equal 1 2 "" + }) + testCaseAsync "no failure should fail" (async { + try + do! + async { return 1 } + |> Expect.failure + + failtest "should not succeed" + with + | :? AssertException -> () + | ex -> failtest "Expected AssertException, but was %A" (ex.GetType()) + }) + testCaseAsync "`failwith` (`System.Exception`) should fail" (async { + let msg = "some error" + try + do! + async { return failwith msg } + |> Expect.failure + + failtest "should not succeed" + with + | ex when ex.Message = msg -> () + | ex -> failtest "Expected System.Exception, but was %A" (ex.GetType()) + }) + testCaseAsync "`raise NotImplementedException` should fail" (async { + let msg = "oh no" + try + do! + async { return raise (System.NotImplementedException(msg)) } + |> Expect.failure + + failtest "should not succeed" + with + | :? System.NotImplementedException as ex -> + Expect.equal ex.Message msg "Should have correct error message" + | ex -> failtest "Expected System.Exception, but was %A" (ex.GetType()) + }) + ] + + let tests = testList (nameof Expect) [ + failureTests + ] + +module private Range = + open Ionide.LanguageServerProtocol.Types + + let inline pos line column : Position = { Line = line; Character = column} + let inline range p1 p2 = { Start = p1; End = p2 } + + let touchesTests = testList (nameof Range.touches) [ + testCase "completely disjoint ranges don't touch" <| fun _ -> + let r1 = { Start = pos 1 5; End = pos 3 7} + let r2 = { Start = pos 5 3; End = pos 7 8} + + let touch = Range.touches r1 r2 + Expect.isFalse touch "Should not touch" + testCase "range 1 inside range 2 don't touch" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 1 3; End = pos 7 8} + + let touch = Range.touches r1 r2 + Expect.isFalse touch "Should not touch" + let touch = Range.touches r2 r1 + Expect.isFalse touch "Should not touch" + testCase "two same single positions touch" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 2 5} + let r2 = { Start = pos 2 5; End = pos 2 5} + + let touch = Range.touches r1 r2 + Expect.isTrue touch "Should touch" + testCase "common End/Start touch" <| fun _ -> + let r1 = { Start = pos 1 5; End = pos 2 5} + let r2 = { Start = pos 2 5; End = pos 5 3} + + let touch = Range.touches r1 r2 + Expect.isTrue touch "Should touch" + let touch = Range.touches r2 r1 + Expect.isTrue touch "Should touch" + testCase "two same ranges don't touch" <| fun _ -> + let r1 = { Start = pos 1 5; End = pos 2 5} + let r2 = { Start = pos 1 5; End = pos 2 5} + + let touch = Range.touches r1 r2 + Expect.isFalse touch "Should not touch" + testCase "strictly overlapping ranges don't touch" <| fun _ -> + let r1 = { Start = pos 1 5; End = pos 3 7} + let r2 = { Start = pos 2 3; End = pos 5 8} + + let touch = Range.touches r1 r2 + Expect.isFalse touch "Should not touch" + ] + let private overlapsStrictlyTests = testList (nameof Range.overlapsStrictly) [ + testCase "completely distinct ranges on different lines don't overlap" <| fun _ -> + let r1 = { Start = pos 1 3; End = pos 2 7 } + let r2 = { Start = pos 4 5; End = pos 7 8 } + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isFalse overlap "Should not overlap" + + testCase "completely distinct ranges on same line don't overlap" <| fun _ -> + let r1 = { Start = pos 3 3; End = pos 3 7 } + let r2 = { Start = pos 3 8; End = pos 3 11 } + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isFalse overlap "Should not overlap" + + testCase "ranges with same End/Start overlap" <| fun _ -> + let r1 = { Start = pos 2 3; End = pos 3 7 } + let r2 = { Start = pos 3 7; End = pos 4 11 } + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isTrue overlap "Should overlap" + + testCase "ranges with same Start/End overlap" <| fun _ -> + let r1 = { Start = pos 3 7; End = pos 4 11 } + let r2 = { Start = pos 2 3; End = pos 3 7 } + + let overlap = Range.overlapsStrictly r2 r1 + Expect.isTrue overlap "Should overlap" + + testCase "position ranges on same position overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 2 5} + let r2 = { Start = pos 2 5; End = pos 2 5} + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isTrue overlap "Should overlap" + + testCase "same ranges overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 2 5; End = pos 3 7} + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isTrue overlap "Should overlap" + + testCase "completely inside overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 5 7} + let r2 = { Start = pos 3 1; End = pos 4 3} + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isTrue overlap "Should overlap" + let overlap = Range.overlapsStrictly r2 r1 + Expect.isTrue overlap "Should overlap" + + testCase "overlapping ranges overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 3 1; End = pos 5 6} + + let overlap = Range.overlapsStrictly r1 r2 + Expect.isTrue overlap "Should overlap" + let overlap = Range.overlapsStrictly r2 r1 + Expect.isTrue overlap "Should overlap" + ] + + let private overlapsLooselyTests = testList (nameof Range.overlapsLoosely) [ + testCase "completely distinct ranges on different lines don't overlap" <| fun _ -> + let r1 = { Start = pos 1 3; End = pos 2 7 } + let r2 = { Start = pos 4 5; End = pos 7 8 } + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isFalse overlap "Should not overlap" + + testCase "completely distinct ranges on same line don't overlap" <| fun _ -> + let r1 = { Start = pos 3 3; End = pos 3 7 } + let r2 = { Start = pos 3 8; End = pos 3 11 } + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isFalse overlap "Should not overlap" + + testCase "ranges with same End/Start don't overlap" <| fun _ -> + let r1 = { Start = pos 2 3; End = pos 3 7 } + let r2 = { Start = pos 3 7; End = pos 4 11 } + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isFalse overlap "Should not overlap" + + testCase "ranges with same Start/End don't overlap" <| fun _ -> + let r1 = { Start = pos 3 7; End = pos 4 11 } + let r2 = { Start = pos 2 3; End = pos 3 7 } + + let overlap = Range.overlapsLoosely r2 r1 + Expect.isFalse overlap "Should not overlap" + + testCase "position ranges on same position don't overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 2 5} + let r2 = { Start = pos 2 5; End = pos 2 5} + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isFalse overlap "Should not overlap" + + testCase "same ranges overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 2 5; End = pos 3 7} + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isTrue overlap "Should overlap" + + testCase "completely inside overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 5 7} + let r2 = { Start = pos 3 1; End = pos 4 3} + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isTrue overlap "Should overlap" + let overlap = Range.overlapsLoosely r2 r1 + Expect.isTrue overlap "Should overlap" + + testCase "overlapping ranges overlap" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 3 1; End = pos 5 6} + + let overlap = Range.overlapsLoosely r1 r2 + Expect.isTrue overlap "Should overlap" + let overlap = Range.overlapsLoosely r2 r1 + Expect.isTrue overlap "Should overlap" + ] + + let isDisjointStrictlyTests = testList (nameof Range.isDisjointStrictly) [ + testCase "completely distinct ranges on different lines are disjoint" <| fun _ -> + let r1 = { Start = pos 1 3; End = pos 2 7 } + let r2 = { Start = pos 4 5; End = pos 7 8 } + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isTrue disjoint "Should be disjoint" + + testCase "completely distinct ranges on same line are disjoint" <| fun _ -> + let r1 = { Start = pos 3 3; End = pos 3 7 } + let r2 = { Start = pos 3 8; End = pos 3 11 } + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isTrue disjoint "Should be disjoint" + + testCase "ranges with same End/Start aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 3; End = pos 3 7 } + let r2 = { Start = pos 3 7; End = pos 4 11 } + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "ranges with same Start/End aren't disjoint" <| fun _ -> + let r1 = { Start = pos 3 7; End = pos 4 11 } + let r2 = { Start = pos 2 3; End = pos 3 7 } + + let disjoint = Range.isDisjointStrictly r2 r1 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "position ranges on same position aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 2 5} + let r2 = { Start = pos 2 5; End = pos 2 5} + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "same ranges aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 2 5; End = pos 3 7} + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "completely inside aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 5 7} + let r2 = { Start = pos 3 1; End = pos 4 3} + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + let disjoint = Range.isDisjointStrictly r2 r1 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "overlapping ranges aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 3 1; End = pos 5 6} + + let disjoint = Range.isDisjointStrictly r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + let disjoint = Range.isDisjointStrictly r2 r1 + Expect.isFalse disjoint "Should not be disjoint" + ] + + let isDisjointLooselyTests = testList (nameof Range.isDisjointLoosely) [ + testCase "completely distinct ranges on different lines are disjoint" <| fun _ -> + let r1 = { Start = pos 1 3; End = pos 2 7 } + let r2 = { Start = pos 4 5; End = pos 7 8 } + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isTrue disjoint "Should be disjoint" + + testCase "completely distinct ranges on same line are disjoint" <| fun _ -> + let r1 = { Start = pos 3 3; End = pos 3 7 } + let r2 = { Start = pos 3 8; End = pos 3 11 } + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isTrue disjoint "Should be disjoint" + + testCase "ranges with same End/Start aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 3; End = pos 3 7 } + let r2 = { Start = pos 3 7; End = pos 4 11 } + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isTrue disjoint "Should be disjoint" + + testCase "ranges with same Start/End aren't disjoint" <| fun _ -> + let r1 = { Start = pos 3 7; End = pos 4 11 } + let r2 = { Start = pos 2 3; End = pos 3 7 } + + let disjoint = Range.isDisjointLoosely r2 r1 + Expect.isTrue disjoint "Should be disjoint" + + testCase "position ranges on same position are disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 2 5} + let r2 = { Start = pos 2 5; End = pos 2 5} + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isTrue disjoint "Should be disjoint" + + testCase "same ranges aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 2 5; End = pos 3 7} + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "completely inside aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 5 7} + let r2 = { Start = pos 3 1; End = pos 4 3} + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + let disjoint = Range.isDisjointLoosely r2 r1 + Expect.isFalse disjoint "Should not be disjoint" + + testCase "overlapping ranges aren't disjoint" <| fun _ -> + let r1 = { Start = pos 2 5; End = pos 3 7} + let r2 = { Start = pos 3 1; End = pos 5 6} + + let disjoint = Range.isDisjointLoosely r1 r2 + Expect.isFalse disjoint "Should not be disjoint" + let disjoint = Range.isDisjointLoosely r2 r1 + Expect.isFalse disjoint "Should not be disjoint" + ] + + let tests = testList (nameof Range) [ + touchesTests + overlapsStrictlyTests + overlapsLooselyTests + isDisjointStrictlyTests + isDisjointLooselyTests + ] + +module private Text = + let private trimTripleQuotationTests = testList (nameof Text.trimTripleQuotation) [ + let check input expected = + let actual = input |> Text.trimTripleQuotation + Expect.equal actual expected "Invalid trimming" + + testList "normal string" [ + testCase "empty string" <| fun _ -> + let text = "" + let expected = text + check text expected + testCase "single line with text" <| fun _ -> + let text = "foo bar" + let expected = text + check text expected + testCase "multi lines with text without indentation" <| fun _ -> + let text = "foo bar\nlorem ipsum\ndolor\nsit" + let expected = text + check text expected + testCase "leading new line and no indentation" <| fun _ -> + let text = "\nfoo bar\nlorem ipsum\ndolor\nsit" + let expected = text.Substring 1 + check text expected + testCase "single line with indentation" <| fun _ -> + let text = " foo bar" + let expected = text.TrimStart() + check text expected + testCase "multi lines with all same indentation" <| fun _ -> + let text = " foo bar\n lorem ipsum\n dolor sit" + let expected = "foo bar\nlorem ipsum\ndolor sit" + check text expected + testCase "multi lines with all different indentation" <| fun _ -> + let text = " foo bar\n lorem ipsum\n dolor sit" + let expected = " foo bar\nlorem ipsum\n dolor sit" + check text expected + testCase "leading new line and multi line with all different indentation" <| fun _ -> + let text = "\n foo bar\n lorem ipsum\n dolor sit" + let expected = " foo bar\nlorem ipsum\n dolor sit" + check text expected + testCase "multi lines with empty lines" <| fun _ -> + let text = " foo bar\n \n baz\n lorem ipsum\n \n\n dolor sit\n \n ---" + let expected = "foo bar\n\nbaz\n lorem ipsum\n \n\ndolor sit\n\n ---" + check text expected + testCase "last whitespace line gets trimmed" <| fun _ -> + let text = "foo bar\n " + let expected = "foo bar\n" + check text expected + testCase "whitespace in last line doesn't get trimmed if there are other chars" <| fun _ -> + let text = "foo bar\nbaz " + let expected = text + check text expected + testCase "trim leading nl, indentation, trailing whitespace line" <| fun _ -> + let text = "\n foo bar\n\n baz\n lorem ipsum\n dolor sit\n " + let expected = "foo bar\n\n baz\nlorem ipsum\n dolor sit\n" + check text expected + ] + testList "triple quotation" [ + testCase "fsharp code written on beginning of line" <| fun _ -> + let text = """ +module Foo + +let rec handle (a: int) = +if a = 15 then + failwith "Oh no!" +else + match a with + | 42 -> printfn "42" + | i when i < 42 -> + handle (i+1) + | _ -> + // i > 42 + let a = + a + 17 + handle a + +let a = 42 +if a < 12 then +printfn "Result=%A" a +else +handle a + """ + let expected = """module Foo + +let rec handle (a: int) = +if a = 15 then + failwith "Oh no!" +else + match a with + | 42 -> printfn "42" + | i when i < 42 -> + handle (i+1) + | _ -> + // i > 42 + let a = + a + 17 + handle a + +let a = 42 +if a < 12 then +printfn "Result=%A" a +else +handle a +""" // whitespace in last empty line is trimmed, but `\n` is kept + check text expected + testCase "fsharp code written with indention to match surrounding code" <| fun _ -> + let text = """ + module Foo + + let rec handle (a: int) = + if a = 15 then + failwith "Oh no!" + else + match a with + | 42 -> printfn "42" + | i when i < 42 -> + handle (i+1) + | _ -> + // i > 42 + let a = + a + 17 + handle a + + let a = 42 + if a < 12 then + printfn "Result=%A" a + else + handle a + """ + let expected = """module Foo + +let rec handle (a: int) = + if a = 15 then + failwith "Oh no!" + else + match a with + | 42 -> printfn "42" + | i when i < 42 -> + handle (i+1) + | _ -> + // i > 42 + let a = + a + 17 + handle a + +let a = 42 +if a < 12 then + printfn "Result=%A" a +else + handle a +""" + check text expected + testCase "trimming already trimmed string doesn't change string" <| fun _ -> + let text = """ + module Foo + + let rec handle (a: int) = + if a = 15 then + failwith "Oh no!" + else + match a with + | 42 -> printfn "42" + | i when i < 42 -> + handle (i+1) + | _ -> + // i > 42 + let a = + a + 17 + handle a + + let a = 42 + if a < 12 then + printfn "Result=%A" a + else + handle a + """ + let once = text |> Text.trimTripleQuotation + let twice = once |> Text.trimTripleQuotation + Expect.equal twice once "trimming should not change a trimmed string" + testCase "independent trimmings should trim same" <| fun _ -> + let text = """ + module Foo + + let rec handle (a: int) = + if a = 15 then + failwith "Oh no!" + else + match a with + | 42 -> printfn "42" + | i when i < 42 -> + handle (i+1) + | _ -> + // i > 42 + let a = + a + 17 + handle a + + let a = 42 + if a < 12 then + printfn "Result=%A" a + else + handle a + """ + let a = text |> Text.trimTripleQuotation + let b = text |> Text.trimTripleQuotation + Expect.equal b a "both trimmings should be same" + ] + ] + let tests = testList (nameof Text) [ + trimTripleQuotationTests + ] + +let tests = testList (nameof Utils) [ + Expect.tests + Range.tests + Text.tests +] diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Utils.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Utils.fs new file mode 100644 index 000000000..e039936d1 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Utils/Utils.fs @@ -0,0 +1,275 @@ +module Utils.Utils + +module Expect = + open FsAutoComplete.Utils + open Expecto + + let failureMatching (m: AssertException -> bool) (f: Async<_>) = async { + let failed = async { + try + do! f |> Async.map ignore + return false + with + | :? AssertException as ex when m ex -> return true + // keep other exceptions + } + + let! failed = failed + if not failed then + failtestf "Expected AssertException, but was no exception" + } + /// passed Async `f` is expected to throw `Expecto.AssertException` + /// -> Expecto Test in `f` is expected to fail + /// + /// ~ Basically fancy `Async` wrapper for `Expect.throwsT` + /// + /// Note: `failwith` doesn't trigger success (throws `System.Exception`). Use `failtest` instead + let failure f = failureMatching (fun _ -> true) f + +module private Seq = + let tryMin source = + source + |> Seq.fold (fun m e -> + match m with + | None -> Some e + | Some m -> Some (min m e) + ) None + +module Position = + open Ionide.LanguageServerProtocol.Types + + let inline assertPositive (pos: Position) = + assert(pos.Line >= 0) + assert(pos.Character >= 0) + + let inline eq p1 p2 = + // p1.Line = p2.Line && p1.Character = p2.Character + p1 = p2 + let inline gt p1 p2 = + p1.Line > p2.Line || (p1.Line = p2.Line && p1.Character > p2.Character) + let inline geq p1 p2 = eq p1 p2 || gt p1 p2 + let inline lt p1 p2 = gt p2 p1 + let inline leq p1 p2 = geq p2 p1 + +/// Note: Always assumes correct order inside Range: `Start <= End` +module Range = + open Ionide.LanguageServerProtocol.Types + + // Strict: no touching + // Loose: touching + + + /// Range represents a single position (`Start = End`) + let inline isPosition (range: Range) = + range.Start = range.End + + /// Strict: `pos` on `Start` or `End` of `range` counts as containing + /// + /// ```text + /// -----------------------------------> + /// ^^^^^^^^^^^^^^^^^ range + /// ^ ^ ^ ^ ^ false + /// | | | ┕ true + /// | | ┕ true + /// | ┕ true + /// ┕ false + /// ``` + let inline containsStrictly (pos: Position) (range: Range) = + // range.Start <= pos <= range.End + Position.leq range.Start pos && Position.leq pos range.End + + /// Loose: `pos` on `Start` or `End` of `range` doesn't count as containing + /// + /// ```text + /// -----------------------------------> + /// ^^^^^^^^^^^^^^^^^ range + /// ^ ^ ^ ^ ^ false + /// | | | ┕ false + /// | | ┕ true + /// | ┕ false + /// ┕ false + /// ``` + let inline containsLoosely (pos: Position) (range: Range) = + // range.Start < pos < range.End + Position.leq range.Start pos && Position.leq pos range.End + + /// ```text + /// -----------------------------------> + /// ^^^^^^^^^^^^^^^^^ range + /// ^ ^ ^ ^ ^ false + /// | | | ┕ true + /// | | ┕ false + /// | ┕ true + /// ┕ false + /// ``` + let inline onBorder (pos: Position) (range: Range) = + pos = range.Start || pos = range.End + + /// Share a Start/End or End/Start, but nothing else. + /// + /// ```text + /// --------------------------> + /// ^^^^^^^ + /// | | ^^^^^^^^ false + /// | ^^^^^^^^ true + /// ^^^^^^^^ false + /// ^^^^^^ false + /// ^^^ false + /// ^ true + /// ^^^ true + /// ``` + let inline touches (range1: Range) (range2: Range) = + range1.Start = range2.End || range1.End = range2.Start + + /// Strict: Just sharing a Start/End (touching) counts as overlap too + /// + /// ```text + /// --------------------------> + /// ^^^^^^^ + /// | | ^^^^^^^^ false + /// | ^^^^^^^^ true + /// ^^^^^^^^ true + /// ^^^^^^^ true + /// ``` + let overlapsStrictly (range1: Range) (range2: Range) = + range1 |> containsStrictly range2.Start + || + range1 |> containsStrictly range2.End + || + range2 |> containsStrictly range1.Start + || + range2 |> containsStrictly range1.End + + /// Loose: Touching doesn't count as overlapping. + /// Neither does both just position and same position + /// + /// ```text + /// --------------------------> + /// ^^^^^^^ + /// | | | ^^^^^^^^ false + /// | | ^^^^^^^^ false + /// | ^^^^^^^^ true + /// ^^^^^^^ true + /// ``` + /// ```text + /// --------------------------> + /// ^ + /// | ^ false + /// ^ false + /// ^^^^ false + /// ^^^^^^ true + /// ``` + let overlapsLoosely (range1: Range) (range2: Range) = + (range1 |> overlapsStrictly range2) + && + not (range1 |> touches range2) + + /// Strict: Touching is not disjoint + /// + /// ```text + /// --------------------------> + /// ^^^^^^^ + /// | | ^^^^^^^^ true + /// | ^^^^^^^^ false + /// | ^ false + /// ^^^^^^^^ false + /// ``` + let isDisjointStrictly (range1: Range) (range2: Range) = + not <| overlapsStrictly range1 range2 + /// Loose: Touching is disjoint + /// + /// ```text + /// --------------------------> + /// ^^^^^^^ + /// | | ^^^^^^^^ true + /// | ^^^^^^^^ true + /// | ^ true + /// ^^^^^^^^ false + /// ``` + let isDisjointLoosely (range1: Range) (range2: Range) = + not <| overlapsLoosely range1 range2 + + +module Text = + open System + + let inline assertNoCarriageReturn (text: string) = + if text.Contains '\r' then + Expecto.Tests.failtest "Text contains `\\r` (either alone or as `\\r\\n`). But only `\\n` is supported" + let removeCarriageReturn (text: string) = + text.Replace("\r\n", "\n").Replace("\r", "\n") + + /// Note: only works with `\n`, but fails with `\r`! + let lines (text: string) = + assertNoCarriageReturn text + text.Split '\n' + + /// remove leading `\n` from triple quoted string with text starting in next line + let private trimLeadingNewLine (text: string) = + if text.StartsWith '\n' then + text.Substring 1 + else + text + /// remove trailing whitespace from last line, if last line is otherwise empty. + /// Note: keeps the `\n`! + /// Note: doesn't trim a single line with just whitespace -> requires at least one `\n` + let private trimLastWhitespacesLine (text: string) = + match text.LastIndexOf '\n' with + | -1 -> text + | i -> + let tail = text.AsSpan(i+1) + if not tail.IsEmpty && tail.IsWhiteSpace() then + text.Substring(0, i+1) + else + text + /// remove trailing last line, if last line is empty. + /// Unlike `trimLastWhitespacesLine` this removes the trailing `\n` too + /// Note: doesn't trim a single line with just whitespace -> requires at least one `\n` + let private trimTrailingEmptyLine (text: string) = + match text.LastIndexOf '\n' with + | -1 -> + text + | i when text.AsSpan().Slice(i).IsWhiteSpace() -> // `\n` is whitespace + text.Substring(0, i) + | _ -> text + + let getIndentation (line: string) = + line.Length - line.AsSpan().TrimStart().Length + let private detectIndentation (text: string) = + text + |> lines + |> Seq.filter (not << String.IsNullOrWhiteSpace) + |> Seq.map getIndentation + |> Seq.tryMin + |> Option.defaultValue 0 + + let private trimIndentation (text: string) = + match text |> detectIndentation with + | 0 -> text + | ind -> + text + |> lines + |> Seq.map (fun line -> + if line.Length <= ind then + assert(line |> String.IsNullOrWhiteSpace) + "" + else + line.Substring ind + ) + |> String.concat "\n" + + /// Trim: + /// * Leading `\n` from triple quotes string with text starting in next line + /// * indentation (measured for non-empty lines) + /// * Trailing whitespace in otherwise empty last line + /// Note: `\n` isn't removed + /// + /// Note: Asserts the passed text contains no `\r` (neither `\r` nor `\r\n`). + /// It doesn't replace `\r` with `\n` but instead fails! + let trimTripleQuotation (text: string) = + assertNoCarriageReturn text + + text + |> trimLeadingNewLine + |> trimIndentation + |> trimLastWhitespacesLine