Remove Cache when non-existing file or file outside of workspace gets…

… closed (#1010)

* Remove Cache when non-existing file or file outside of workspace gets closed

src/FsAutoComplete.Core/State.fs

@@ -292,3 +292,10 @@ type State =
 
       return (opts, text, line)
     }
+
+  /// Removes `file` from all caches
+  member x.Forget(file: string<LocalPath>) =
+    x.LastCheckedVersion.TryRemove(file) |> ignore
+    x.Files.TryRemove(file) |> ignore
+    x.ProjectController.RemoveProjectOptions(UMX.untag file) |> ignore
+    x.ScriptProjectOptions.TryRemove(file) |> ignore

src/FsAutoComplete/FsAutoComplete.Lsp.fs

@@ -612,6 +612,59 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
 
   do commandDisposables.Add <| commands.Notify.Subscribe handleCommandEvents
 
+  /// Removes all caches (state & diagnostics) if:
+  /// * file doesn't exist on disk (untitled or deleted)
+  /// * file is outside of current workspace (and not part of any project)
+  let forgetDocument (uri: DocumentUri) =
+    let filePath = uri |> Path.FileUriToLocalPath |> Utils.normalizePath
+
+    // remove cached data for
+    // * non-existing files (untitled & deleted)
+    // * files outside of workspace (and not used by any project)
+    let doesNotExist (file: string<LocalPath>) = not (File.Exists(UMX.untag file))
+
+    let isOutsideWorkspace (file: string<LocalPath>) =
+      match rootPath with
+      | None ->
+        // no workspace specified
+        true
+      | Some rootPath ->
+        let rec isInside (rootDir: DirectoryInfo, dirToCheck: DirectoryInfo) =
+          if String.Equals(rootDir.FullName, dirToCheck.FullName, StringComparison.InvariantCultureIgnoreCase) then
+            true
+          else
+            match dirToCheck.Parent with
+            | null -> false
+            | parent -> isInside (rootDir, parent)
+
+        let rootDir = DirectoryInfo(rootPath)
+        let fileDir = FileInfo(UMX.untag file).Directory
+
+        if isInside (rootDir, fileDir) then
+          false
+        else
+          // file might be outside of workspace but part of a project
+          match state.GetProjectOptions file with
+          | None -> true
+          | Some projOptions ->
+            if doesNotExist (UMX.tag projOptions.ProjectFileName) then
+              // case for script file
+              true
+            else
+              // issue: fs-file does never get removed from project options (-> requires reload of FSAC to register)
+              // -> don't know if file still part of project (file might have been removed from project)
+              // -> keep cache for file
+              false
+
+    if doesNotExist filePath || isOutsideWorkspace filePath then
+      logger.info (
+        Log.setMessage "Removing cached data for {file}"
+        >> Log.addContext "file" filePath
+      )
+
+      state.Forget filePath
+      diagnosticCollections.ClearFor uri
+
   ///Helper function for handling Position requests using **recent** type check results
   member x.positionHandler<'a, 'b when 'b :> ITextDocumentPositionParams>
     (f: 'b -> FcsPos -> ParseAndCheckResults -> string -> NamedText -> AsyncLspResult<'a>)
@@ -1043,6 +1096,16 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
       ()
     }
 
+  override _.TextDocumentDidClose(p) =
+    async {
+      logger.info (
+        Log.setMessage "TextDocumentDidOpen Request: {parms}"
+        >> Log.addContextDestructured "parms" p
+      )
+
+      forgetDocument p.TextDocument.Uri
+    }
+
   override __.TextDocumentCompletion(p: CompletionParams) =
     asyncResult {
       logger.info (
@@ -1941,8 +2004,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
       p.Changes
       |> Array.iter (fun c ->
         if c.Type = FileChangeType.Deleted then
-          let uri = c.Uri
-          diagnosticCollections.ClearFor uri
+          forgetDocument c.Uri
 
         ())
 

test/FsAutoComplete.Tests.Lsp/CoreTests.fs

@@ -21,6 +21,7 @@ open Utils
 open Utils.Utils
 open FsToolkit.ErrorHandling.Operator.AsyncResult
 open FSharpx.Control
+open Utils.Tests
 
 ///Test for initialization of the server
 let initTests state =
@@ -371,3 +372,56 @@ let tooltipTests state =
               "* `'a` is `int`"
               "* `'b` is `int`"
               "* `'c` is `int`" ] ] ]
+
+let closeTests state =
+  // Note: clear diagnostics also implies clear caches (-> remove file & project options from State).
+  let root = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "CloseTests")
+  let workspace = Path.Combine(root, "Workspace")
+  serverTestList "close tests" state defaultConfigDto (Some workspace) (fun server -> [
+    testCaseAsync "closing untitled script file clears diagnostics" (async {
+      let source = 
+        // The value or constructor 'untitled' is not defined.
+        "let foo = untitled" 
+      let! (doc, diags) = server |> Server.createUntitledDocument source
+      Expect.isNonEmpty diags "There should be an error"
+      do! doc |> Document.close
+
+      let! diags = doc |> Document.waitForLatestDiagnostics (TimeSpan.FromSeconds 5.0)
+      Expect.isEmpty diags "There should be a final publishDiagnostics without any diags"
+    })
+    testCaseAsync "closing existing script file inside workspace doesn't clear diagnostics" (async {
+      let! (doc, diags) = server |> Server.openDocument "Script.fsx"
+      Expect.isNonEmpty diags "There should be an error"
+      do! doc |> Document.close
+
+      let! diags = doc |> Document.waitForLatestDiagnostics (TimeSpan.FromSeconds 5.0)
+      Expect.isNonEmpty diags "There should be no publishDiagnostics without any diags after close"
+    })
+    testCaseAsync "closing existing script file outside workspace clears diagnostics" (async {
+      let file = Path.Combine(root, "Script.fsx")
+      let! (doc, diags) = server |> Server.openDocument file
+      Expect.isNonEmpty diags "There should be an error"
+      do! doc |> Document.close
+
+      let! diags = doc |> Document.waitForLatestDiagnostics (TimeSpan.FromSeconds 5.0)
+      Expect.isEmpty diags "There should be a final publishDiagnostics without any diags"
+    })
+
+    testCaseAsync "closing existing file inside project & workspace doesn't clear diagnostics" (async {
+      let! (doc, diags) = server |> Server.openDocument "InsideProjectInsideWorkspace.fs"
+      Expect.isNonEmpty diags "There should be an error"
+      do! doc |> Document.close
+
+      let! diags = doc |> Document.waitForLatestDiagnostics (TimeSpan.FromSeconds 5.0)
+      Expect.isNonEmpty diags "There should be no publishDiagnostics without any diags after close"
+    })
+    testCaseAsync "closing existing file inside project but outside workspace doesn't clear diagnostics" (async {
+      let file = Path.Combine(root, "InsideProjectOutsideWorkspace.fs")
+      let! (doc, diags) = server |> Server.openDocument file
+      Expect.isNonEmpty diags "There should be an error"
+      do! doc |> Document.close
+
+      let! diags = doc |> Document.waitForLatestDiagnostics (TimeSpan.FromSeconds 5.0)
+      Expect.isNonEmpty diags "There should be no publishDiagnostics without any diags after close"
+    })
+  ])

test/FsAutoComplete.Tests.Lsp/Program.fs

@@ -51,6 +51,7 @@ let lspTests =
               FsAutoComplete.State.Initial toolsPath testRunDir workspaceLoaderFactory
 
             initTests state
+            closeTests state
 
             Utils.Tests.Server.tests state
             Utils.Tests.CursorbasedTests.tests state

test/FsAutoComplete.Tests.Lsp/TestCases/CloseTests/InsideProjectOutsideWorkspace.fs

@@ -0,0 +1,3 @@
+namespace MyProject
+
+let someValue = inProjectOutsideWorkspace

test/FsAutoComplete.Tests.Lsp/TestCases/CloseTests/Script.fsx

@@ -0,0 +1 @@
+let foo = outsideWorkspace

test/FsAutoComplete.Tests.Lsp/TestCases/CloseTests/Workspace/InsideProjectInsideWorkspace.fs

@@ -0,0 +1,3 @@
+namespace MyProject
+
+let someValue = inProjectInsideWorkspace

test/FsAutoComplete.Tests.Lsp/TestCases/CloseTests/Workspace/Script.fsx

@@ -0,0 +1 @@
+let foo = insideWorkspace

test/FsAutoComplete.Tests.Lsp/TestCases/CloseTests/Workspace/Workspace.fsproj

@@ -0,0 +1,13 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <TargetFramework>net6.0</TargetFramework>
+    <GenerateDocumentationFile>true</GenerateDocumentationFile>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="InsideProjectInsideWorkspace.fs" />
+    <Compile Include="../InsideProjectOutsideWorkspace.fs" />
+  </ItemGroup>
+
+</Project>