feat: enhance multi-root workspace robustness and cleanup

- Introduce a permanent fallback workspace to handle files outside defined roots.
- Automatically migrate open documents to fallback on workspace removal.
- Explicitly clear diagnostics for all files when a workspace folder is removed.
- Clean up matching documents from the fallback workspace when a new folder is added.
- Refactor get_workspace to rely on the fallback root and remove redundant null checks in handlers.
- Add comprehensive test for fallback workspace document lifecycle.

Author: randy3k

R/diagnostics.R

@@ -130,7 +130,7 @@ diagnose_file <- function(uri, content, is_rmarkdown = FALSE, globals = NULL, ca
 
 diagnostics_callback <- function(self, uri, version, diagnostics) {
     workspace <- self$get_workspace(uri)
-    if (is.null(diagnostics) || is.null(workspace) || !workspace$documents$has(uri) || !lsp_settings$get("diagnostics")) return(NULL)
+    if (is.null(diagnostics) || !workspace$documents$has(uri) || !lsp_settings$get("diagnostics")) return(NULL)
 
     logger$info("diagnostics_callback called:", list(
         uri = uri,
@@ -163,7 +163,7 @@ diagnostics_task <- function(self, uri, document, delay = 0) {
 
     workspace <- self$get_workspace(uri)
 
-    if (cache_ttl > 0 && !is.null(workspace) && workspace$diagnostics_cache$has(cache_key)) {
+    if (cache_ttl > 0 && workspace$diagnostics_cache$has(cache_key)) {
         cached_entry <- workspace$diagnostics_cache$get(cache_key)
         age <- as.numeric(difftime(Sys.time(), cached_entry$time, units = "secs"))
         if (!is.na(age) && age <= cache_ttl) {
@@ -173,7 +173,7 @@ diagnostics_task <- function(self, uri, document, delay = 0) {
         }
     }
 
-    is_package <- !is.null(workspace) && is_package(workspace$root)
+    is_package <- is_package(workspace$root)
     globals <- NULL
 
     if (is_package) {
@@ -199,7 +199,7 @@ diagnostics_task <- function(self, uri, document, delay = 0) {
             cache = lsp_settings$get("lint_cache")
         ),
         callback = function(result) {
-            if (cache_ttl > 0 && !is.null(workspace)) {
+            if (cache_ttl > 0) {
                 workspace$diagnostics_cache$set(cache_key, list(
                     time = Sys.time(),
                     diagnostics = result

R/document.R

@@ -476,7 +476,7 @@ parse_document <- function(uri, content) {
 
 parse_callback <- function(self, uri, version, parse_data) {
     workspace <- self$get_workspace(uri)
-    if (is.null(workspace) || is.null(parse_data) || !workspace$documents$has(uri)) return(NULL)
+    if (is.null(parse_data) || !workspace$documents$has(uri)) return(NULL)
     logger$info("parse_callback called:", list(uri = uri, version = version))
     doc <- workspace$documents$get(uri)
 
@@ -526,7 +526,7 @@ parse_task <- function(self, uri, document, delay = 0) {
 
     # Check cache in the main process before spawning a child task
     workspace <- self$get_workspace(uri)
-    if (!is.null(workspace) && workspace$parse_cache$has(content_hash)) {
+    if (workspace$parse_cache$has(content_hash)) {
         logger$info("parse_task: cache hit for", uri)
         cached_entry <- workspace$parse_cache$get(content_hash)
         cached_env <- list2env(cached_entry, parent = .GlobalEnv)
@@ -545,7 +545,7 @@ parse_task <- function(self, uri, document, delay = 0) {
 
 resolve_callback <- function(self, uri, version, packages) {
     workspace <- self$get_workspace(uri)
-    if (is.null(workspace) || !workspace$documents$has(uri)) return(NULL)
+    if (!workspace$documents$has(uri)) return(NULL)
     logger$info("resolve_callback called:", list(uri = uri, version = version))
     workspace$load_packages(packages)
     doc <- workspace$documents$get(uri)

R/languageserver.R

@@ -68,6 +68,7 @@ LanguageServer <- R6::R6Class("LanguageServer",
 
             self$pending_replies <- collections::dict()
             self$workspaces <- collections::dict()
+            self$workspaces$set("", Workspace$new(NULL))
 
             super$initialize()
         },
@@ -86,21 +87,41 @@ LanguageServer <- R6::R6Class("LanguageServer",
             key <- if (length(uri) == 0) "" else uri
             if (!self$workspaces$has(key)) {
                 path <- if (length(uri) == 0) NULL else path_from_uri(uri)
-                self$workspaces$set(key, Workspace$new(path))
+                new_workspace <- Workspace$new(path)
+                self$workspaces$set(key, new_workspace)
+                
+                # Remove documents from the fallback workspace if they belong here
+                if (!is.null(path)) {
+                    fallback <- self$workspaces$get("")
+                    for (doc_uri in fallback$documents$keys()) {
+                        doc_path <- path_from_uri(doc_uri)
+                        if (path_has_parent(doc_path, path)) {
+                            fallback$documents$remove(doc_uri)
+                        }
+                    }
+                }
             }
         },
         remove_workspace = function(uri) {
             key <- if (length(uri) == 0) "" else uri
+            if (key == "") return(invisible(NULL))
             if (self$workspaces$has(key)) {
+                workspace <- self$workspaces$get(key)
+                for (doc_uri in workspace$documents$keys()) {
+                    diagnostics_callback(self, doc_uri, NULL, list())
+                    doc <- workspace$documents$get(doc_uri)
+                    if (isTRUE(doc$is_open)) {
+                        self$workspaces$get("")$documents$set(doc_uri, doc)
+                    }
+                }
                 self$workspaces$remove(key)
             }
         },
         get_workspace = function(uri) {
             workspaces_list <- self$workspaces$values()
-            if (length(workspaces_list) == 0) return(NULL)
 
             default_key <- if (length(self$rootUri) == 0) "" else self$rootUri
-            default_workspace <- self$workspaces$get(default_key, workspaces_list[[1]])
+            default_workspace <- self$workspaces$get(default_key, self$workspaces$get(""))
 
             if (length(uri) == 0) return(default_workspace)
 

tests/testthat/test-workspace.R

@@ -179,3 +179,45 @@ test_that("Multiple workspace folders are loaded and handled", {
     })
   expect_equal(length(result), 3)
 })
+
+test_that("Fallback workspace cleans up documents when directory is added", {
+  skip_on_cran()
+
+  client <- language_client(NULL, workspace_folders = NULL)
+
+  dir1 <- tempfile()
+  dir.create(dir1)
+  dir.create(file.path(dir1, "R"))
+  file.create(file.path(dir1, "DESCRIPTION"))
+  file1 <- file.path(dir1, "R", "test1.R")
+  writeLines(c("fun_wk1 <- function(x) { x }"), file1)
+
+  # Open the file, it goes to fallback workspace
+  client %>% did_open(file1)
+
+  # Wait for file to be parsed
+  Sys.sleep(0.5)
+
+  # Add a workspace that contains the file
+  client %>% notify(
+    "workspace/didChangeWorkspaceFolders", list(
+      event = list(
+        added = list(list(uri = path_to_uri(dir1), name = basename(dir1))),
+        removed = list()
+      )
+    ))
+
+  # Wait for workspace update to process
+  Sys.sleep(0.5)
+
+  # Server should have loaded the file as part of the new workspace folder, 
+  # but the old reference in the fallback workspace should be deleted.
+  # If we search for fun_wk1, it should only be found once (in the new workspace).
+  result <- client %>% respond_workspace_symbol("fun_wk1",
+    retry_when = function(result) {
+      length(result) == 0
+    })
+  
+  expect_equal(length(result), 1)
+})
+