diff --git a/.vscode/launch.json b/.vscode/launch.json index c5ba1a784..9237446c0 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -78,7 +78,7 @@ "args": [ "--debug", "--filter", - "FSAC.lsp.${input:loader}.${input:testName}" + "FSAC.lsp.${input:loader}.${input:lsp-server}.${input:testName}" ] } ], @@ -103,6 +103,17 @@ "default": "WorkspaceLoader", "type": "pickString" }, + + { + "id": "lsp-server", + "description": "The lsp serrver", + "options": [ + "FSharpLspServer", + "AdaptiveLspServer" + ], + "default": "FSharpLspServer", + "type": "pickString" + }, { "id": "testName", "description": "the name of the test as provided to `testCase`", diff --git a/paket.dependencies b/paket.dependencies index e853b8c67..c1c7c7755 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -50,6 +50,7 @@ nuget YoloDev.Expecto.TestSdk nuget AltCover nuget GitHubActionsTestLogger nuget Ionide.LanguageServerProtocol +nuget Microsoft.Extensions.Caching.Memory group Build source https://api.nuget.org/v3/index.json diff --git a/paket.lock b/paket.lock index b916a8568..828b430c0 100644 --- a/paket.lock +++ b/paket.lock @@ -176,12 +176,33 @@ NUGET System.Text.Encoding.CodePages (>= 4.0.1) - restriction: || (&& (== net7.0) (< net6.0)) (== netstandard2.0) Microsoft.CodeCoverage (17.3) - restriction: || (== net6.0) (== net7.0) (&& (== netstandard2.0) (>= net45)) (&& (== netstandard2.0) (>= netcoreapp1.0)) Microsoft.DotNet.PlatformAbstractions (3.1.6) - restriction: || (== net6.0) (== net7.0) (&& (== netstandard2.0) (>= net5.0)) + Microsoft.Extensions.Caching.Abstractions (6.0) + Microsoft.Extensions.Primitives (>= 6.0) + Microsoft.Extensions.Caching.Memory (6.0.1) + Microsoft.Extensions.Caching.Abstractions (>= 6.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 6.0) + Microsoft.Extensions.Logging.Abstractions (>= 6.0) + Microsoft.Extensions.Options (>= 6.0) + Microsoft.Extensions.Primitives (>= 6.0) + Microsoft.Extensions.DependencyInjection.Abstractions (6.0) + Microsoft.Bcl.AsyncInterfaces (>= 6.0) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0) + System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0) Microsoft.Extensions.DependencyModel (6.0) - restriction: || (== net6.0) (== net7.0) (&& (== netstandard2.0) (>= net5.0)) System.Buffers (>= 4.5.1) System.Memory (>= 4.5.4) System.Runtime.CompilerServices.Unsafe (>= 6.0) System.Text.Encodings.Web (>= 6.0) System.Text.Json (>= 6.0) + Microsoft.Extensions.Logging.Abstractions (6.0.2) + System.Buffers (>= 4.5.1) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< net6.0)) (== netstandard2.0) + System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< net6.0)) (== netstandard2.0) + Microsoft.Extensions.Options (6.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 6.0) + Microsoft.Extensions.Primitives (>= 6.0) + System.ComponentModel.Annotations (>= 5.0) - restriction: || (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0) + Microsoft.Extensions.Primitives (6.0) + System.Memory (>= 4.5.4) - restriction: || (&& (== net6.0) (>= net461)) (&& (== net6.0) (< netcoreapp3.1)) (&& (== net7.0) (>= net461)) (&& (== net7.0) (< netcoreapp3.1)) (== netstandard2.0) + System.Runtime.CompilerServices.Unsafe (>= 6.0) Microsoft.NET.StringTools (17.3.1) - copy_local: false System.Memory (>= 4.5.5) System.Runtime.CompilerServices.Unsafe (>= 6.0) @@ -319,6 +340,7 @@ NUGET System.Runtime.CompilerServices.Unsafe (>= 6.0) System.CommandLine (2.0.0-beta4.22272.1) System.Memory (>= 4.5.4) - restriction: || (&& (== net7.0) (< net6.0)) (== netstandard2.0) + System.ComponentModel.Annotations (5.0) - restriction: || (&& (== net6.0) (< netstandard2.1)) (&& (== net7.0) (< netstandard2.1)) (== netstandard2.0) System.Configuration.ConfigurationManager (6.0) System.Security.Cryptography.ProtectedData (>= 6.0) System.Security.Permissions (>= 6.0) diff --git a/src/FsAutoComplete.Core/CodeGeneration.fs b/src/FsAutoComplete.Core/CodeGeneration.fs index b5e9056dd..a990c2e9d 100644 --- a/src/FsAutoComplete.Core/CodeGeneration.fs +++ b/src/FsAutoComplete.Core/CodeGeneration.fs @@ -1,4 +1,4 @@ -/// Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/CodeGeneration/CodeGeneration.fs +// Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/CodeGeneration/CodeGeneration.fs namespace FsAutoComplete open System diff --git a/src/FsAutoComplete.Core/Commands.fs b/src/FsAutoComplete.Core/Commands.fs index 5afc3211e..64646f5a2 100644 --- a/src/FsAutoComplete.Core/Commands.fs +++ b/src/FsAutoComplete.Core/Commands.fs @@ -713,11 +713,9 @@ module Commands = let getSymbolUsesInProjects (symbol, projects: FSharpProjectOptions list, onFound) = projects - |> List.map (fun p -> - asyncResult { - for file in p.SourceFiles do - do! findReferencesInFile (file, symbol, p, onFound) - }) + |> List.collect (fun p -> + [ for file in p.SourceFiles do + yield findReferencesInFile (file, symbol, p, onFound) ]) |> Async.Parallel |> Async.map (Array.toList >> FsToolkit.ErrorHandling.List.sequenceResultM) @@ -770,9 +768,9 @@ module Commands = let symbolRange = symbol.DefinitionRange.NormalizeDriveLetterCasing() let symbolFile = symbolRange.TaggedFileName - let symbolFileText = + let! symbolFileText = tryGetFileSource (symbolFile) - |> Result.fold id (fun e -> failwith $"Unable to get file source for file '{symbolFile}'") + |> Result.mapError (fun e -> e + $"Unable to get file source for file '{symbolFile}'") let! symbolText = symbolFileText.[symbolRange] // |> Result.fold id (fun e -> failwith "Unable to get text for initial symbol use") @@ -790,37 +788,40 @@ module Commands = |> List.distinctBy (fun x -> x.ProjectFileName) let onFound (symbolUseRange: range) = - async { + asyncResult { let symbolUseRange = symbolUseRange.NormalizeDriveLetterCasing() let symbolFile = symbolUseRange.TaggedFileName - let targetText = tryGetFileSource (symbolFile) - - match targetText with - | Error e -> () - | Ok sourceText -> - let sourceSpan = - sourceText.[symbolUseRange] - |> Result.fold id (fun e -> failwith "Unable to get text for symbol use") - - // There are two kinds of ranges we get back: - // * ranges that exactly match the short name of the symbol - // * ranges that are longer than the short name of the symbol, - // typically because we're talking about some kind of fully-qualified usage - // For the latter, we need to adjust the reported range to just be the portion - // of the fully-qualfied text that is the symbol name. - if sourceSpan = symbolText then - symbolUseRanges.Add symbolUseRange - else - match sourceSpan.IndexOf(symbolText) with - | -1 -> () - | n -> - if sourceSpan.Length >= n + symbolText.Length then - let startPos = symbolUseRange.Start.IncColumn n - let endPos = symbolUseRange.Start.IncColumn(n + symbolText.Length) - - let actualUseRange = Range.mkRange symbolUseRange.FileName startPos endPos - symbolUseRanges.Add actualUseRange + let! sourceText = tryGetFileSource (symbolFile) + + + let! sourceSpan = + sourceText.[symbolUseRange] + |> Result.mapError (fun e -> e + "Unable to get text for symbol use") + + // There are two kinds of ranges we get back: + // * ranges that exactly match the short name of the symbol + // * ranges that are longer than the short name of the symbol, + // typically because we're talking about some kind of fully-qualified usage + // For the latter, we need to adjust the reported range to just be the portion + // of the fully-qualfied text that is the symbol name. + if sourceSpan = symbolText then + symbolUseRanges.Add symbolUseRange + else + match sourceSpan.IndexOf(symbolText) with + | -1 -> () + | n -> + if sourceSpan.Length >= n + symbolText.Length then + let startPos = symbolUseRange.Start.IncColumn n + let endPos = symbolUseRange.Start.IncColumn(n + symbolText.Length) + + let actualUseRange = Range.mkRange symbolUseRange.FileName startPos endPos + symbolUseRanges.Add actualUseRange } + |> Async.map (fun x -> + match x with + | Ok () -> () + | Error e -> + commandsLogger.info (Log.setMessage "OnFound failed: {errpr}" >> Log.addContextDestructured "error" e)) let! _ = getSymbolUsesInProjects (symbol, projects, onFound) diff --git a/src/FsAutoComplete.Core/CompilerServiceInterface.fs b/src/FsAutoComplete.Core/CompilerServiceInterface.fs index d983c3037..7bc6b751f 100644 --- a/src/FsAutoComplete.Core/CompilerServiceInterface.fs +++ b/src/FsAutoComplete.Core/CompilerServiceInterface.fs @@ -9,6 +9,11 @@ open Ionide.ProjInfo.ProjectSystem open FSharp.UMX open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols +open Microsoft.Extensions.Caching.Memory +open System +open FsToolkit.ErrorHandling + + type Version = int @@ -26,6 +31,9 @@ type FSharpCompilerServiceChecker(hasAnalyzers) = let entityCache = EntityCache() + let mutable lastCheckResults: IMemoryCache = + new MemoryCache(MemoryCacheOptions(SizeLimit = Nullable<_>(200L))) + let checkerLogger = LogProvider.getLoggerByName "Checker" let optsLogger = LogProvider.getLoggerByName "Opts" @@ -227,6 +235,14 @@ type FSharpCompilerServiceChecker(hasAnalyzers) = member __.ScriptTypecheckRequirementsChanged = scriptTypecheckRequirementsChanged.Publish + /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation. + member _.ClearCaches() = + let oldlastCheckResults = lastCheckResults + lastCheckResults <- new MemoryCache(MemoryCacheOptions(SizeLimit = Nullable<_>(20L))) + oldlastCheckResults.Dispose() + checker.InvalidateAll() + checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() + member __.ParseFile(fn: string, source, fpo) = checkerLogger.info (Log.setMessage "ParseFile - {file}" >> Log.addContextDestructured "file" fn) @@ -234,7 +250,7 @@ type FSharpCompilerServiceChecker(hasAnalyzers) = checker.ParseFile(path, source, fpo) member __.ParseAndCheckFileInProject(filePath: string, version, source: ISourceText, options) = - async { + asyncResult { let opName = sprintf "ParseAndCheckFileInProject - %A" filePath checkerLogger.info (Log.setMessage "{opName}" >> Log.addContextDestructured "opName" opName) @@ -255,18 +271,34 @@ type FSharpCompilerServiceChecker(hasAnalyzers) = >> Log.addContextDestructured "errors" (List.ofArray p.Diagnostics) ) - return ResultOrString.Error(sprintf "Check aborted (%A). Errors: %A" c parseErrors) + return! ResultOrString.Error(sprintf "Check aborted (%A). Errors: %A" c parseErrors) | FSharpCheckFileAnswer.Succeeded (c) -> checkerLogger.info ( Log.setMessage "{opName} completed successfully" >> Log.addContextDestructured "opName" opName ) - return Ok(ParseAndCheckResults(p, c, entityCache)) + let r = ParseAndCheckResults(p, c, entityCache) + + let ops = + MemoryCacheEntryOptions() + .SetSize(1) + .SetSlidingExpiration(TimeSpan.FromMinutes(2.)) + + return lastCheckResults.Set(filePath, r, ops) with ex -> - return ResultOrString.Error(ex.ToString()) + return! ResultOrString.Error(ex.ToString()) } + member _.TryGetLastCheckResultForFile(file: string) = + let opName = sprintf "TryGetLastCheckResultForFile - %A" file + + checkerLogger.info (Log.setMessage "{opName}" >> Log.addContextDestructured "opName" opName) + + match lastCheckResults.TryGetValue(file) with + | (true, v) -> Some v + | _ -> None + member __.TryGetRecentCheckResultsForFile(file: string, options, source: ISourceText) = let opName = sprintf "TryGetRecentCheckResultsForFile - %A" file @@ -274,13 +306,21 @@ type FSharpCompilerServiceChecker(hasAnalyzers) = Log.setMessage "{opName} - {hash}" >> Log.addContextDestructured "opName" opName >> Log.addContextDestructured "hash" (source.GetHashCode() |> int) + ) let options = clearProjectReferences options let result = checker.TryGetRecentCheckResultsForFile(UMX.untag file, options, sourceText = source, userOpName = opName) - |> Option.map (fun (pr, cr, _) -> ParseAndCheckResults(pr, cr, entityCache)) + |> Option.map (fun (pr, cr, version) -> + checkerLogger.info ( + Log.setMessage "{opName} - got results - {version}" + >> Log.addContextDestructured "opName" opName + >> Log.addContextDestructured "version" version + ) + + ParseAndCheckResults(pr, cr, entityCache)) checkerLogger.info ( Log.setMessage "{opName} - {hash} - cacheHit {cacheHit}" diff --git a/src/FsAutoComplete.Core/FileSystem.fs b/src/FsAutoComplete.Core/FileSystem.fs index e8b2b9b30..edbe18105 100644 --- a/src/FsAutoComplete.Core/FileSystem.fs +++ b/src/FsAutoComplete.Core/FileSystem.fs @@ -144,7 +144,7 @@ type NamedText(fileName: string, str: string) = // because we know there are lines after the first line let firstLine = (x :> ISourceText).GetLineString(m.StartLine - 1) - builder.AppendLine(firstLine.Substring(m.StartColumn)) + builder.AppendLine(firstLine.Substring(Math.Min(firstLine.Length, m.StartColumn))) |> ignore // whole intermediate lines, including newlines @@ -155,7 +155,7 @@ type NamedText(fileName: string, str: string) = // final part, potential slice, so we do not include the trailing newline let lastLine = (x :> ISourceText).GetLineString(m.EndLine - 1) - builder.Append(lastLine.Substring(0, m.EndColumn)) + builder.Append(lastLine.Substring(0, Math.Min(lastLine.Length, m.EndColumn))) |> ignore Ok(builder.ToString()) @@ -260,8 +260,8 @@ type NamedText(fileName: string, str: string) = member x.ModifyText(m: FSharp.Compiler.Text.Range, text: string) : Result = result { let startRange, endRange = x.SplitAt(m) - let! startText = x[startRange] - let! endText = x[endRange] + let! startText = x[startRange] |> Result.mapError (fun x -> $"startRange -> {x}") + and! endText = x[endRange] |> Result.mapError (fun x -> $"endRange -> {x}") let totalText = startText + text + endText return NamedText(x.FileName, totalText) } @@ -355,6 +355,8 @@ type VolatileFile = Lines: NamedText Version: int option } + member this.FileName = this.Lines.FileName + /// Updates the Lines value member this.SetLines(lines) = { this with Lines = lines } @@ -407,11 +409,18 @@ type FileSystem(actualFs: IFileSystem, tryFindFile: string -> Volatil let fsLogger = LogProvider.getLoggerByName "FileSystem" let getContent (filename: string) = - fsLogger.debug (Log.setMessage "Getting content of `{path}`" >> Log.addContext "path" filename) + filename |> tryFindFile - |> Option.map (fun file -> file.Lines.ToString() |> System.Text.Encoding.UTF8.GetBytes) + |> Option.map (fun file -> + fsLogger.debug ( + Log.setMessage "Getting content of `{path}` - {hash}" + >> Log.addContext "path" filename + >> Log.addContext "hash" (file.Lines.GetHashCode()) + ) + file.Lines.ToString() |> System.Text.Encoding.UTF8.GetBytes + ) /// translation of the BCL's Windows logic for Path.IsPathRooted. /// @@ -455,12 +464,18 @@ type FileSystem(actualFs: IFileSystem, tryFindFile: string -> Volatil expanded - member _.GetLastWriteTimeShim(f: string) = - f - |> Utils.normalizePath - |> tryFindFile - |> Option.map (fun f -> f.Touched) - |> Option.defaultWith (fun () -> actualFs.GetLastWriteTimeShim f) + member _.GetLastWriteTimeShim(filename: string) = + let result = + filename + |> Utils.normalizePath + |> tryFindFile + |> Option.map (fun f -> f.Touched) + |> Option.defaultWith (fun () -> actualFs.GetLastWriteTimeShim filename) + + fsLogger.debug (Log.setMessage "GetLastWriteTimeShim of `{path}` - {date} " + >> Log.addContext "path" filename + >> Log.addContext "date" result) + result member _.NormalizePathShim(f: string) = f |> Utils.normalizePath |> UMX.untag diff --git a/src/FsAutoComplete.Core/Lexer.fs b/src/FsAutoComplete.Core/Lexer.fs index 88f831ef9..0d1303b4f 100644 --- a/src/FsAutoComplete.Core/Lexer.fs +++ b/src/FsAutoComplete.Core/Lexer.fs @@ -247,7 +247,7 @@ module Lexer = | StaticallyResolvedTypeParameter | Keyword -> true | _ -> false) - /// Gets the option if Some x, otherwise try to get another value + // Gets the option if Some x, otherwise try to get another value |> Option.orElseWith (fun _ -> tokensUnderCursor |> List.tryFind (fun { DraftToken.Kind = k } -> k = Operator)) |> Option.map (fun token -> diff --git a/src/FsAutoComplete.Core/ParseAndCheckResults.fs b/src/FsAutoComplete.Core/ParseAndCheckResults.fs index fbf6d1a0d..fa39c0c78 100644 --- a/src/FsAutoComplete.Core/ParseAndCheckResults.fs +++ b/src/FsAutoComplete.Core/ParseAndCheckResults.fs @@ -549,6 +549,11 @@ type ParseAndCheckResults let residue = longName.PartialIdent + logger.info ( + Log.setMessage "TryGetCompletions - lineStr: {lineStr}" + >> Log.addContextDestructured "lineStr" lineStr + ) + logger.info ( Log.setMessage "TryGetCompletions - long name: {longName}" >> Log.addContextDestructured "longName" longName @@ -581,9 +586,8 @@ type ParseAndCheckResults | Some k when k.Kind = Operator -> return None | Some k when k.Kind = Keyword -> return None | _ -> - let results = - checkResults.GetDeclarationListInfo(Some parseResults, pos.Line, lineStr, longName, getAllSymbols) + checkResults.GetDeclarationListInfo(Some parseResults, pos.Line, lineStr, longName, getSymbols) let getKindPriority = function diff --git a/src/FsAutoComplete.Core/TypedAstPatterns.fs b/src/FsAutoComplete.Core/TypedAstPatterns.fs index 1a623f9dd..bbec371dd 100644 --- a/src/FsAutoComplete.Core/TypedAstPatterns.fs +++ b/src/FsAutoComplete.Core/TypedAstPatterns.fs @@ -254,7 +254,7 @@ module SymbolUse = | _ -> None [] -/// Active patterns over `FSharpSymbol`. +// Active patterns over `FSharpSymbol`. module SymbolPatterns = let private attributeSuffixLength = "Attribute".Length diff --git a/src/FsAutoComplete.Core/TypedAstUtils.fs b/src/FsAutoComplete.Core/TypedAstUtils.fs index 63d0d8871..2ae1b3601 100644 --- a/src/FsAutoComplete.Core/TypedAstUtils.fs +++ b/src/FsAutoComplete.Core/TypedAstUtils.fs @@ -1,4 +1,4 @@ -///Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/Common/TypedAstUtils.fs +//Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/Common/TypedAstUtils.fs namespace FsAutoComplete open System diff --git a/src/FsAutoComplete.Core/paket.references b/src/FsAutoComplete.Core/paket.references index 2290a3a13..323acb9d2 100644 --- a/src/FsAutoComplete.Core/paket.references +++ b/src/FsAutoComplete.Core/paket.references @@ -13,3 +13,4 @@ System.Reflection.Metadata Microsoft.Build.Utilities.Core Ionide.LanguageServerProtocol Ionide.KeepAChangelog.Tasks +Microsoft.Extensions.Caching.Memory diff --git a/src/FsAutoComplete/CodeFixes.fs b/src/FsAutoComplete/CodeFixes.fs index b6cde1051..378b0e289 100644 --- a/src/FsAutoComplete/CodeFixes.fs +++ b/src/FsAutoComplete/CodeFixes.fs @@ -1,5 +1,5 @@ -/// This module contains the logic for codefixes that FSAC surfaces, as well as conversion logic between -/// compiler diagnostics and LSP diagnostics/code actions +// This module contains the logic for codefixes that FSAC surfaces, as well as conversion logic between +// compiler diagnostics and LSP diagnostics/code actions namespace FsAutoComplete.CodeFix open FsAutoComplete diff --git a/src/FsAutoComplete/CodeFixes/ResolveNamespace.fs b/src/FsAutoComplete/CodeFixes/ResolveNamespace.fs index a76bdff02..bd5522bed 100644 --- a/src/FsAutoComplete/CodeFixes/ResolveNamespace.fs +++ b/src/FsAutoComplete/CodeFixes/ResolveNamespace.fs @@ -30,29 +30,38 @@ let fix let adjustInsertionPoint (lines: ISourceText) (ctx: InsertionContext) = let l = ctx.Pos.Line - match ctx.ScopeKind with - | ScopeKind.TopModule when l > 1 -> - let line = lines.GetLineString(l - 2) - - let isImplicitTopLevelModule = - not (line.StartsWith "module" && not (line.EndsWith "=")) - - if isImplicitTopLevelModule then 1 else l - | ScopeKind.TopModule -> 1 - | ScopeKind.Namespace -> - let mostRecentNamespaceInScope = - let lineNos = if l = 0 then [] else [ 0 .. l - 1 ] - - lineNos - |> List.mapi (fun i line -> i, lines.GetLineString line) - |> List.choose (fun (i, lineStr) -> if lineStr.StartsWith "namespace" then Some i else None) - |> List.tryLast - - match mostRecentNamespaceInScope with - // move to the next line below "namespace" and convert it to F# 1-based line number - | Some line -> line + 2 - | None -> l - | _ -> l + let retVal = + match ctx.ScopeKind with + | ScopeKind.TopModule when l > 1 -> + let line = lines.GetLineString(l - 2) + + let isImplicitTopLevelModule = + not (line.StartsWith "module" && not (line.EndsWith "=")) + + if isImplicitTopLevelModule then 1 else l + | ScopeKind.TopModule -> 1 + | ScopeKind.Namespace -> + let mostRecentNamespaceInScope = + let lineNos = if l = 0 then [] else [ 0 .. l - 1 ] + + lineNos + |> List.mapi (fun i line -> i, lines.GetLineString line) + |> List.choose (fun (i, lineStr) -> if lineStr.StartsWith "namespace" then Some i else None) + |> List.tryLast + + match mostRecentNamespaceInScope with + // move to the next line below "namespace" and convert it to F# 1-based line number + | Some line -> line + 2 + | None -> l + | _ -> l + + let containsAttribute (x: string) = x.Contains "[<" + let currentLine = System.Math.Max(retVal - 2, 0) |> lines.GetLineString + + if currentLine |> containsAttribute then + retVal + 1 + else + retVal let qualifierFix file diagnostic qual = { SourceDiagnostic = Some diagnostic @@ -76,22 +85,26 @@ let fix ns let lineStr = - let whitespace = String.replicate ctx.Pos.Column " " + let whitespace = + let column = + // HACK: This is a work around for inheriting the correct column of the current module + // It seems the column we get from FCS is incorrect + let previousLine = docLine - 1 + let insertionPointIsNotOutOfBoundsOfTheFile = docLine > 0 + + let theThereAreOtherOpensInThisModule () = + text.GetLineString(previousLine).Contains "open " + + if insertionPointIsNotOutOfBoundsOfTheFile && theThereAreOtherOpensInThisModule () then + text.GetLineString(previousLine).Split("open") |> Seq.head |> Seq.length // inherit the previous opens whitespace + else + ctx.Pos.Column + + String.replicate column " " + $"%s{whitespace}open %s{actualOpen}\n" - let edits = - [| yield insertLine docLine lineStr - if - text.GetLineCount() < docLine + 1 - && text.GetLineString(docLine + 1).Trim() <> "" - then - yield insertLine (docLine + 1) "" - if - (ctx.Pos.Column = 0 || ctx.ScopeKind = ScopeKind.Namespace) - && docLine > 0 - && not (text.GetLineString(docLine - 1).StartsWith "open") - then - yield insertLine (docLine - 1) "" |] + let edits = [| yield insertLine docLine lineStr |] { Edits = edits File = file diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index b026413b1..7ead25333 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -164,7 +164,7 @@ module AMap = /// Adaptively applies the given mapping function to all elements and returns a new amap containing the results. let mapAdaptiveValue mapper (map: amap<_, aval<'b>>) = - map |> AMap.mapA (fun k v -> AVal.map mapper v) + map |> AMap.mapA (fun k v -> AVal.map (mapper k) v) [] @@ -211,7 +211,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar transact (fun () -> config.Value <- c) mutableConfigChanges |> AVal.force - let tfmConfig = config |> AVal.map (fun c -> @@ -235,11 +234,11 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let diagnosticCollections = new DiagnosticCollection(sendDiagnostics) - let notifications = Event() + let notifications = Event() let scriptFileProjectOptions = Event() - let handleCommandEvents (n: NotificationEvent) = + let handleCommandEvents (n: NotificationEvent, ct: CancellationToken) = try async { try @@ -432,19 +431,20 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar () } - |> Async.RunSynchronouslyWithCT CancellationToken.None - + |> Async.RunSynchronouslyWithCT ct with :? OperationCanceledException as e -> () + do disposables.Add( (notifications.Publish :> IObservable<_>) - .BufferedDebounce(TimeSpan.FromMilliseconds(200.)) - .SelectMany(fun l -> l.Distinct()) + // .BufferedDebounce(TimeSpan.FromMilliseconds(200.)) + // .SelectMany(fun l -> l.Distinct()) .Subscribe(fun e -> handleCommandEvents e) ) + let adaptiveFile (filePath: string) = let file = AdaptiveFile.GetLastWriteTimeUtc(UMX.untag filePath) @@ -520,10 +520,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar projects |> Seq.iter (fun (proj: string, _) -> - UMX.untag proj - |> ProjectResponse.ProjectLoading - |> NotificationEvent.Workspace - |> notifications.Trigger) + let not = + UMX.untag proj |> ProjectResponse.ProjectLoading |> NotificationEvent.Workspace + + notifications.Trigger(not, CancellationToken.None)) let projectOptions = loader.LoadProjects(projects |> Seq.map (fst >> UMX.untag) |> Seq.toList) @@ -562,6 +562,8 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar projectOptions, additionalDependencies) + and! checker = checker + checker.ClearCaches() // if we got new projects assume we're gonna need to clear caches let options = projectOptions @@ -598,13 +600,12 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ProjectItems = projViewerItemsNormalized.Items Additionals = Map.empty } - ProjectResponse.Project(ws, false) - |> NotificationEvent.Workspace - |> notifications.Trigger) + let not = ProjectResponse.Project(ws, false) |> NotificationEvent.Workspace + notifications.Trigger(not, CancellationToken.None)) + + let not = ProjectResponse.WorkspaceLoad true |> NotificationEvent.Workspace - ProjectResponse.WorkspaceLoad true - |> NotificationEvent.Workspace - |> notifications.Trigger + notifications.Trigger(not, CancellationToken.None) return options |> List.map fst }) @@ -613,35 +614,153 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let fantomasLogger = LogProvider.getLoggerByName "Fantomas" let fantomasService: FantomasService = new LSPFantomasService() :> FantomasService + let openFilesTokens = + cmap, cval> () + + + let openFilesTokensA = + openFilesTokens |> AMap.map (fun _ v -> v :> aval<_>) + let openFiles = - cmap, cval> () + cmap, cval> () + + let openFilesA = openFiles |> AMap.map (fun _ v -> v :> aval<_>) + + let textChanges = cmap, cset> () + + let textChangesA = textChanges |> AMap.map (fun _ x -> x :> aset<_>) + + let openFilesWithChanges: amap<_, aval> = + + openFilesA + |> AMap.map (fun filePath file -> + aval { + let! (file) = file + and! changes = textChangesA |> AMap.tryFind filePath + + match changes with + | None -> return (file) + | Some c -> + let! ps = c |> ASet.toAVal + + let changes = + ps + |> Seq.sortBy (fun x -> x.TextDocument.Version.Value) + |> Seq.collect (fun p -> p.ContentChanges |> Array.map (fun x -> x, p.TextDocument.Version.Value)) + + let file = + (file, changes) + ||> Seq.fold (fun text (change, version) -> + match change.Range with + | None -> // replace entire content + // We want to update the DateTime here since TextDocumentDidChange will not have changes reflected on disk + VolatileFile.Create(filePath, change.Text, Some version, DateTime.UtcNow) + | Some rangeToReplace -> + // replace just this slice + let fcsRangeToReplace = protocolRangeToRange (UMX.untag filePath) rangeToReplace + + try + match text.Lines.ModifyText(fcsRangeToReplace, change.Text) with + | Ok text -> VolatileFile.Create(text, Some version, DateTime.UtcNow) + + | Error message -> + logger.error ( + Log.setMessage + "Error applying {change} to document {file} for version {version} - {range} : {message} " + >> Log.addContextDestructured "file" filePath + >> Log.addContextDestructured "version" version + >> Log.addContextDestructured "message" message + >> Log.addContextDestructured "range" fcsRangeToReplace + >> Log.addContextDestructured "change" change + ) - let openFilesA = openFiles |> AMap.map' (fun v -> v :> aval<_>) + text + with e -> + logger.error ( + Log.setMessage "Error applying {change} to document {file} for version {version} - {range}" + >> Log.addContextDestructured "file" filePath + >> Log.addContextDestructured "range" fcsRangeToReplace + >> Log.addContextDestructured "version" version + >> Log.addContextDestructured "change" change + >> Log.addExn e + ) + + text) + + return (file) + }) + + + let resetFileVal (fileVal: cval<_>) = + let cts: CancellationTokenSource = fileVal |> AVal.force + + try + logger.info ( + Log.setMessage "Cancelling {filePath} - {version}" + >> Log.addContextDestructured "filePath" fileVal + // >> Log.addContextDestructured "version" oldFile.Version + ) + + cts.Cancel() + cts.Dispose() + with + | :? OperationCanceledException + | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") -> + // ignore if already cancelled + () + + transact (fun () -> fileVal.Value <- new CancellationTokenSource()) + + let resetCancellationToken filePath = + openFilesTokens |> AMap.tryFind filePath |> AVal.force |> Option.iter (resetFileVal) + + let adder _ = + cval (new CancellationTokenSource()) + + let updater _ (v: cval<_>) = + resetFileVal v - let cancelAllOpenFileCheckRequests () = transact (fun () -> - let files = openFiles |> AMap.force + openFilesTokens.AddOrElse(filePath, adder, updater) + ) - for (_, fileVal) in files do - let (oldFile, cts: CancellationTokenSource) = fileVal |> AVal.force - cts.Cancel() - cts.Dispose() - fileVal.Value <- oldFile, new CancellationTokenSource()) + let resetAllCancellationTokens () = + let files = openFilesTokens |> AMap.force - let updateOpenFiles (file: VolatileFile) = + for (_, fileVal) in files do + resetFileVal fileVal + let updateOpenFiles (file: VolatileFile) = let adder _ = - cval (file, new CancellationTokenSource()) + cval file let updater _ (v: cval<_>) = - let (oldFile, cts: CancellationTokenSource) = v.Value - cts.Cancel() - cts.Dispose() - v.Value <- file, new CancellationTokenSource() + v.Value <- file + + transact (fun () -> + resetCancellationToken file.FileName + openFiles.AddOrElse(file.Lines.FileName, adder, updater) + ) + + let updateTextchanges filePath p = + let adder _ = cset<_> [ p ] + let updater _ (v: cset<_>) = v.Add p |> ignore + + transact (fun () -> + resetCancellationToken filePath + textChanges.AddOrElse(filePath, adder, updater)) + + let isFileOpen file = + openFilesA |> AMap.tryFindA file |> AVal.map (Option.isSome) - transact (fun () -> openFiles.AddOrElse(file.Lines.FileName, adder, updater)) + let findFileInOpenFiles' file = + openFilesWithChanges |> AMap.tryFindA file - let findFileInOpenFiles file = openFilesA |> AMap.tryFindA file + let findFileInOpenFiles file = + findFileInOpenFiles' file + + let forceFindOpenFile filePath = + findFileInOpenFiles filePath |> AVal.force let forceFindOpenFileOrRead file = findFileInOpenFiles file @@ -660,7 +779,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar Lines = NamedText(file, change) Version = None } - (file, new CancellationTokenSource()) |> Some + Some file else None with e -> @@ -673,42 +792,52 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar None) |> Result.ofOption (fun () -> $"Could not read file: {file}") - let forceFindOpenFile filePath = - findFileInOpenFiles filePath |> AVal.force |> Option.map fst + do FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem <- FileSystem(FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem, forceFindOpenFile) let forceFindSourceText filePath = - forceFindOpenFileOrRead filePath |> Result.map (fun (f, _) -> f.Lines) + forceFindOpenFileOrRead filePath |> Result.map (fun f -> f.Lines) - let openFilesToProjectOptions = - openFilesA - |> AMap.mapAdaptiveValue (fun (info, cts) -> - let file = info.Lines.FileName - if Utils.isAScript (UMX.untag file) then - (checker, tfmConfig) - ||> AVal.map2 (fun checker tfm -> - let opts = - checker.GetProjectOptionsFromScript(file, info.Lines, tfm) - |> Async.RunSynchronouslyWithCTSafe(fun () -> cts.Token) + let getProjectOptionsForFile' getFile (filePath: string) = + aval { + if Utils.isAScript (UMX.untag filePath) then + let! checker = checker + and! tfmConfig = tfmConfig + and! (openFile : Option<_>) = getFile filePath + and! cts = openFilesTokensA |> AMap.tryFindA filePath + return + option { + let! (info : VolatileFile) = openFile + and! cts = cts - opts |> Option.iter (scriptFileProjectOptions.Trigger) - opts |> Option.map List.singleton |> Option.defaultValue List.empty) + let! opts = + checker.GetProjectOptionsFromScript(filePath, info.Lines, tfmConfig) + |> Async.RunSynchronouslyWithCTSafe(fun () -> cts.Token) + opts |> scriptFileProjectOptions.Trigger + return opts + } + |> Option.toList else - loadedProjectOptions - |> AVal.map (fun opts -> + let! opts = loadedProjectOptions + + return opts - |> List.filter (fun (opts) -> opts.SourceFiles |> Array.map Utils.normalizePath |> Array.contains (file)))) + |> List.filter (fun (opts) -> opts.SourceFiles |> Array.map Utils.normalizePath |> Array.contains (filePath)) + } - let getProjectOptionsForFile file = - openFilesToProjectOptions - |> AMap.tryFind file - |> AVal.bind (Option.defaultValue (AVal.constant [])) + + let getProjectOptionsForFile (filePath: string) = + getProjectOptionsForFile' findFileInOpenFiles' filePath + + let openFilesToProjectOptions = + openFilesWithChanges + |> AMap.map (fun name file -> getProjectOptionsForFile' (fun _ -> AVal.map Some file) name) let autoCompleteItems: cmap * (Position -> option) * FSharp.Compiler.Syntax.ParsedInput> = cmap () @@ -728,10 +857,12 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let checkUnusedOpens = async { try + let! ct = Async.CancellationToken + let! unused = UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, (fun i -> (source: ISourceText).GetLineString(i - 1))) - notifications.Trigger(NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray))) + notifications.Trigger(NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray)), ct) with e -> logger.error (Log.setMessage "checkUnusedOpens failed" >> Log.addExn e) } @@ -739,11 +870,12 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let checkUnusedDeclarations = async { try + let! ct = Async.CancellationToken let isScript = Utils.isAScript (UMX.untag filePath) let! unused = UnusedDeclarations.getUnusedDeclarations (tyRes.GetCheckResults, isScript) let unused = unused |> Seq.toArray - notifications.Trigger(NotificationEvent.UnusedDeclarations(filePath, unused)) + notifications.Trigger(NotificationEvent.UnusedDeclarations(filePath, unused), ct) with e -> logger.error (Log.setMessage "checkUnusedDeclarations failed" >> Log.addExn e) } @@ -753,9 +885,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar try let getSourceLine lineNo = source.GetLineString(lineNo - 1) + let! ct = Async.CancellationToken let! simplified = SimplifyNames.getSimplifiableNames (tyRes.GetCheckResults, getSourceLine) let simplified = Array.ofSeq simplified - notifications.Trigger(NotificationEvent.SimplifyNames(filePath, simplified)) + notifications.Trigger(NotificationEvent.SimplifyNames(filePath, simplified), ct) with e -> logger.error (Log.setMessage "checkSimplifiedNames failed" >> Log.addExn e) } @@ -790,14 +923,17 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar >> Log.addContextDestructured "date" (file.Touched) ) + // HACK: Insurance for a bug where FCS invalidates graph nodes incorrectly and seems to typecheck forever use cts = new CancellationTokenSource() cts.CancelAfter(TimeSpan.FromSeconds(60.)) let! result = - checker.ParseAndCheckFileInProject(file.Lines.FileName, (file.Lines.GetHashCode()), file.Lines, opts) + Debug.measureAsync $"checker.ParseAndCheckFileInProject - {file.Lines.FileName}" + <| checker.ParseAndCheckFileInProject(file.Lines.FileName, (file.Lines.GetHashCode()), file.Lines, opts) |> Async.withCancellation cts.Token - notifications.Trigger(NotificationEvent.FileParsed(file.Lines.FileName)) + let! ct = Async.CancellationToken + notifications.Trigger(NotificationEvent.FileParsed(file.Lines.FileName), ct) match result with | Error e -> @@ -814,55 +950,93 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar >> Log.addContextDestructured "file" file.Lines.FileName ) + Async.Start( + async { + let checkErrors = parseAndCheck.GetParseResults.Diagnostics + let parseErrors = parseAndCheck.GetCheckResults.Diagnostics - let checkErrors = parseAndCheck.GetParseResults.Diagnostics - let parseErrors = parseAndCheck.GetCheckResults.Diagnostics + let errors = + Array.append checkErrors parseErrors + |> Array.distinctBy (fun e -> + e.Severity, e.ErrorNumber, e.StartLine, e.StartColumn, e.EndLine, e.EndColumn, e.Message) - let errors = - Array.append checkErrors parseErrors - |> Array.distinctBy (fun e -> - e.Severity, e.ErrorNumber, e.StartLine, e.StartColumn, e.EndLine, e.EndColumn, e.Message) + notifications.Trigger(NotificationEvent.ParseError(errors, file.Lines.FileName), ct) + }, + ct + ) - NotificationEvent.ParseError(errors, file.Lines.FileName) - |> notifications.Trigger + Async.Start(analyzeFile config (file.Lines.FileName, file.Version, file.Lines, parseAndCheck), ct) + Async.Start( + async { + // HACK: LargeObjectHeap gets fragmented easily for really large files, which F# can easily have. + // Yes this seems excessive doing this every time we type check but it's the best current kludge. + // It maybe better to set default environment variables from https://learn.microsoft.com/en-us/dotnet/core/runtime-config/garbage-collector + // instead of manually calling this, specifically the `DOTNET_GCConserveMemory` variable. + System.Runtime.GCSettings.LargeObjectHeapCompactionMode <- + System.Runtime.GCLargeObjectHeapCompactionMode.CompactOnce + + // GC.Collect() + // GC.WaitForPendingFinalizers() + }, + ct + ) - do! analyzeFile config (file.Lines.FileName, file.Version, file.Lines, parseAndCheck) + return parseAndCheck + } - // LargeObjectHeap gets fragmented easily for really large files, which F# can easily have. - // Yes this seems excessive doing this every time we type check but it's the best current kludge. - System.Runtime.GCSettings.LargeObjectHeapCompactionMode <- - System.Runtime.GCLargeObjectHeapCompactionMode.CompactOnce - GC.Collect() - GC.WaitForPendingFinalizers() + let typeCheckerTokens = + new System.Collections.Concurrent.ConcurrentDictionary, CancellationTokenSource>() - return parseAndCheck - } + let getCTForFile filePath = + let add x = new CancellationTokenSource() + + let update x (typeCheckerToken: CancellationTokenSource) = + typeCheckerToken.Cancel() + // typeCheckerToken.Dispose() + new CancellationTokenSource() + + typeCheckerTokens.AddOrUpdate(filePath, add, update).Token + + let cancelCTForFile filePath = getCTForFile filePath |> ignore /// Bypass Adaptive checking and tell the checker to check a file - let forceTypeCheck f = + let forceTypeCheck f opts = async { - logger.info (Log.setMessage "Forced Check : {file}" >> Log.addContextDestructured "file" f) - let checker = checker |> AVal.force - let config = config |> AVal.force + try + logger.info (Log.setMessage "Forced Check : {file}" >> Log.addContextDestructured "file" f) + let checker = checker |> AVal.force + let config = config |> AVal.force - match findFileInOpenFiles f |> AVal.force, getProjectOptionsForFile f |> AVal.force |> List.tryHead with - | Some (fileInfo, _), Some (opts) -> return! parseAndCheckFile checker fileInfo opts config |> Async.Ignore - | _, _ -> () + let opts = + opts + |> Option.orElseWith (fun () -> getProjectOptionsForFile f |> AVal.force |> Seq.tryHead) + + match forceFindOpenFileOrRead f, opts with + | Ok (fileInfo), Some opts -> return! parseAndCheckFile checker fileInfo opts config |> Async.Ignore + | _, _ -> () + with e -> + + logger.warn ( + Log.setMessage "Forced Check error : {file}" + >> Log.addContextDestructured "file" f + >> Log.addExn e + ) } let openFilesToParsedResults = - openFilesA - |> AMap.mapAdaptiveValue (fun (info, cts) -> + openFilesWithChanges + |> AMap.mapAdaptiveValue (fun _ (info) -> aval { let file = info.Lines.FileName let! checker = checker and! projectOptions = getProjectOptionsForFile file + and! cts = openFilesTokensA |> AMap.tryFindA file - match List.tryHead projectOptions with - | Some opts -> + match List.tryHead projectOptions, cts with + | Some opts, Some cts -> return Debug.measure "parseFile" <| fun () -> @@ -870,13 +1044,13 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar checker.ParseFile(file, info.Lines, opts) |> Async.RunSynchronouslyWithCTSafe(fun () -> cts.Token) - | None -> return None + | _ -> return None }) let openFilesToRecentCheckedFilesResults = - openFilesA - |> AMap.mapAdaptiveValue (fun (info, _) -> + openFilesWithChanges + |> AMap.mapAdaptiveValue (fun _ (info) -> aval { let file = info.Lines.FileName let! checker = checker @@ -887,28 +1061,29 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let parseAndCheck = checker.TryGetRecentCheckResultsForFile(file, opts, info.Lines) return parseAndCheck - | None -> return None + | _ -> return None }) let openFilesToCheckedFilesResults = - openFilesA - |> AMap.mapAdaptiveValue (fun (info, cts) -> + openFilesWithChanges + |> AMap.mapAdaptiveValue (fun _ (info) -> aval { let file = info.Lines.FileName let! checker = checker and! projectOptions = getProjectOptionsForFile file and! config = config + and! cts = openFilesTokensA |> AMap.tryFindA file - match List.tryHead projectOptions with - | Some (opts) -> + match List.tryHead projectOptions, cts with + | Some (opts), Some cts -> let parseAndCheck = - Debug.measure "parseAndCheckFile" + Debug.measure $"parseAndCheckFile - {file}" <| fun () -> parseAndCheckFile checker info opts config |> Async.RunSynchronouslyWithCTSafe(fun () -> cts.Token) return parseAndCheck - | None -> return None + | _ -> return None }) let getParseResults filePath = @@ -930,23 +1105,45 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar |> Result.ofOption (fun () -> $"No parse results for {filePath}") let forceGetTypeCheckResults filePath = - let tyResults = getTypeCheckResults (filePath) + let rec doIt tryAgain = + let result = + let tyResults = getTypeCheckResults (filePath) + + match getRecentTypeCheckResults filePath |> AVal.force with + | Some s -> + if lock tyResults (fun () -> tyResults.OutOfDate) then + Async.Start(async { tyResults |> AVal.force |> ignore }) + + Some s + | None -> tyResults |> AVal.force + |> Result.ofOption (fun () -> $"No typecheck results for {filePath}") + + match result with + | Error e when tryAgain -> + // mark this file as outdated to force typecheck + transact (fun () -> + (openFilesA |> AMap.tryFind filePath |> AVal.force) + |> Option.iter (fun x -> x.MarkOutdated())) - match getRecentTypeCheckResults filePath |> AVal.force with - | Some s -> - if lock tyResults (fun () -> tyResults.OutOfDate) then - Async.Start(async { tyResults |> AVal.force |> ignore }) + doIt false + | Error e -> Error e + | Ok x -> Ok x - Some s - | None -> tyResults |> AVal.force - |> Result.ofOption (fun () -> $"No typecheck results for {filePath}") + doIt true - let openFilesToCheckedDeclarations = + let openFilesToCheckedDeclarations () = openFilesToCheckedFilesResults - |> AMap.map' (AVal.mapOption (fun parseAndCheck -> parseAndCheck.GetParseResults.GetNavigationItems().Declarations)) + |> AMap.force + |> HashMap.map (fun _ v -> + v + |> AVal.mapOption (fun c -> c.GetParseResults.GetNavigationItems().Declarations) + |> AVal.force) let getDeclarations filename = - openFilesToCheckedDeclarations |> AMap.tryFindAndFlatten (filename) + // openFilesToCheckedDeclarations |> AMap.tryFindAndFlatten (filename) + openFilesToCheckedFilesResults + |> AMap.tryFindAndFlatten filename + |> AVal.mapOption (fun c -> c.GetParseResults.GetNavigationItems().Declarations) let getFilePathAndPosition (p: ITextDocumentPositionParams) = let filePath = p.GetFilePath() |> Utils.normalizePath @@ -963,7 +1160,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar { new ICodeGenerationService with member x.TokenizeLine(file, i) = option { - let! (text, _) = forceFindOpenFileOrRead file |> Option.ofResult + let! (text) = forceFindOpenFileOrRead file |> Option.ofResult try let! line = text.Lines.GetLine(Position.mkPos i 0) @@ -975,7 +1172,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar member x.GetSymbolAtPosition(file, pos) = option { try - let! (text, _) = forceFindOpenFileOrRead file |> Option.ofResult + let! (text) = forceFindOpenFileOrRead file |> Option.ofResult let! line = tryGetLineStr pos text.Lines |> Option.ofResult return! Lexer.getSymbol pos.Line pos.Column line SymbolLookupKind.Fuzzy [||] with _ -> @@ -983,14 +1180,14 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar } member x.GetSymbolAndUseAtPositionOfKind(fileName, pos, kind) = - asyncMaybe { + asyncOption { let! symbol = x.GetSymbolAtPosition(fileName, pos) if symbol.Kind = kind then - let! (text, _) = forceFindOpenFileOrRead fileName |> Option.ofResult + let! (text) = forceFindOpenFileOrRead fileName |> Option.ofResult let! line = tryGetLineStr pos text.Lines |> Option.ofResult - let! result = forceGetTypeCheckResults fileName |> Option.ofResult - let symbolUse = result.TryGetSymbolUse pos line + let! tyRes = forceGetTypeCheckResults fileName |> Option.ofResult + let symbolUse = tyRes.TryGetSymbolUse pos line return! Some(symbol, symbolUse) else return! None @@ -1004,9 +1201,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let tryGetParseResultsForFile filePath pos = asyncResult { - let! (file, _) = forceFindOpenFileOrRead filePath + let! (file) = forceFindOpenFileOrRead filePath let! lineStr = file.Lines |> tryGetLineStr pos - let! tyRes = forceGetTypeCheckResults filePath + and! tyRes = forceGetTypeCheckResults filePath return tyRes, lineStr, file.Lines } @@ -1051,7 +1248,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let writeAbstractClassStub = AbstractClassStubGenerator.writeAbstractClassStub codeGenServer - let foo bar fizz = fizz * fizz let getAbstractClassStub tyRes objExprRange lines lineStr = Commands.getAbstractClassStub @@ -1160,14 +1356,22 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar false)) |> AVal.force + let thisShouldBeASettingToTurnOffHoldingFilesInMemory = false - if doesNotExist filePath || isOutsideWorkspace filePath then + if + thisShouldBeASettingToTurnOffHoldingFilesInMemory + || doesNotExist filePath + || isOutsideWorkspace filePath + then logger.info ( Log.setMessage "Removing cached data for {file}." >> Log.addContext "file" filePath ) - transact (fun () -> openFiles.Remove filePath |> ignore) + transact (fun () -> + openFiles.Remove filePath |> ignore + textChanges.Remove filePath |> ignore) + diagnosticCollections.ClearFor(uri) else logger.info ( @@ -1175,6 +1379,80 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar >> Log.addContext "file" filePath ) + let getDependentFilesForFile file = + let projects = getProjectOptionsForFile file |> AVal.force + + projects + |> List.toArray + |> Array.collect (fun proj -> + logger.info ( + Log.setMessage "Source Files: {sourceFiles}" + >> Log.addContextDestructured "sourceFiles" proj.SourceFiles + ) + + let idx = proj.SourceFiles |> Array.findIndex (fun x -> x = UMX.untag file) + + proj.SourceFiles + |> Array.splitAt idx + |> snd + |> Array.map (fun sourceFile -> proj, sourceFile)) + |> Array.distinct + + let getDependentProjectsOfProjects ps = + let projectSnapshot = loadedProjectOptions |> AVal.force + + let allDependents = System.Collections.Generic.HashSet() + + let currentPass = ResizeArray() + currentPass.AddRange(ps |> List.map (fun p -> p.ProjectFileName)) + + let mutable continueAlong = true + + while continueAlong do + let dependents = + projectSnapshot + |> Seq.filter (fun p -> + p.ReferencedProjects + |> Seq.exists (fun r -> + match r.ProjectFilePath with + | None -> false + | Some p -> currentPass.Contains(p))) + + if Seq.isEmpty dependents then + continueAlong <- false + currentPass.Clear() + else + for d in dependents do + allDependents.Add d |> ignore + + currentPass.Clear() + currentPass.AddRange(dependents |> Seq.map (fun p -> p.ProjectFileName)) + + Seq.toList allDependents + + let forceCheckDepenenciesForFile filePath = + async { + let dependentFiles = getDependentFilesForFile filePath + + let dependentProjects = + getProjectOptionsForFile filePath + |> AVal.force + |> getDependentProjectsOfProjects + |> List.toArray + |> Array.collect (fun proj -> proj.SourceFiles |> Array.map (fun sourceFile -> proj, sourceFile)) + + do! + Array.concat [| dependentFiles; dependentProjects |] + |> Array.map (fun (proj, file) -> + let file = UMX.tag file + let token = getCTForFile file + + forceTypeCheck (file) (Some proj) + |> Async.withCancellationSafe (fun () -> token)) + |> Seq.toArray // Force iteration + |> Async.Sequential + |> Async.Ignore + } let symbolUseWorkspace pos lineStr text tyRes = @@ -1193,37 +1471,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar |> AVal.force |> Seq.tryFind (fun x -> x.ProjectFileName = file) - let getDependentProjectsOfProjects ps = - let projectSnapshot = loadedProjectOptions |> AVal.force - - let allDependents = System.Collections.Generic.HashSet() - - let currentPass = ResizeArray() - currentPass.AddRange(ps |> List.map (fun p -> p.ProjectFileName)) - - let mutable continueAlong = true - - while continueAlong do - let dependents = - projectSnapshot - |> Seq.filter (fun p -> - p.ReferencedProjects - |> Seq.exists (fun r -> - match r.ProjectFilePath with - | None -> false - | Some p -> currentPass.Contains(p))) - - if Seq.isEmpty dependents then - continueAlong <- false - currentPass.Clear() - else - for d in dependents do - allDependents.Add d |> ignore - - currentPass.Clear() - currentPass.AddRange(dependents |> Seq.map (fun p -> p.ProjectFileName)) - - Seq.toList allDependents let getDeclarationLocation (symUse, text) = SymbolLocation.getDeclarationLocation ( @@ -1462,52 +1709,13 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar updateConfig c workspacePaths.Value <- WorkspaceChosen.Projs(HashSet.ofList projs)) + let defaultSettings = + { Helpers.defaultServerCapabilities with + TextDocumentSync = + Helpers.defaultServerCapabilities.TextDocumentSync + |> Option.map (fun x -> { x with Change = Some TextDocumentSyncKind.Incremental }) } - return - { InitializeResult.Default with - Capabilities = - { ServerCapabilities.Default with - HoverProvider = Some true - RenameProvider = Some(U2.First true) - DefinitionProvider = Some true - TypeDefinitionProvider = Some true - ImplementationProvider = Some true - ReferencesProvider = Some true - DocumentHighlightProvider = Some true - DocumentSymbolProvider = Some true - WorkspaceSymbolProvider = Some true - DocumentFormattingProvider = Some true - DocumentRangeFormattingProvider = Some true - SignatureHelpProvider = - Some - { TriggerCharacters = Some [| '('; ','; ' ' |] - RetriggerCharacters = Some [| ','; ')'; ' ' |] } - CompletionProvider = - Some - { ResolveProvider = Some true - TriggerCharacters = Some([| '.'; ''' |]) - AllCommitCharacters = None //TODO: what chars shoudl commit completions? - } - CodeLensProvider = Some { CodeLensOptions.ResolveProvider = Some true } - CodeActionProvider = - Some - { CodeActionKinds = None - ResolveProvider = None } - TextDocumentSync = - Some - { TextDocumentSyncOptions.Default with - OpenClose = Some true - Change = Some TextDocumentSyncKind.Full - Save = Some { IncludeText = Some true } } - FoldingRangeProvider = Some true - SelectionRangeProvider = Some true - SemanticTokensProvider = - Some - { Legend = - createTokenLegend - Range = Some true - Full = Some(U2.First true) } - InlayHintProvider = Some { ResolveProvider = Some false } } } + return { InitializeResult.Default with Capabilities = defaultSettings } with e -> logger.error ( @@ -1547,11 +1755,15 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let doc = p.TextDocument let filePath = doc.GetFilePath() |> Utils.normalizePath - // We want to try to use the file system's datetime if available - let file = VolatileFile.Create(filePath, doc.Text, (Some doc.Version)) - updateOpenFiles file - forceGetTypeCheckResults filePath |> ignore - return () + + if isFileOpen filePath |> AVal.force then + return () + else + // We want to try to use the file system's datetime if available + let file = VolatileFile.Create(filePath, doc.Text, (Some doc.Version)) + updateOpenFiles file + forceGetTypeCheckResults filePath |> ignore + return () with e -> logger.error ( Log.setMessage "TextDocumentDidOpen Request Errored {p}" @@ -1592,17 +1804,24 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar >> Log.addContextDestructured "parms" p ) - let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath - let changes = p.ContentChanges |> Array.head + let doc = p.TextDocument + let filePath = doc.GetFilePath() |> Utils.normalizePath + resetAllCancellationTokens () + cancelCTForFile filePath + + updateTextchanges filePath p - // We want to update the DateTime here since TextDocumentDidChange will not have changes reflected on disk - // TODO: Incremental changes - let file = - VolatileFile.Create(filePath, changes.Text, p.TextDocument.Version, DateTime.UtcNow) + async { + do! Async.Sleep(10) + forceGetTypeCheckResults filePath |> ignore - updateOpenFiles file - forceGetTypeCheckResults filePath |> ignore + //! for smaller projects this isn't really an issue type checking all dependants but bigger ones it is + //? Should we have a setting to enable/disable this? + // do! forceCheckDepenenciesForFile filePath + + } + |> Async.Start return () with e -> @@ -1613,7 +1832,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) return () - } override __.TextDocumentDidSave(p) = @@ -1624,6 +1842,8 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar >> Log.addContextDestructured "parms" p ) + resetAllCancellationTokens () + let doc = p.TextDocument let filePath = doc.GetFilePath() |> Utils.normalizePath @@ -1637,25 +1857,18 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar // Very unlikely to get here VolatileFile.Create(filePath, p.Text.Value, None, DateTime.UtcNow)) - updateOpenFiles file - let knownFiles = openFilesA |> AMap.force - - logger.info ( - Log.setMessage "typechecking for files {files}" - >> Log.addContextDestructured "files" knownFiles - ) - - cancelAllOpenFileCheckRequests () - - for (file, aFile) in knownFiles do - let (_, cts) = aFile |> AVal.force + transact (fun () -> + updateOpenFiles file + textChanges.Remove filePath |> ignore) - do! - forceTypeCheck file - |> Async.withCancellationSafe (fun () -> cts.Token) - |> Async.Ignore + async { + do! Async.Sleep(10) + forceGetTypeCheckResults filePath |> ignore + do! lspClient.CodeLensRefresh() + do! forceCheckDepenenciesForFile filePath - do! lspClient.CodeLensRefresh() + } + |> Async.Start return () with e -> @@ -1679,19 +1892,16 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr - - let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr + let! (namedText2) = forceFindOpenFileOrRead filePath |> Result.ofStringErr - let completionList = - { IsIncomplete = false - Items = KeywordList.hashSymbolCompletionItems } + let! lineStr2 = namedText2.Lines |> tryGetLineStr pos |> Result.ofStringErr - if lineStr.StartsWith "#" then + if lineStr2.StartsWith "#" then let completionList = { IsIncomplete = false Items = KeywordList.hashSymbolCompletionItems } + return! success (Some completionList) else let config = AVal.force config @@ -1708,29 +1918,53 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let getCompletions = asyncResult { - let! typeCheckResults = forceGetTypeCheckResults filePath + + let! (namedText) = forceFindOpenFileOrRead filePath + let! lineStr = namedText.Lines |> tryGetLineStr pos + + let quickCheck = + aval { + let! checker = checker + return checker.TryGetLastCheckResultForFile(filePath) + } + + let! typeCheckResults = + asyncResult { + match AVal.force quickCheck with + | Some s -> return s + | None -> return! forceGetTypeCheckResults filePath + } let getAllSymbols () = if config.ExternalAutocomplete then typeCheckResults.GetAllEntities true else [] - - match! + // TextDocumentCompletion will sometimes come in before TextDocumentDidChange + // This will require the trigger character to be at the place VSCode says it is + // Otherwise we'll fail here and our retry logic will come into place + do! + match p.Context with + | Some ({ triggerKind = CompletionTriggerKind.TriggerCharacter } as context) -> + namedText.Lines.TryGetChar pos = context.triggerCharacter + | _ -> true + |> Result.requireTrue $"TextDocumentCompletion was sent before TextDocumentDidChange" + + + let! (decls, residue, shouldKeywords) = Debug.measure "TextDocumentCompletion.TryGetCompletions" (fun () -> - typeCheckResults.TryGetCompletions pos lineStr None getAllSymbols) - with - | None -> return None - | Some (decls, residue, shouldKeywords) -> - return Some(decls, residue, shouldKeywords, typeCheckResults, getAllSymbols) + typeCheckResults.TryGetCompletions pos lineStr None getAllSymbols + |> AsyncResult.ofOption (fun () -> "No TryGetCompletions results")) + + return Some(decls, residue, shouldKeywords, typeCheckResults, getAllSymbols, namedText) } match! - retryAsyncOption (TimeSpan.FromMilliseconds(100.)) 5 getCompletions + retryAsyncOption (TimeSpan.FromMilliseconds(10.)) 100 getCompletions |> AsyncResult.ofStringErr with - | None -> return! success (Some completionList) - | Some (decls, residue, shouldKeywords, typeCheckResults, getAllSymbols) -> + | None -> return! success (None) + | Some (decls, _, shouldKeywords, typeCheckResults, _, namedText) -> return! Debug.measure "TextDocumentCompletion.TryGetCompletions success" @@ -1834,7 +2068,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar else sym - let decls = openFilesToCheckedDeclarations |> AMap.force |> Seq.map (snd) + // let decls = openFilesToCheckedDeclarations |> AMap.force |> Seq.map (snd) match getAutoCompleteByDeclName sym |> AVal.force with | None -> //Isn't in sync filled cache, we don't have result @@ -1887,10 +2121,8 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr - - let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let charAtCaret = p.Context |> Option.bind (fun c -> c.TriggerCharacter) @@ -1946,9 +2178,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr match tyRes.TryGetToolTipEnhanced pos lineStr with | Ok (Some (tip, signature, footer, typeDoc)) -> @@ -2022,9 +2254,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! documentsAndRanges = @@ -2048,7 +2280,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let version = forceFindOpenFileOrRead namedText.FileName |> Option.ofResult - |> Option.bind (fun (f, _) -> f.Version) + |> Option.bind (fun (f) -> f.Version) { TextDocument = { Uri = Path.FilePathToUri(UMX.untag namedText.FileName) @@ -2077,10 +2309,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! decl = tyRes.TryFindDeclaration pos lineStr |> AsyncResult.ofStringErr return decl |> findDeclToLspLocation |> GotoResult.Single |> Some with e -> @@ -2103,9 +2335,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! decl = tyRes.TryFindTypeDeclaration pos lineStr |> AsyncResult.ofStringErr return decl |> findDeclToLspLocation |> GotoResult.Single |> Some with e -> @@ -2127,9 +2359,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = tryGetLineStr pos namedText.Lines |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! usages = symbolUseWorkspace pos lineStr namedText.Lines tyRes @@ -2167,9 +2399,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = tryGetLineStr pos namedText.Lines |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! (symbol, uses) = tyRes.TryGetSymbolUseAndUsages pos lineStr |> Result.ofStringErr @@ -2199,9 +2431,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = tryGetLineStr pos namedText.Lines |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr logger.info ( Log.setMessage "TextDocumentImplementation Request: {parms}" @@ -2295,10 +2527,8 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let glyphToSymbolKind = glyphToSymbolKind |> AVal.force let decls = - openFilesToCheckedDeclarations - |> AMap.force + openFilesToCheckedDeclarations () |> Seq.toArray - |> Array.map (fun (p, ns) -> p, AVal.force ns) |> Array.choose (fun (p, ns) -> ns |> Option.map (fun ns -> p, ns)) let res = @@ -2446,7 +2676,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let tryGetFileVersion filePath = forceFindOpenFileOrRead filePath |> Option.ofResult - |> Option.bind (fun (f, _) -> f.Version) + |> Option.bind (fun (f) -> f.Version) let clientCapabilities = clientCapabilities |> AVal.force @@ -2716,7 +2946,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar let getParseResultsForFile file = asyncResult { let! namedText = forceFindSourceText file - let! parseResults = forceGetParseResults file + and! parseResults = forceGetParseResults file return namedText, parseResults } @@ -2826,9 +3056,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let fcsRange = protocolRangeToRange (UMX.untag filePath) p.Range let config = config |> AVal.force @@ -3096,10 +3326,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! tip = Commands.typesig tyRes pos lineStr |> Result.ofCoreResponse return { Content = CommandResponse.typeSig FsAutoComplete.JsonSerializer.writeJson tip } @@ -3125,10 +3355,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar FSharp.Compiler.Text.Position.mkPos (p.Position.Line) (p.Position.Character + 2) let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! (typ, parms, generics) = tyRes.TryGetSignatureData pos lineStr |> Result.ofStringErr return @@ -3154,10 +3384,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! { InsertPosition = insertPos InsertText = text } = @@ -3175,7 +3405,7 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar NewText = text } |] } |] Changes = None } } - let! response = lspClient.WorkspaceApplyEdit edit + let! _ = lspClient.WorkspaceApplyEdit edit return () with e -> @@ -3468,9 +3698,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr let! t = Commands.Help tyRes pos lineStr |> Result.ofCoreResponse return { Content = CommandResponse.help FsAutoComplete.JsonSerializer.writeJson t } with e -> @@ -3492,9 +3722,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar ) let (filePath, pos) = getFilePathAndPosition p - let! (namedText, _) = forceFindOpenFileOrRead filePath |> Result.ofStringErr + let! (namedText) = forceFindOpenFileOrRead filePath |> Result.ofStringErr let! lineStr = namedText.Lines |> tryGetLineStr pos |> Result.ofStringErr - let! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr + and! tyRes = forceGetTypeCheckResults filePath |> Result.ofStringErr lastFSharpDocumentationTypeCheck <- Some tyRes let! t = Commands.FormattedDocumentation tyRes pos lineStr |> Result.ofCoreResponse return { Content = CommandResponse.formattedDocumentation FsAutoComplete.JsonSerializer.writeJson t } diff --git a/src/FsAutoComplete/LspServers/Common.fs b/src/FsAutoComplete/LspServers/Common.fs index 24d40c351..7e9ba4ac6 100644 --- a/src/FsAutoComplete/LspServers/Common.fs +++ b/src/FsAutoComplete/LspServers/Common.fs @@ -137,8 +137,15 @@ type DiagnosticCollection(sendDiagnostics: DocumentUri -> Diagnostic[] -> Async< cts.Cancel() module Async = + open FsAutoComplete.Logging + open FsAutoComplete.Logging.Types open System.Threading.Tasks + let rec logger = LogProvider.getLoggerByQuotation <@ logger @> + + let inline logCancelled e = + logger.trace (Log.setMessage "Operation Cancelled" >> Log.addExn e) + let withCancellation (ct: CancellationToken) (a: Async<'a>) : Async<'a> = async { let! ct2 = Async.CancellationToken @@ -165,11 +172,16 @@ module Async = let! result = withCancellation (ct ()) work return Some result with - | :? OperationCanceledException as e -> return None + | :? OperationCanceledException as e -> + logCancelled e + return None | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") -> + logCancelled e return None } + let StartWithCT ct work = Async.Start(work, ct) + let RunSynchronouslyWithCT ct work = Async.RunSynchronously(work, cancellationToken = ct) @@ -177,8 +189,12 @@ module Async = try work |> RunSynchronouslyWithCT(ct ()) |> Some with - | :? OperationCanceledException as e -> None - | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") -> None + | :? OperationCanceledException as e -> + logCancelled e + None + | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") -> + logCancelled e + None [] module ObservableExtensions = @@ -197,3 +213,47 @@ module Helpers = let ignoreNotification = async.Return(()) let fullPathNormalized = Path.GetFullPath >> Utils.normalizePath >> UMX.untag + + let defaultServerCapabilities = + { ServerCapabilities.Default with + HoverProvider = Some true + RenameProvider = Some(U2.First true) + DefinitionProvider = Some true + TypeDefinitionProvider = Some true + ImplementationProvider = Some true + ReferencesProvider = Some true + DocumentHighlightProvider = Some true + DocumentSymbolProvider = Some true + WorkspaceSymbolProvider = Some true + DocumentFormattingProvider = Some true + DocumentRangeFormattingProvider = Some true + SignatureHelpProvider = + Some + { TriggerCharacters = Some [| '('; ','; ' ' |] + RetriggerCharacters = Some [| ','; ')'; ' ' |] } + CompletionProvider = + Some + { ResolveProvider = Some true + TriggerCharacters = Some([| '.'; ''' |]) + AllCommitCharacters = None //TODO: what chars shoudl commit completions? + } + CodeLensProvider = Some { CodeLensOptions.ResolveProvider = Some true } + CodeActionProvider = + Some + { CodeActionKinds = None + ResolveProvider = None } + TextDocumentSync = + Some + { TextDocumentSyncOptions.Default with + OpenClose = Some true + Change = Some TextDocumentSyncKind.Incremental + Save = Some { IncludeText = Some true } } + FoldingRangeProvider = Some true + SelectionRangeProvider = Some true + SemanticTokensProvider = + Some + { Legend = + createTokenLegend + Range = Some true + Full = Some(U2.First true) } + InlayHintProvider = Some { ResolveProvider = Some false } } diff --git a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs index eaa723cae..df5166a5c 100644 --- a/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/LspServers/FsAutoComplete.Lsp.fs @@ -1243,50 +1243,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) = |> Async.Start return - { InitializeResult.Default with - Capabilities = - { ServerCapabilities.Default with - HoverProvider = Some true - RenameProvider = Some(U2.First true) - DefinitionProvider = Some true - TypeDefinitionProvider = Some true - ImplementationProvider = Some true - ReferencesProvider = Some true - DocumentHighlightProvider = Some true - DocumentSymbolProvider = Some true - WorkspaceSymbolProvider = Some true - DocumentFormattingProvider = Some true - DocumentRangeFormattingProvider = Some true - SignatureHelpProvider = - Some - { TriggerCharacters = Some [| '('; ','; ' ' |] - RetriggerCharacters = Some [| ','; ')'; ' ' |] } - CompletionProvider = - Some - { ResolveProvider = Some true - TriggerCharacters = Some([| '.'; ''' |]) - AllCommitCharacters = None //TODO: what chars shoudl commit completions? - } - CodeLensProvider = Some { CodeLensOptions.ResolveProvider = Some true } - CodeActionProvider = - Some - { CodeActionKinds = None - ResolveProvider = None } - TextDocumentSync = - Some - { TextDocumentSyncOptions.Default with - OpenClose = Some true - Change = Some TextDocumentSyncKind.Full - Save = Some { IncludeText = Some true } } - FoldingRangeProvider = Some true - SelectionRangeProvider = Some true - SemanticTokensProvider = - Some - { Legend = - createTokenLegend - Range = Some true - Full = Some(U2.First true) } - InlayHintProvider = Some { ResolveProvider = Some false } } } + { InitializeResult.Default with Capabilities = Helpers.defaultServerCapabilities } |> success } diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs index a3693571c..a7b347f64 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs @@ -1331,7 +1331,7 @@ let private renameUnusedValue state = """ (Diagnostics.acceptAll) selectPrefix - + testCaseAsync "replace doesn't trigger for function" <| CodeFix.checkNotApplicable server """ @@ -1370,8 +1370,8 @@ let private replaceWithSuggestionTests state = let selectCodeFix replacement = CodeFix.withTitle (ReplaceWithSuggestion.title replacement) let validateDiags (diags: Diagnostic[]) = Diagnostics.expectCode "39" diags - Expect.exists - diags + Expect.exists + diags (fun (d: Diagnostic) -> d.Message.Contains "Maybe you want one of the following:") "Diagnostic with code 39 should suggest name" testCaseAsync "can change Min to min" <| @@ -1467,19 +1467,74 @@ let private replaceWithSuggestionTests state = let private resolveNamespaceTests state = let config = { defaultConfigDto with ResolveNamespaces = Some true } serverTestList (nameof ResolveNamespace) state config None (fun server -> [ + let selectCodeFix = CodeFix.matching (fun ca -> ca.Title.StartsWith "open") testCaseAsync "doesn't fail when target not in last line" <| CodeFix.checkApplicable server """ let x = $0Min(2.0, 1.0) """ // Note: new line at end! (Diagnostics.log >> Diagnostics.acceptAll) - (CodeFix.log >> CodeFix.matching (fun ca -> ca.Title.StartsWith "open") >> Array.take 1) + (CodeFix.log >> selectCodeFix >> Array.take 1) testCaseAsync "doesn't fail when target in last line" <| CodeFix.checkApplicable server "let x = $0Min(2.0, 1.0)" // Note: No new line at end! (Diagnostics.log >> Diagnostics.acceptAll) - (CodeFix.log >> CodeFix.matching (fun ca -> ca.Title.StartsWith "open") >> Array.take 1) + (CodeFix.log >> selectCodeFix >> Array.take 1) + testCaseAsync "place open in module correctly when having additional modules" + <| CodeFix.check + server + """ +module Foo = + open Microsoft + + let foo = Date$0Time.Now + """ + (Diagnostics.log >> Diagnostics.acceptAll) + selectCodeFix + """ +module Foo = + open Microsoft + open System + + let foo = DateTime.Now + """ + + + testCaseAsync "place open in module correctly without any modules" + <| CodeFix.check + server + """ +module Foo = + let foo = $0DateTime.Now + """ + (Diagnostics.log >> Diagnostics.acceptAll) + selectCodeFix + """ +module Foo = + open System + let foo = DateTime.Now + """ + + + testCaseAsync "With attribute" + <| CodeFix.check + server + """ +[] +module Foo = + + let foo = $0DateTime.Now + """ + (Diagnostics.log >> Diagnostics.acceptAll) + selectCodeFix + """ +[] +module Foo = + open System + + let foo = DateTime.Now + """ //TODO: Implement & unify with `Completion.AutoOpen` (`CompletionTests.fs`) // Issues: // * Complex because of nesting modules (-> where to open) @@ -1579,7 +1634,7 @@ let private wrapExpressionInParenthesesTests state = selectCodeFix ]) -let tests state = testList "CodeFix tests" [ +let tests state = testList "CodeFix-tests" [ HelpersTests.tests AddExplicitTypeAnnotationTests.tests state diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs index f0f3aed18..741503e39 100644 --- a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs +++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs @@ -6,7 +6,7 @@ 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 @@ -29,8 +29,8 @@ module Cursor = *) /// Returns Cursor Position BEFORE index - /// - /// Index might be `text.Length` (-> cursor AFTER last character). + /// + /// 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) @@ -45,8 +45,8 @@ module Cursor = 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: 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 @@ -79,16 +79,16 @@ module Cursor = let tryFindAnyCursor (lines: string[]) = lines |> Seq.mapi (fun i l -> (i,l)) - |> Seq.tryPick (fun (i,line) -> - tryFindAnyCursorInLine line + |> Seq.tryPick (fun (i,line) -> + tryFindAnyCursorInLine line |> Option.map (fun (marker, c, line) -> (marker, pos i c, line)) ) |> function | None -> None - | Some (marker, p,line) -> + | Some (marker, p,line) -> lines.[p.Line] <- line Some ((marker, p), lines) - + let lines = text |> Text.lines match tryFindAnyCursor lines with | None -> None @@ -96,9 +96,9 @@ module Cursor = let text = lines |> String.concat "\n" Some ((marker, p), text) - /// Returns Position of first `$0` (`Cursor.Marker`) and the updated input text without the cursor marker. + /// 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 = tryExtractPositionMarkedWithAnyOf [| Marker |] @@ -109,7 +109,7 @@ module Cursor = >> 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 @@ -125,9 +125,9 @@ module Cursor = /// 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=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) = @@ -157,7 +157,7 @@ module Cursor = >> Result.valueOr (failtestf "Invalid position: %s") /// Calculates cursors position after all edits are applied. - /// + /// /// When cursor inside a changed area: /// * deleted: cursor moves to start of deletion: /// ```fsharp @@ -184,7 +184,7 @@ module Cursor = /// let foo = 42 $0- 7 + 123 /// ``` /// -> like deletion - /// * Implementation detail: + /// * Implementation detail: /// Replacement is considered: First delete (-> move cursor to front), then insert (-> cursor stays) /// /// Note: `edits` must be sorted by range! @@ -213,7 +213,7 @@ module Cursor = else - e.Character + s.Character { Line = pos.Line + deltaLine; Character = pos.Character + deltaChar } - + // add new text to pos let pos = if System.String.IsNullOrEmpty edit.NewText then @@ -248,7 +248,7 @@ module Cursor = 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) = @@ -264,7 +264,7 @@ module Cursors = 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 = @@ -274,7 +274,7 @@ module Cursors = let text = tps |> List.head |> snd let poss = tps |> List.map fst (text, poss) - + /// Like `extract`, but instead of just extracting Cursors marked with `Cursor.Marker` (`$0`), /// this here extract all specified markers. @@ -337,8 +337,8 @@ module Text = module TextEdit = let apply (edit: TextEdit) = - // `edit` is from FSAC LSP -> might contain `\r`. - // But only `\n` handled by `Text.lines` -> remove `\r` + // `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 @@ -352,7 +352,7 @@ module TextEdit = && not (edit |> inserts) - // **Note**: + // **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) @@ -360,9 +360,9 @@ module TextEdit = // * 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 + // 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: @@ -386,7 +386,7 @@ module TextEdit = Some "Expected change, but does nothing (neither delete nor insert)" else None - + module TextEdits = /// Checks edits for: @@ -394,13 +394,13 @@ module TextEdits = /// * 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 + /// > 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) = @@ -413,7 +413,7 @@ module TextEdits = | None -> tryFindOverlappingEditExample edits let (|Overlapping|_|) = tryFindOverlappingEditExample - let (|Invalids|_|) = + 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) = @@ -439,7 +439,7 @@ module TextEdits = | [] -> Some "Expected at least one TextEdit, but were none" // edits should be valid | Invalids errs -> - sprintf + sprintf "Expected all TextEdits to be valid, but there was at least one erroneous Edit. Invalid Edits: %A" errs |> Some @@ -448,7 +448,7 @@ module TextEdits = 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 + 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 @@ -482,7 +482,7 @@ module TextEdits = 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` @@ -500,7 +500,7 @@ module WorkspaceEdit = 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 textDocVersion, Some version when textDocVersion <> version -> Some $"Edit should be for document version `{textDocVersion}`, but version was `{version}`" | _ -> None