diff --git a/NEWS.md b/NEWS.md index 498fef14..b8e538a3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # languageserver 0.3.18 +- Index complete R projects with bounded, cached shallow summaries while fully + parsing only packages, open files, and static `source()` closures. Keep + unrelated standalone scripts isolated in semantic editor features. - Retire persistent `callr` workers when cancelling tasks so a late interrupt cannot leak into the next diagnostics run. - Prevent a dead persistent worker from crashing the language server when a diff --git a/R/call_hierarchy.R b/R/call_hierarchy.R index 23ae4297..f3d620fc 100644 --- a/R/call_hierarchy.R +++ b/R/call_hierarchy.R @@ -14,12 +14,41 @@ indexed_call_range <- function(index, i) { ) } +#' Create a call-hierarchy item for calls made outside a function +#' @noRd +call_hierarchy_file_item <- function(workspace, uri, selection_range, + context_uri = uri) { + document <- workspace$documents$get(uri, NULL) + if (is.null(document)) return(NULL) + last_row <- max(document$nline - 1L, 0L) + last_col <- nchar(document$line0(last_row), type = "chars") + file_range <- range( + position(0L, 0L), + document$to_lsp_position(last_row, last_col) + ) + name <- basename(path_from_uri(uri)) + if (!length(name) || !nzchar(name)) name <- uri + list( + name = name, + detail = "top level", + kind = SymbolKind$File, + uri = uri, + range = file_range, + selectionRange = selection_range, + data = list(contextUri = context_uri, topLevel = TRUE) + ) +} + indexed_incoming_calls <- function(workspace, item) { target_key <- item$data$definitionKey if (is.null(target_key)) target_key <- paste0("global:", item$name) in_calls <- collections::dict() + context_uri <- item$data$contextUri + if (is.null(context_uri)) context_uri <- item$uri + doc_uris <- workspace_reference_document_uris( + workspace, item$uri, context_uri) - for (doc_uri in workspace$documents$keys()) { + for (doc_uri in doc_uris) { parse_data <- workspace$get_parse_data(doc_uri) index <- parse_data$reference_index if (is.null(index)) return(NULL) @@ -35,16 +64,29 @@ indexed_incoming_calls <- function(workspace, item) { definitions <- definitions[vapply(definitions, function(definition) { identical(definition$type, "function") }, logical(1L))] - if (!length(definitions)) next for (i in selected) { + call_range <- indexed_call_range(index, i) containing <- which(vapply(definitions, function(definition) { indexed_position_in_range( index$line[[i]], index$col[[i]], definition$range) && indexed_position_in_range( index$end_line[[i]], index$end_col[[i]], definition$range) }, logical(1L))) - if (!length(containing)) next + if (!length(containing)) { + key <- paste(doc_uri, "top-level", sep = ":") + if (!in_calls$has(key)) { + in_calls$set(key, list( + from = call_hierarchy_file_item( + workspace, doc_uri, call_range, context_uri), + fromRanges = list() + )) + } + entry <- in_calls$get(key) + entry$fromRanges[[length(entry$fromRanges) + 1L]] <- call_range + in_calls$set(key, entry) + next + } spans <- vapply(definitions[containing], function(definition) { (definition$range$end$line - definition$range$start$line) * @@ -72,15 +114,15 @@ indexed_incoming_calls <- function(workspace, item) { range = definition$range, selectionRange = definition$range, data = list( - definition = list(uri = doc_uri, range = definition$range) + definition = list(uri = doc_uri, range = definition$range), + contextUri = context_uri ) ), fromRanges = list() )) } entry <- in_calls$get(key) - entry$fromRanges[[length(entry$fromRanges) + 1L]] <- - indexed_call_range(index, i) + entry$fromRanges[[length(entry$fromRanges) + 1L]] <- call_range in_calls$set(key, entry) } } @@ -111,6 +153,8 @@ indexed_outgoing_calls <- function(workspace, item) { sep = "\r" )) result <- list() + context_uri <- item$data$contextUri + if (is.null(context_uri)) context_uri <- item$uri for (indices in groups) { i <- indices[[1L]] point <- list( @@ -118,7 +162,8 @@ indexed_outgoing_calls <- function(workspace, item) { col = index$code_point_col[[i]] ) symbol_definition <- definition_reply( - NULL, item$uri, workspace, doc, point)$result + NULL, item$uri, workspace, doc, point, + context_uri = context_uri)$result if (is.null(symbol_definition) || equal_definition(symbol_definition, item$data$definition)) { next @@ -134,7 +179,10 @@ indexed_outgoing_calls <- function(workspace, item) { detail = detail, range = symbol_definition$range, selectionRange = symbol_definition$range, - data = list(definition = symbol_definition) + data = list( + definition = symbol_definition, + contextUri = context_uri + ) ), fromRanges = lapply(indices, function(j) indexed_call_range(index, j)) ) @@ -172,7 +220,8 @@ prepare_call_hierarchy_reply <- function(id, uri, workspace, document, point) { selectionRange = defn$range, data = list( definition = defn, - definitionKey = definition_key + definitionKey = definition_key, + contextUri = uri ) ) ) @@ -199,7 +248,11 @@ call_hierarchy_incoming_calls_reply <- function(id, workspace, item) { in_calls <- collections::dict() - for (doc_uri in workspace$documents$keys()) { + context_uri <- item$data$contextUri + if (is.null(context_uri)) context_uri <- item$uri + doc_uris <- workspace_reference_document_uris( + workspace, item$uri, context_uri) + for (doc_uri in doc_uris) { doc <- workspace$documents$get(doc_uri) xdoc <- workspace$get_parse_data(doc_uri)$xml_doc if (is.null(xdoc)) next @@ -243,7 +296,9 @@ call_hierarchy_incoming_calls_reply <- function(id, workspace, item) { for (i in seq_along(symbols)) { symbol_point <- list(row = symbol_line1[[i]] - 1, col = symbol_col1[[i]]) - symbol_defn <- definition_reply(NULL, doc_uri, workspace, doc, symbol_point)$result + symbol_defn <- definition_reply( + NULL, doc_uri, workspace, doc, symbol_point, + context_uri = context_uri)$result if (!equal_definition(symbol_defn, item$data$definition)) { next @@ -261,7 +316,8 @@ call_hierarchy_incoming_calls_reply <- function(id, workspace, item) { definition = list( uri = doc_uri, range = defn$range - ) + ), + contextUri = context_uri ) ), fromRanges = list() @@ -288,6 +344,59 @@ call_hierarchy_incoming_calls_reply <- function(id, workspace, item) { in_calls$set(defn, defn_item) } } + + symbols <- xml_find_all(xdoc, + glue("//SYMBOL_FUNCTION_CALL[text() = '{token_quote}']", + token_quote = token_quote)) + if (!length(symbols)) next + symbol_line1 <- as.integer(xml_attr(symbols, "line1")) + symbol_col1 <- as.integer(xml_attr(symbols, "col1")) + symbol_line2 <- as.integer(xml_attr(symbols, "line2")) + symbol_col2 <- as.integer(xml_attr(symbols, "col2")) + for (i in seq_along(symbols)) { + call_range <- range( + start = doc$to_lsp_position( + row = symbol_line1[[i]] - 1L, + col = symbol_col1[[i]] - 1L + ), + end = doc$to_lsp_position( + row = symbol_line2[[i]] - 1L, + col = symbol_col2[[i]] + ) + ) + contained <- any(vapply(defns, function(defn) { + indexed_position_in_range( + call_range$start$line, + call_range$start$character, + defn$range + ) && indexed_position_in_range( + call_range$end$line, + call_range$end$character, + defn$range + ) + }, logical(1L))) + if (contained) next + symbol_point <- list( + row = symbol_line1[[i]] - 1L, + col = symbol_col1[[i]] + ) + symbol_defn <- definition_reply( + NULL, doc_uri, workspace, doc, symbol_point, + context_uri = context_uri)$result + if (!equal_definition(symbol_defn, item$data$definition)) next + + key <- paste(doc_uri, "top-level", sep = ":") + if (!in_calls$has(key)) { + in_calls$set(key, list( + from = call_hierarchy_file_item( + workspace, doc_uri, call_range, context_uri), + fromRanges = list() + )) + } + entry <- in_calls$get(key) + entry$fromRanges[[length(entry$fromRanges) + 1L]] <- call_range + in_calls$set(key, entry) + } } result <- in_calls$values() @@ -312,6 +421,8 @@ call_hierarchy_outgoing_calls_reply <- function(id, workspace, item) { } result <- list() + context_uri <- item$data$contextUri + if (is.null(context_uri)) context_uri <- item$uri start_point <- doc$from_lsp_position(item$range$start) end_point <- doc$from_lsp_position(item$range$end) line1 <- start_point$row + 1 @@ -338,7 +449,9 @@ call_hierarchy_outgoing_calls_reply <- function(id, workspace, item) { for (i in seq_along(symbols)) { symbol_point <- list(row = symbol_line1[[i]] - 1, col = symbol_col1[[i]]) - symbol_defn <- definition_reply(NULL, item$uri, workspace, doc, symbol_point)$result + symbol_defn <- definition_reply( + NULL, item$uri, workspace, doc, symbol_point, + context_uri = context_uri)$result if (is.null(symbol_defn) || equal_definition(symbol_defn, item$data$definition)) { next @@ -356,7 +469,8 @@ call_hierarchy_outgoing_calls_reply <- function(id, workspace, item) { range = symbol_defn$range, selectionRange = symbol_defn$range, data = list( - definition = symbol_defn + definition = symbol_defn, + contextUri = context_uri ) ), fromRanges = list() diff --git a/R/code_lens.R b/R/code_lens.R index 8ac73bfb..e0585f0f 100644 --- a/R/code_lens.R +++ b/R/code_lens.R @@ -12,11 +12,13 @@ current_parse_data <- function(uri, workspace, document) { #' Find calls to a workspace function without resolving every symbol #' @noRd -function_call_locations <- function(workspace, symbol) { +function_call_locations <- function(workspace, symbol, context_uri = NULL) { token_quote <- xml_single_quote(symbol) locations <- list() - for (doc_uri in workspace$documents$keys()) { + doc_uris <- workspace_reference_document_uris( + workspace, context_uri, context_uri) + for (doc_uri in doc_uris) { document <- workspace$documents$get(doc_uri) parse_data <- workspace$get_parse_data(doc_uri) indexed <- parse_data$reference_index @@ -68,6 +70,56 @@ function_call_locations <- function(workspace, symbol) { locations } +#' Convert an LSP URI to the marshalled URI shape used by VS Code commands +#' @noRd +vscode_command_uri <- function(uri) { + pattern <- paste0( + "^([A-Za-z][A-Za-z0-9+.-]*):", + "(?://([^/?#]*))?([^?#]*)(?:\\?([^#]*))?(?:#(.*))?$" + ) + parts <- regmatches(uri, regexec(pattern, uri, perl = TRUE))[[1L]] + if (length(parts) != 6L) return(NULL) + + decode <- function(value) { + value <- utils::URLdecode(value) + Encoding(value) <- "UTF-8" + value + } + result <- list(`$mid` = 1L, scheme = tolower(parts[[2L]])) + if (nzchar(parts[[3L]])) result$authority <- decode(parts[[3L]]) + if (nzchar(parts[[4L]])) result$path <- decode(parts[[4L]]) + if (nzchar(parts[[5L]])) result$query <- decode(parts[[5L]]) + if (nzchar(parts[[6L]])) result$fragment <- decode(parts[[6L]]) + result +} + +#' Convert LSP locations to the internal shapes accepted by VS Code commands +#' @noRd +vscode_command_position <- function(value) { + list( + lineNumber = value$line + 1L, + column = value$character + 1L + ) +} + +#' @noRd +vscode_command_range <- function(value) { + list( + startLineNumber = value$start$line + 1L, + startColumn = value$start$character + 1L, + endLineNumber = value$end$line + 1L, + endColumn = value$end$character + 1L + ) +} + +#' @noRd +vscode_command_location <- function(value) { + list( + uri = vscode_command_uri(value$uri), + range = vscode_command_range(value$range) + ) +} + #' Resolve a function-reference code lens #' @noRd resolve_function_code_lens <- function(workspace, lens) { @@ -75,14 +127,24 @@ resolve_function_code_lens <- function(workspace, lens) { uri <- lens$data$uri if (is.null(symbol) || is.null(uri)) return(lens) - locations <- function_call_locations(workspace, symbol) + locations <- function_call_locations(workspace, symbol, context_uri = uri) count <- length(locations) title <- sprintf("%d call%s", count, if (count == 1L) "" else "s") - lens$command <- list( + command <- list( title = title, - tooltip = sprintf("Show the semantic call hierarchy for %s()", symbol), - command = "editor.showCallHierarchy" + tooltip = sprintf("Show calls to %s()", symbol), + command = "" ) + anchor <- vscode_command_uri(uri) + if (count && !is.null(anchor)) { + command$command <- "editor.action.peekLocations" + command$arguments <- list( + anchor, + vscode_command_position(lens$range$start), + lapply(locations, vscode_command_location) + ) + } + lens$command <- command lens } diff --git a/R/completion.R b/R/completion.R index a533e8e3..7c4b162c 100644 --- a/R/completion.R +++ b/R/completion.R @@ -184,12 +184,18 @@ extract_default_values <- function(default_expr) { #' Complete argument values based on default parameter values #' @noRd argument_value_completion <- function(workspace, funct, package, arg_name, token, - exported_only = TRUE, formals_list = NULL) { + exported_only = TRUE, formals_list = NULL, uri = NULL) { # Reuse formals already resolved by the caller when completing multiple # arguments from the same function. if (is.null(formals_list)) { - formals_list <- workspace$get_formals(funct, package, - exported_only = exported_only) + formals_list <- if (is.null(uri)) { + workspace$get_formals( + funct, package, exported_only = exported_only) + } else { + call_with_optional_uri( + workspace$get_formals, + funct, package, exported_only = exported_only, uri = uri) + } } if (is.null(formals_list) || !is.list(formals_list)) { @@ -226,7 +232,8 @@ argument_value_completion <- function(workspace, funct, package, arg_name, token type = "argument_value", funct = funct, package = package, - argument = arg_name + argument = arg_name, + context_uri = uri ) ) }) @@ -240,12 +247,14 @@ arg_value_completion <- function(uri, workspace, document, point, token, funct, # Get the package context package_for_call <- package if (is.null(package_for_call)) { - package_for_call <- workspace$guess_namespace(funct, isf = TRUE) + package_for_call <- call_with_optional_uri( + workspace$guess_namespace, funct, isf = TRUE, uri = uri) } # Try to get the formals - works with NULL package for user-defined functions - formals_list <- workspace$get_formals(funct, package_for_call, - exported_only = exported_only) + formals_list <- call_with_optional_uri( + workspace$get_formals, + funct, package_for_call, exported_only = exported_only, uri = uri) if (is.null(formals_list) || !is.list(formals_list) || length(formals_list) == 0) { return(list()) @@ -264,7 +273,7 @@ arg_value_completion <- function(uri, workspace, document, point, token, funct, # Generate completions for this parameter param_completions <- argument_value_completion( workspace, funct, package_for_call, param_name, token, - exported_only, formals_list) + exported_only, formals_list, uri = uri) all_completions <- c(all_completions, param_completions) } } @@ -304,12 +313,15 @@ arg_completion <- function(uri, workspace, point, token, funct, package = NULL, } if (is.null(token_args)) { - package <- workspace$guess_namespace(funct, isf = TRUE) + package <- call_with_optional_uri( + workspace$guess_namespace, funct, isf = TRUE, uri = uri) } } if (!is.null(package)) { - args <- names(workspace$get_formals(funct, package, exported_only = exported_only)) + args <- names(call_with_optional_uri( + workspace$get_formals, + funct, package, exported_only = exported_only, uri = uri)) if (package == "base" && funct == "options") { args <- c(args, names(.Options)) @@ -320,7 +332,8 @@ arg_completion <- function(uri, workspace, point, token, funct, package = NULL, token_data <- list( type = "parameter", funct = funct, - package = package + package = package, + context_uri = uri ) } } @@ -453,8 +466,13 @@ completion_select_indices <- function(labels, sort_text, token, limit) { #' Complete any object in the workspace #' @noRd workspace_completion <- function(workspace, token, - package = NULL, exported_only = TRUE, snippet_support = NULL, limit = Inf) { + package = NULL, exported_only = TRUE, snippet_support = NULL, limit = Inf, + uri = NULL) { candidates <- list() + get_namespace <- function(name) { + if (is.null(uri)) workspace$get_namespace(name) + else call_with_optional_uri(workspace$get_namespace, name, uri = uri) + } append_candidates <- function(objects, kind, detail, sort_prefix, type, package, is_function = FALSE) { @@ -478,14 +496,20 @@ workspace_completion <- function(workspace, token, } if (is.null(package)) { - packages <- c(WORKSPACE, workspace$loaded_packages) + loaded_packages <- if (is.null(uri) || + !is.function(workspace$loaded_packages_for_context)) { + workspace$loaded_packages + } else { + workspace$loaded_packages_for_context(uri) + } + packages <- c(WORKSPACE, loaded_packages) } else { packages <- c(package) } if (is.null(package) || exported_only) { for (nsname in packages) { - ns <- workspace$get_namespace(nsname) + ns <- get_namespace(nsname) if (is.null(ns)) { next } @@ -516,7 +540,7 @@ workspace_completion <- function(workspace, token, "lazydata", nsname) } } else { - ns <- workspace$get_namespace(package) + ns <- get_namespace(package) if (!is.null(ns)) { tag <- paste0("{", package, "}") functs <- ns$get_symbols(want_functs = TRUE, exported_only = FALSE) @@ -586,6 +610,8 @@ workspace_completion <- function(workspace, token, completions <- unname(Map(function(label, kind, detail, sort_text, type, package, is_function) { + data <- list(type = type, package = package) + if (!is.null(uri)) data$context_uri <- uri if (isTRUE(snippet_support) && is_function) { list( label = label, @@ -594,7 +620,7 @@ workspace_completion <- function(workspace, token, sortText = sort_text, insertText = paste0(label, "($0)"), insertTextFormat = InsertTextFormat$Snippet, - data = list(type = type, package = package) + data = data ) } else { list( @@ -602,7 +628,7 @@ workspace_completion <- function(workspace, token, kind = kind, detail = detail, sortText = sort_text, - data = list(type = type, package = package) + data = data ) } }, labels, kinds, details, sort_text, types, packages, functions)) @@ -858,7 +884,7 @@ completion_reply <- function(id, uri, workspace, document, point, capabilities) } workspace_completions <- workspace_completion( workspace, token, package, token_result$accessor == "::", - snippet_support, nmax) + snippet_support, nmax, uri = uri) providers_incomplete <- providers_incomplete || isTRUE(attr(workspace_completions, "truncated")) completions <- c(completions, workspace_completions) @@ -941,7 +967,10 @@ completion_item_resolve_reply <- function(id, workspace, params, capabilities) { doc <- NULL doc_string <- NULL if (is.null(params$data$uri)) { - doc <- workspace$get_documentation(params$data$funct, params$data$package, isf = TRUE) + doc <- call_with_optional_uri( + workspace$get_documentation, + params$data$funct, params$data$package, isf = TRUE, + uri = params$data$context_uri) } else { document <- workspace$documents$get(params$data$uri) func_line1 <- params$data$line @@ -961,7 +990,10 @@ completion_item_resolve_reply <- function(id, workspace, params, capabilities) { } else if (params$data$type %in% c("constant", "function", "nonfunction", "lazydata")) { if (isTRUE(capabilities$completionItem$labelDetailsSupport)) { if (params$data$type == "function") { - sig <- workspace$get_signature(params$label, params$data$package) + sig <- call_with_optional_uri( + workspace$get_signature, + params$label, params$data$package, + uri = params$data$context_uri) if (!is.null(sig)) { params$labelDetails <- list( detail = substr(sig, nchar(params$label) + 1, nchar(sig)) @@ -973,8 +1005,11 @@ completion_item_resolve_reply <- function(id, workspace, params, capabilities) { doc <- NULL doc_string <- NULL if (is.null(params$data$uri)) { - doc <- workspace$get_documentation(params$label, params$data$package, - isf = params$data$type == "function") + doc <- call_with_optional_uri( + workspace$get_documentation, + params$label, params$data$package, + isf = params$data$type == "function", + uri = params$data$context_uri) } else { document <- workspace$documents$get(params$data$uri) token_line1 <- params$data$line diff --git a/R/definition.R b/R/definition.R index 64e581b2..16ee2c1f 100644 --- a/R/definition.R +++ b/R/definition.R @@ -12,7 +12,8 @@ definition_xpath <- paste( #' writes the function definition to a temporary file and returns that #' as the location. #' @noRd -definition_reply <- function(id, uri, workspace, document, point, rootPath) { +definition_reply <- function(id, uri, workspace, document, point, rootPath, + context_uri = uri) { token_result <- document$detect_token(point) resolved <- FALSE @@ -86,8 +87,10 @@ definition_reply <- function(id, uri, workspace, document, point, rootPath) { } if (!resolved && check_scope(uri, document, point)) { - result <- workspace$get_definition(token_result$token, token_result$package, - exported_only = token_result$accessor != ":::") + result <- call_with_optional_uri( + workspace$get_definition, + token_result$token, token_result$package, + exported_only = token_result$accessor != ":::", uri = context_uri) } if (is.null(result)) { diff --git a/R/diagnostics.R b/R/diagnostics.R index 5e31871e..243d5530 100644 --- a/R/diagnostics.R +++ b/R/diagnostics.R @@ -196,7 +196,10 @@ diagnostics_task <- function(self, uri, document, delay = 0) { } } - globals <- if (is_package(workspace$root)) { + globals <- if (!is.null(workspace$index) && + isTRUE(workspace$index$enabled)) { + workspace$get_diagnostics_globals(uri) + } else if (is_package(workspace$root)) { workspace$get_diagnostics_globals() } else { NULL diff --git a/R/handlers-textsync.R b/R/handlers-textsync.R index 8ac5d793..e592a1d2 100644 --- a/R/handlers-textsync.R +++ b/R/handlers-textsync.R @@ -2,6 +2,16 @@ #' #' Handler to the `textDocument/didOpen` [Notification]. #' @noRd +update_document_index <- function(self, workspace, uri, content, + cacheable = FALSE) { + if (is.null(workspace$index) || !isTRUE(workspace$index$enabled)) { + return(invisible(NULL)) + } + workspace$index$update_content(uri, content, cacheable = cacheable) + self$refresh_index_documents(workspace, uri) + invisible(NULL) +} + text_document_did_open <- function(self, params) { textDocument <- params$textDocument uri <- uri_escape_unicode(textDocument$uri) @@ -26,6 +36,7 @@ text_document_did_open <- function(self, params) { doc <- Document$new(uri, language = language, version = version, content = content) workspace$documents$set(uri, doc) doc$did_open() + update_document_index(self, workspace, uri, doc$content) # Performance: Parse immediately on open (no delay) to have data ready for initial requests self$text_sync(uri, document = doc, run_lintr = TRUE, parse = TRUE, delay = 0) } @@ -77,6 +88,7 @@ text_document_did_change <- function(self, params) { workspace$documents$set(uri, doc) } doc$did_open() + update_document_index(self, workspace, uri, doc$content) self$text_sync( uri, document = doc, @@ -124,6 +136,8 @@ text_document_did_save <- function(self, params) { doc <- workspace$documents$get(uri) doc$set_content(doc$version, content) doc$did_open() + update_document_index( + self, workspace, uri, doc$content, cacheable = TRUE) self$text_sync(uri, document = doc, run_lintr = TRUE, parse = TRUE) } @@ -152,8 +166,15 @@ text_document_did_close <- function(self, params) { doc$did_close() } + if (!is.null(workspace$index) && isTRUE(workspace$index$enabled)) { + if (file.exists(path)) { + workspace$index$update_path(path) + } else { + workspace$index$remove(uri) + } + self$prune_index_documents(workspace) # do not remove document in package - if (!(is_package(workspace$root) && is_from_workspace)) { + } else if (!(is_package(workspace$root) && is_from_workspace)) { diagnostics_callback(self, uri, NULL, list()) workspace$documents$remove(uri) workspace$diagnostics_globals_cache <- NULL diff --git a/R/handlers-workspace.R b/R/handlers-workspace.R index 32c44b7d..b7376b35 100644 --- a/R/handlers-workspace.R +++ b/R/handlers-workspace.R @@ -4,6 +4,21 @@ FileChangeType <- list( Deleted = 3 ) +#' Refresh a shallow summary without overwriting an open editor buffer +#' @noRd +refresh_index_summary <- function(workspace, index, uri) { + document_uri <- Filter(function(candidate) { + identical(index_canonical_uri(candidate), index_canonical_uri(uri)) + }, workspace$documents$keys()) + if (length(document_uri)) { + doc <- workspace$documents$get(document_uri[[1L]]) + if (isTRUE(doc$is_open)) { + return(index$update_content(document_uri[[1L]], doc$content)) + } + } + index$update_path(path_from_uri(uri)) +} + #' `workspace/didChangeWorkspaceFolders` notification handler #' #' Handler to the `workspace/didChangeWorkspaceFolders` [Notification] @@ -34,8 +49,31 @@ workspace_did_change_configuration <- function(self, params) { logger$info("settings ", settings) + index_settings <- intersect(names(settings), c( + "index_mode", "index_include", "index_exclude", + "index_max_files", "index_max_file_size_mb", "index_batch_size", + "index_time_budget_ms", "index_persistent_cache" + )) lsp_settings$update_from_workspace(settings) + if (length(index_settings)) { + for (workspace in self$workspaces$values()) { + open_documents <- Filter(function(doc) isTRUE(doc$is_open), + workspace$documents$values()) + workspace$index <- WorkspaceIndex$new(workspace$root) + self$load_workspace(workspace) + if (isTRUE(workspace$index$enabled)) { + for (doc in open_documents) { + workspace$index$update_content( + doc$uri, doc$content, cacheable = FALSE) + } + self$refresh_index_documents(workspace) + } else { + self$prune_legacy_documents(workspace) + } + } + } + if (!lsp_settings$get("diagnostics")) { for (workspace in self$workspaces$values()) { for (uri in workspace$documents$keys()) { @@ -50,23 +88,11 @@ workspace_did_change_configuration <- function(self, params) { #' Handler to the `workspace/didChangeWatchedFiles` [Notification]. #' @noRd workspace_did_change_watched_files <- function(self, params) { - # All open documents will be automatically handled by lsp requests. - # Only non-open documents in a package should be handled here. - for (file_event in params$changes) { - uri <- file_event$uri + uri <- uri_escape_unicode(file_event$uri) path <- path_from_uri(uri) workspace <- self$get_workspace(uri) - if (!is_package(workspace$root)) { - next - } - - source_dir <- file.path(workspace$root, "R") - if (dirname(path) != source_dir) { - next - } - if (workspace$documents$has(uri)) { doc <- workspace$documents$get(uri) if (doc$is_open) { @@ -76,6 +102,53 @@ workspace_did_change_watched_files <- function(self, params) { } type <- file_event$type + index <- workspace$index + if (!is.null(index) && isTRUE(index$enabled)) { + if (!index$should_index(path) && type != FileChangeType$Deleted) next + + dependents <- index$dependents( + uri, include_candidates = type == FileChangeType$Created) + if (type == FileChangeType$Created || + type == FileChangeType$Changed) { + logger$info("index", path) + index$update_path(path) + # A newly created file can make a previously unresolved + # static source call resolvable. + for (dependent in dependents) { + refresh_index_summary(workspace, index, dependent) + } + package_root <- index$package_root_for_uri(uri) + if (!is.null(package_root) || workspace$documents$has(uri)) { + if (workspace$documents$has(uri)) { + workspace$documents$remove(uri) + } + if (is.function(self$load_index_document)) { + self$load_index_document(workspace, uri) + } + } + } else if (type == FileChangeType$Deleted) { + logger$info("remove", path) + index$remove(uri) + if (workspace$documents$has(uri)) { + workspace$documents$remove(uri) + workspace$diagnostics_globals_cache <- NULL + workspace$type_hierarchy_cache$clear() + } + for (dependent in dependents) { + refresh_index_summary(workspace, index, dependent) + } + } + if (is.function(self$refresh_index_documents)) { + self$refresh_index_documents(workspace) + } + workspace$update_loaded_packages() + next + } + + # Compatibility path when project indexing is disabled. + if (!is_package(workspace$root)) next + source_dir <- file.path(workspace$root, "R") + if (dirname(path) != source_dir) next if (type == FileChangeType$Created || type == FileChangeType$Changed) { logger$info("load", path) diff --git a/R/hover.R b/R/hover.R index ea134e4b..7e8ad5b7 100644 --- a/R/hover.R +++ b/R/hover.R @@ -8,8 +8,15 @@ hover_xpath <- paste( #' Format hover contents for a function argument #' @noRd -function_argument_hover_contents <- function(workspace, funct, package, parameter) { - doc <- workspace$get_documentation(funct, package, isf = TRUE) +function_argument_hover_contents <- function(workspace, funct, package, parameter, + uri = NULL) { + doc <- if (is.null(uri)) { + workspace$get_documentation(funct, package, isf = TRUE) + } else { + call_with_optional_uri( + workspace$get_documentation, + funct, package, isf = TRUE, uri = uri) + } if (!is.list(doc)) return(NULL) doc_string <- doc$arguments[[parameter]] @@ -19,7 +26,9 @@ function_argument_hover_contents <- function(workspace, funct, package, paramete } if (is.null(doc_string)) return(NULL) - sig <- workspace$get_signature(funct, package) + sig <- if (is.null(uri)) workspace$get_signature(funct, package) + else call_with_optional_uri( + workspace$get_signature, funct, package, uri = uri) if (is.null(sig)) return(doc_string) c( @@ -164,7 +173,7 @@ hover_reply <- function(id, uri, workspace, document, point) { if (!resolved) { contents <- function_argument_hover_contents( - workspace, funct, package, token_text) + workspace, funct, package, token_text, uri = uri) resolved <- TRUE } } @@ -218,22 +227,31 @@ hover_reply <- function(id, uri, workspace, document, point) { } if (!resolved) { - contents <- workspace$get_help(token_result$token, token_result$package) + contents <- call_with_optional_uri( + workspace$get_help, + token_result$token, token_result$package, uri = uri) if (is.null(contents)) { def_text <- NULL - doc <- workspace$get_documentation(token_result$token, token_result$package) + doc <- call_with_optional_uri( + workspace$get_documentation, + token_result$token, token_result$package, uri = uri) signs <- if (is.null(token_result$package)) { - workspace$guess_namespace(token_result$token) + call_with_optional_uri( + workspace$guess_namespace, token_result$token, uri = uri) } else { token_result$package } - sig <- workspace$get_signature(token_result$token, signs, - exported_only = token_result$accessor != ":::") + sig <- call_with_optional_uri( + workspace$get_signature, + token_result$token, signs, + exported_only = token_result$accessor != ":::", uri = uri) if (is.null(sig)) { - def <- workspace$get_definition(token_result$token, token_result$package, - exported_only = token_result$accessor != ":::") + def <- call_with_optional_uri( + workspace$get_definition, + token_result$token, token_result$package, + exported_only = token_result$accessor != ":::", uri = uri) if (!is.null(def)) { def_doc <- workspace$documents$get(def$uri) def_line1 <- def$range$start$line + 1 diff --git a/R/index.R b/R/index.R new file mode 100644 index 00000000..fbb8ae11 --- /dev/null +++ b/R/index.R @@ -0,0 +1,697 @@ +#' Convert a workspace-index glob to a regular expression +#' @noRd +index_glob_regex <- function(pattern) { + pattern <- gsub("\\", "/", pattern, fixed = TRUE) + output <- character() + i <- 1L + n <- nchar(pattern) + while (i <= n) { + remaining <- substr(pattern, i, n) + if (startsWith(remaining, "**/")) { + output <- c(output, "(?:.*/)?") + i <- i + 3L + } else if (startsWith(remaining, "**")) { + output <- c(output, ".*") + i <- i + 2L + } else { + char <- substr(pattern, i, i) + if (identical(char, "*")) { + output <- c(output, "[^/]*") + } else if (identical(char, "?")) { + output <- c(output, "[^/]") + } else if (char %in% strsplit(".\\+()[]{}^$|", "", fixed = TRUE)[[1L]]) { + output <- c(output, paste0("\\", char)) + } else { + output <- c(output, char) + } + i <- i + 1L + } + } + paste0("^", paste0(output, collapse = ""), "$") +} + +#' Match a workspace-relative path against index globs +#' @noRd +index_glob_match <- function(path, patterns, directory = FALSE) { + if (!length(patterns)) return(FALSE) + path <- gsub("\\", "/", path, fixed = TRUE) + if (directory) path <- paste0(sub("/+$", "", path), "/") + any(vapply(patterns, function(pattern) { + is.character(pattern) && length(pattern) == 1L && nzchar(pattern) && + grepl(index_glob_regex(pattern), path, ignore.case = TRUE, + perl = TRUE) + }, logical(1L))) +} + +#' Normalize a path without requiring it to exist +#' @noRd +index_normalize_path <- function(path) { + path <- path.expand(path) + absolute <- grepl("^(?:/|[[:alpha:]]:[/\\\\])", path) + if (!absolute) path <- file.path(getwd(), path) + if (.Platform$OS.type == "windows") { + path <- gsub("\\", "/", path, fixed = TRUE) + } + path +} + +#' Canonical file URI used internally by the workspace index +#' @noRd +index_canonical_uri <- function(uri) { + path <- path_from_uri(uri) + if (!length(path) || !nzchar(path)) return(uri) + path_to_uri(index_normalize_path(path)) +} + +#' Return the nearest package root containing an R source file +#' @noRd +index_package_root <- function(path, workspace_root = NULL) { + if (!length(path) || !nzchar(path)) return(NULL) + path <- index_normalize_path(path) + workspace_root <- if (length(workspace_root) && nzchar(workspace_root)) { + index_normalize_path(workspace_root) + } else { + NULL + } + current <- dirname(path) + repeat { + source_dir <- file.path(current, "R") + if (file.exists(file.path(current, "DESCRIPTION")) && + path_has_parent(path, source_dir)) { + return(current) + } + if (!is.null(workspace_root) && identical(current, workspace_root)) break + parent <- dirname(current) + if (identical(parent, current)) break + if (!is.null(workspace_root) && !path_has_parent(parent, workspace_root) && + !identical(parent, workspace_root)) break + current <- parent + } + NULL +} + +#' Evaluate the small, static path language supported by source indexing +#' @noRd +index_static_path <- function(expr) { + if (is.character(expr) && length(expr) == 1L && !is.na(expr)) { + return(list(path = expr, project_relative = FALSE)) + } + if (!is.call(expr)) return(NULL) + + fun <- deparse(expr[[1L]], nlines = 1L) + if (fun %in% c("file.path", "base::file.path")) { + parts <- as.list(expr)[-1L] + if (!length(parts) || !all(vapply(parts, function(part) { + is.character(part) && length(part) == 1L && !is.na(part) + }, logical(1L)))) return(NULL) + return(list( + path = do.call(file.path, unname(parts)), + project_relative = FALSE + )) + } + if (fun %in% c("here::here", "here:::here")) { + parts <- as.list(expr)[-1L] + if (!all(vapply(parts, function(part) { + is.character(part) && length(part) == 1L && !is.na(part) + }, logical(1L)))) return(NULL) + return(list( + path = if (length(parts)) do.call(file.path, unname(parts)) else "", + project_relative = TRUE + )) + } + NULL +} + +#' Find statically resolvable source calls in an expression +#' @noRd +index_source_specs <- function(expr) { + result <- list() + visit <- function(node) { + if (!is.call(node)) return(NULL) + fun <- deparse(node[[1L]], nlines = 1L) + if (fun %in% c( + "source", "sys.source", "base::source", "base::sys.source")) { + args <- as.list(node)[-1L] + arg_names <- names(args) + file_arg <- NULL + if (length(args)) { + named_file <- which(!is.null(arg_names) & arg_names == "file") + if (length(named_file)) { + file_index <- named_file[[1L]] + } else { + unnamed <- if (is.null(arg_names)) { + seq_along(args) + } else { + which(!nzchar(arg_names)) + } + file_index <- if (length(unnamed)) unnamed[[1L]] else NULL + } + if (length(file_index) && + !identical(args[[file_index]], quote(expr = ))) { + file_arg <- args[[file_index]] + } + } + spec <- index_static_path(file_arg) + if (!is.null(spec)) result[[length(result) + 1L]] <<- spec + } + children <- as.list(node)[-1L] + for (i in seq_along(children)) { + if (identical(children[[i]], quote(expr = ))) next + visit(children[[i]]) + } + NULL + } + visit(expr) + result +} + +#' Resolve a static source path without evaluating project code +#' @noRd +index_source_candidates <- function(spec, from_path, workspace_root) { + if (is.null(spec) || !length(spec$path) || !nzchar(spec$path)) return(NULL) + raw_path <- path.expand(spec$path) + absolute <- grepl("^(?:/|[[:alpha:]]:[/\\\\])", raw_path) + join_path <- function(base, relative) { + normalized_base <- fs::path_norm(base) + normalized <- fs::path_norm(file.path(base, relative)) + rel <- fs::path_rel(normalized, start = normalized_base) + file.path(base, rel) + } + candidates <- if (absolute) { + raw_path + } else if (isTRUE(spec$project_relative)) { + join_path(workspace_root, raw_path) + } else { + c( + join_path(workspace_root, raw_path), + join_path(dirname(from_path), raw_path) + ) + } + candidates <- unique(vapply(candidates, index_normalize_path, character(1L))) + candidates[vapply(candidates, function(candidate) { + (identical(candidate, workspace_root) || + path_has_parent(candidate, workspace_root)) + }, logical(1L))] +} + +#' Resolve a static source path without evaluating project code +#' @noRd +index_resolve_source <- function(spec, from_path, workspace_root) { + candidates <- index_source_candidates(spec, from_path, workspace_root) + if (is.null(candidates)) return(NULL) + candidates <- candidates[vapply(candidates, function(candidate) { + file.exists(candidate) && !dir.exists(candidate) + }, logical(1L))] + if (length(candidates)) candidates[[1L]] else NULL +} + +#' Extract top-level definitions and source edges without building semantic XML +#' @noRd +index_shallow_summary <- function(path, content, workspace_root, metadata = NULL) { + path <- index_normalize_path(path) + workspace_root <- index_normalize_path(workspace_root) + if (is.null(metadata)) metadata <- file.info(path) + expressions <- tryCatch( + parse(text = content, keep.source = TRUE), + error = function(e) NULL + ) + definitions <- list() + source_specs <- list() + if (!is.null(expressions)) { + srcrefs <- attr(expressions, "srcref") + expression_list <- as.list(expressions) + for (i in seq_along(expression_list)) { + expr <- expression_list[[i]] + source_specs <- c(source_specs, index_source_specs(expr)) + if (!is.call(expr) || length(expr) != 3L) next + operator <- deparse(expr[[1L]], nlines = 1L) + if (operator %in% c("<-", "=") && is.symbol(expr[[2L]])) { + symbol <- as.character(expr[[2L]]) + value <- expr[[3L]] + } else if (operator %in% c("->", "->>") && + is.symbol(expr[[3L]])) { + symbol <- as.character(expr[[3L]]) + value <- expr[[2L]] + } else { + next + } + srcref <- if (length(srcrefs) >= i) srcrefs[[i]] else NULL + if (is.null(srcref)) next + definitions[[symbol]] <- list( + name = symbol, + type = get_expr_type(value), + range = expr_range(srcref) + ) + } + } + + sources <- unique(Filter(Negate(is.null), lapply(source_specs, function(spec) { + resolved <- index_resolve_source(spec, path, workspace_root) + if (is.null(resolved)) NULL else path_to_uri(resolved) + }))) + source_candidates <- unique(unlist(lapply(source_specs, function(spec) { + candidates <- index_source_candidates(spec, path, workspace_root) + if (length(candidates)) vapply(candidates, path_to_uri, character(1L)) + else character() + }), use.names = FALSE)) + source_candidate_exists <- vapply(source_candidates, function(uri) { + candidate <- path_from_uri(uri) + file.exists(candidate) && !dir.exists(candidate) + }, logical(1L)) + size <- if (is.data.frame(metadata) && nrow(metadata)) metadata$size[[1L]] else NA_real_ + mtime <- if (is.data.frame(metadata) && nrow(metadata)) metadata$mtime[[1L]] else as.POSIXct(NA) + list( + uri = path_to_uri(path), + path = path, + size = as.numeric(size), + mtime = as.numeric(mtime), + content_hash = get_content_hash(content), + definitions = definitions, + sources = sources, + source_candidates = source_candidates, + source_candidate_exists = source_candidate_exists, + parse_error = is.null(expressions), + package_root = index_package_root(path, workspace_root) + ) +} + +#' A bounded, project-wide index of R source metadata +#' @noRd +WorkspaceIndex <- R6::R6Class("WorkspaceIndex", + public = list( + root = NULL, + files = NULL, + summaries = NULL, + source_edges = NULL, + reverse_edges = NULL, + pending = NULL, + truncated = FALSE, + enabled = TRUE, + cache_dirty = FALSE, + processing_batch = FALSE, + + initialize = function(root) { + self$root <- if (length(root) && nzchar(root)) { + index_normalize_path(root) + } else { + NULL + } + self$files <- collections::dict() + self$summaries <- collections::dict() + self$source_edges <- collections::dict() + self$reverse_edges <- collections::dict() + self$pending <- character() + mode <- lsp_settings$get("index_mode") + if (!is.character(mode) || length(mode) != 1L || is.na(mode)) { + mode <- "auto" + } + self$enabled <- !is.null(self$root) && + !identical(tolower(mode), "off") + }, + + include_patterns = function() { + value <- lsp_settings$get("index_include") + if (!is.character(value) || !length(value)) "**/*.R" else value + }, + + exclude_patterns = function() { + value <- lsp_settings$get("index_exclude") + if (!is.character(value)) character() else value + }, + + max_files = function() { + value <- suppressWarnings(as.integer(lsp_settings$get("index_max_files"))) + if (length(value) != 1L || is.na(value) || value < 1L) 10000L else value + }, + + max_file_bytes = function() { + value <- suppressWarnings(as.numeric( + lsp_settings$get("index_max_file_size_mb"))) + if (length(value) != 1L || is.na(value) || value <= 0) value <- 2 + value * 1024^2 + }, + + contains_path = function(path) { + if (!self$enabled || !length(path) || !nzchar(path)) return(FALSE) + path <- index_normalize_path(path) + identical(path, self$root) || path_has_parent(path, self$root) + }, + + should_index = function(path, directory = FALSE) { + if (!self$contains_path(path)) return(FALSE) + rel <- gsub("\\", "/", fs::path_rel(path, start = self$root), + fixed = TRUE) + if (index_glob_match(rel, self$exclude_patterns(), directory)) { + return(FALSE) + } + directory || index_glob_match(rel, self$include_patterns()) + }, + + cache_file = function() { + if (!isTRUE(lsp_settings$get("index_persistent_cache"))) return(NULL) + base <- if (exists("R_user_dir", envir = asNamespace("tools"), + inherits = FALSE)) { + get("R_user_dir", envir = asNamespace("tools"))( + "languageserver", "cache") + } else { + file.path(path.expand("~"), ".cache", "R", "languageserver") + } + file.path(base, "workspace-index", + paste0(digest::digest(self$root, algo = "xxhash64"), ".rds")) + }, + + load_cache = function() { + cache_file <- self$cache_file() + if (is.null(cache_file) || !file.exists(cache_file)) return(NULL) + cached <- tryCatch(readRDS(cache_file), error = function(e) NULL) + if (!is.list(cached) || !identical(cached$version, 1L) || + !identical(cached$root, self$root) || + !is.list(cached$summaries)) return(NULL) + for (summary in cached$summaries) { + if (!is.list(summary) || !file.exists(summary$path)) next + info <- file.info(summary$path) + if (!nrow(info) || is.na(info$size[[1L]]) || + !identical(as.numeric(info$size[[1L]]), summary$size) || + !identical(as.numeric(info$mtime[[1L]]), summary$mtime)) next + candidates <- summary$source_candidates + if (length(candidates)) { + current_exists <- vapply(candidates, function(uri) { + path <- path_from_uri(uri) + file.exists(path) && !dir.exists(path) + }, logical(1L)) + if (is.null(summary$source_candidate_exists) || !identical( + unname(current_exists), + unname(summary$source_candidate_exists))) next + } + self$set_summary(summary) + } + invisible(NULL) + }, + + save_cache = function() { + if (!self$cache_dirty) return(NULL) + cache_file <- self$cache_file() + if (is.null(cache_file)) return(NULL) + dir.create(dirname(cache_file), recursive = TRUE, showWarnings = FALSE) + temp_file <- tempfile("index-", tmpdir = dirname(cache_file)) + on.exit(unlink(temp_file), add = TRUE) + value <- list( + version = 1L, + root = self$root, + summaries = unname(Filter(function(summary) { + !identical(summary$cacheable, FALSE) + }, self$summaries$values())) + ) + saved <- tryCatch({ + saveRDS(value, temp_file) + if (file.exists(cache_file)) { + file.copy(temp_file, cache_file, overwrite = TRUE) + } else { + file.rename(temp_file, cache_file) + } + }, error = function(e) FALSE) + if (isTRUE(saved)) self$cache_dirty <- FALSE + invisible(NULL) + }, + + discover = function() { + if (!self$enabled || !dir.exists(self$root)) return(invisible(NULL)) + self$files$clear() + self$pending <- character() + self$truncated <- FALSE + self$load_cache() + queue <- collections::queue() + queue$push(self$root) + visited <- new.env(hash = TRUE, parent = emptyenv()) + count <- 0L + max_files <- self$max_files() + max_bytes <- self$max_file_bytes() + pending <- character(max_files) + pending_count <- 0L + real_root <- normalizePath( + self$root, winslash = "/", mustWork = FALSE) + + while (queue$size() && count < max_files) { + directory <- queue$pop() + canonical <- normalizePath( + directory, winslash = "/", mustWork = FALSE) + if (exists(canonical, envir = visited, inherits = FALSE)) next + assign(canonical, TRUE, envir = visited) + entries <- tryCatch(list.files( + directory, all.files = TRUE, no.. = TRUE, + full.names = TRUE), error = function(e) character()) + if (!length(entries)) next + entries <- sort(entries, method = "radix") + info <- file.info(entries) + for (i in seq_along(entries)) { + path <- index_normalize_path(entries[[i]]) + real_path <- normalizePath( + path, winslash = "/", mustWork = FALSE) + if (!identical(real_path, real_root) && + !path_has_parent(real_path, real_root)) next + is_dir <- isTRUE(info$isdir[[i]]) + if (is_dir) { + if (self$should_index(path, directory = TRUE)) { + queue$push(path) + } + next + } + if (!self$should_index(path) || is.na(info$size[[i]]) || + info$size[[i]] > max_bytes) next + count <- count + 1L + if (count > max_files) break + uri <- path_to_uri(path) + metadata <- list( + uri = uri, + path = path, + size = as.numeric(info$size[[i]]), + mtime = as.numeric(info$mtime[[i]]), + package_root = index_package_root(path, self$root) + ) + self$files$set(uri, metadata) + if (!self$summaries$has(uri)) { + pending_count <- pending_count + 1L + pending[[pending_count]] <- uri + } + } + } + self$pending <- if (pending_count) { + pending[seq_len(pending_count)] + } else { + character() + } + stale <- setdiff(self$summaries$keys(), self$files$keys()) + for (uri in stale) self$remove(uri) + self$truncated <- queue$size() > 0L || count >= max_files + package <- vapply(self$pending, function(uri) { + !is.null(self$files$get(uri)$package_root) + }, logical(1L)) + self$pending <- c(self$pending[package], self$pending[!package]) + invisible(NULL) + }, + + set_summary = function(summary) { + uri <- summary$uri + old_sources <- self$source_edges$get(uri, character()) + for (target in old_sources) { + reverse <- setdiff(self$reverse_edges$get(target, character()), uri) + if (length(reverse)) { + self$reverse_edges$set(target, reverse) + } else if (self$reverse_edges$has(target)) { + self$reverse_edges$remove(target) + } + } + self$summaries$set(uri, summary) + self$source_edges$set(uri, summary$sources) + for (target in summary$sources) { + self$reverse_edges$set(target, + union(self$reverse_edges$get(target, character()), uri)) + } + self$cache_dirty <- TRUE + invisible(summary) + }, + + update_content = function(uri, content, metadata = NULL, + cacheable = TRUE) { + if (!self$enabled) return(NULL) + path <- path_from_uri(uri) + if (!self$should_index(path)) return(NULL) + if (is.null(metadata)) metadata <- file.info(path) + summary <- index_shallow_summary( + path, content, self$root, metadata = metadata) + uri <- index_canonical_uri(uri) + summary$uri <- uri + summary$cacheable <- isTRUE(cacheable) + if (isTRUE(summary$parse_error) && self$summaries$has(uri)) { + previous <- self$summaries$get(uri) + summary$definitions <- previous$definitions + summary$sources <- previous$sources + summary$source_candidates <- previous$source_candidates + summary$source_candidate_exists <- + previous$source_candidate_exists + } + self$set_summary(summary) + if (!self$processing_batch) { + self$pending <- setdiff(self$pending, uri) + } + if (!self$files$has(uri)) { + self$files$set(uri, summary[c( + "uri", "path", "size", "mtime", "package_root")]) + } + summary + }, + + update_path = function(path) { + if (!self$enabled || !self$should_index(path) || !file.exists(path)) { + return(NULL) + } + info <- file.info(path) + if (!nrow(info) || is.na(info$size[[1L]]) || + info$size[[1L]] > self$max_file_bytes()) return(NULL) + content <- tryCatch(stringi::stri_read_lines(path), + error = function(e) NULL) + if (is.null(content)) return(NULL) + self$update_content(path_to_uri(index_normalize_path(path)), content, info) + }, + + process_batch = function() { + if (!length(self$pending)) { + self$save_cache() + return(character()) + } + batch_size <- suppressWarnings(as.integer( + lsp_settings$get("index_batch_size"))) + if (length(batch_size) != 1L || is.na(batch_size) || batch_size < 1L) { + batch_size <- 20L + } + budget <- suppressWarnings(as.numeric( + lsp_settings$get("index_time_budget_ms"))) + if (length(budget) != 1L || is.na(budget) || budget <= 0) budget <- 25 + started <- proc.time()[[3L]] + processed <- character() + candidates <- head(self$pending, batch_size) + consumed <- 0L + self$processing_batch <- TRUE + on.exit({ + self$processing_batch <- FALSE + }, add = TRUE) + for (uri in candidates) { + consumed <- consumed + 1L + summary <- self$update_path(path_from_uri(uri)) + if (!is.null(summary)) processed <- c(processed, uri) + elapsed_ms <- (proc.time()[[3L]] - started) * 1000 + if (elapsed_ms >= budget) break + } + if (consumed) self$pending <- self$pending[-seq_len(consumed)] + self$processing_batch <- FALSE + if (!length(self$pending)) self$save_cache() + processed + }, + + remove = function(uri) { + uri <- index_canonical_uri(uri) + old_sources <- self$source_edges$get(uri, character()) + for (target in old_sources) { + reverse <- setdiff(self$reverse_edges$get(target, character()), uri) + if (length(reverse)) self$reverse_edges$set(target, reverse) + else if (self$reverse_edges$has(target)) self$reverse_edges$remove(target) + } + if (self$source_edges$has(uri)) self$source_edges$remove(uri) + if (self$summaries$has(uri)) self$summaries$remove(uri) + if (self$files$has(uri)) self$files$remove(uri) + self$pending <- setdiff(self$pending, uri) + self$cache_dirty <- TRUE + invisible(NULL) + }, + + source_closure = function(uri) { + result <- character(self$max_files() + 1L) + result_count <- 0L + queue <- collections::queue() + queue$push(index_canonical_uri(uri)) + visited <- new.env(hash = TRUE, parent = emptyenv()) + while (queue$size()) { + current <- queue$pop() + if (exists(current, envir = visited, inherits = FALSE)) next + assign(current, TRUE, envir = visited) + result_count <- result_count + 1L + if (result_count > length(result)) { + result <- c(result, character(length(result))) + } + result[[result_count]] <- current + for (target in self$source_edges$get(current, character())) { + queue$push(target) + } + } + if (result_count) result[seq_len(result_count)] else character() + }, + + dependent_closure = function(uri) { + result <- character(self$max_files() + 1L) + result_count <- 0L + queue <- collections::queue() + queue$push(index_canonical_uri(uri)) + visited <- new.env(hash = TRUE, parent = emptyenv()) + while (queue$size()) { + current <- queue$pop() + if (exists(current, envir = visited, inherits = FALSE)) next + assign(current, TRUE, envir = visited) + result_count <- result_count + 1L + if (result_count > length(result)) { + result <- c(result, character(length(result))) + } + result[[result_count]] <- current + for (dependent in self$reverse_edges$get(current, character())) { + queue$push(dependent) + } + } + if (result_count) result[seq_len(result_count)] else character() + }, + + dependents = function(uri, include_candidates = FALSE) { + uri <- index_canonical_uri(uri) + result <- self$reverse_edges$get(uri, character()) + if (isTRUE(include_candidates)) { + for (summary in self$summaries$values()) { + candidates <- summary$source_candidates + if (!is.null(candidates) && uri %in% candidates) { + result <- union(result, summary$uri) + } + } + } + result + }, + + package_root_for_uri = function(uri) { + uri <- index_canonical_uri(uri) + if (self$summaries$has(uri)) { + return(self$summaries$get(uri)$package_root) + } + if (self$files$has(uri)) return(self$files$get(uri)$package_root) + path <- path_from_uri(uri) + if (self$contains_path(path)) index_package_root(path, self$root) else NULL + }, + + package_source_uris = function(package_root = NULL) { + uris <- self$files$keys() + keep <- vapply(uris, function(uri) { + root <- self$files$get(uri)$package_root + !is.null(root) && (is.null(package_root) || identical(root, package_root)) + }, logical(1L)) + uris[keep] + }, + + definitions_for_query = function(pattern) { + result <- list() + for (summary in self$summaries$values()) { + definitions <- summary$definitions + symbols <- names(definitions) + matches <- symbols[fuzzy_find(symbols, pattern)] + result <- c(result, lapply(unname(definitions[matches]), function(def) { + c(uri = summary$uri, def) + })) + } + result + } + ) +) diff --git a/R/inlay_hint.R b/R/inlay_hint.R index e0f3754c..06b7e76c 100644 --- a/R/inlay_hint.R +++ b/R/inlay_hint.R @@ -106,10 +106,9 @@ inlay_hint_reply <- function(id, uri, workspace, document, request_range) { if (exists(cache_key, envir = formals_cache, inherits = FALSE)) { function_formals <- get(cache_key, envir = formals_cache, inherits = FALSE) } else { - function_formals <- tryCatch( - workspace$get_formals(function_name, package), - error = function(e) NULL - ) + function_formals <- tryCatch(call_with_optional_uri( + workspace$get_formals, function_name, package, uri = uri), + error = function(e) NULL) assign(cache_key, function_formals, envir = formals_cache) } @@ -186,7 +185,7 @@ inlay_hint_resolve_reply <- function(id, workspace, hint) { paste0(package, "::", function_name) } contents <- function_argument_hover_contents( - workspace, function_name, package, parameter) + workspace, function_name, package, parameter, uri = hint$data$uri) if (is.null(contents)) { contents <- sprintf( "Parameter `%s` of `%s()`.", parameter, qualified_name) diff --git a/R/languageserver.R b/R/languageserver.R index 3e7d56bb..d7bbcdc3 100644 --- a/R/languageserver.R +++ b/R/languageserver.R @@ -85,6 +85,12 @@ LanguageServer <- R6::R6Class("LanguageServer", # Start latency-sensitive parse work before diagnostics. self$parse_task_manager$run_tasks() if (!self$parse_task_manager$has_work()) { + for (workspace in self$workspaces$values()) { + if (!is.null(workspace$index) && + isTRUE(workspace$index$enabled)) { + workspace$index$process_batch() + } + } self$diagnostics_task_manager$run_tasks() } self$resolve_task_manager$run_tasks() @@ -169,22 +175,133 @@ LanguageServer <- R6::R6Class("LanguageServer", self$workspace_cache$set(uri, best_match) best_match }, + load_index_document = function(workspace, uri) { + if (workspace$documents$has(uri)) return(invisible(NULL)) + path <- path_from_uri(uri) + if (!file.exists(path) || dir.exists(path)) return(invisible(NULL)) + content <- tryCatch(stringi::stri_read_lines(path), + error = function(e) NULL) + if (is.null(content)) return(invisible(NULL)) + doc <- Document$new( + uri, language = "r", version = NULL, content = content) + workspace$documents$set(uri, doc) + self$text_sync(uri, document = doc, parse = TRUE) + invisible(doc) + }, + + refresh_index_documents = function(workspace, entry_uri = NULL) { + index <- workspace$index + if (is.null(index) || !isTRUE(index$enabled)) return(invisible(NULL)) + entries <- if (is.null(entry_uri)) { + Filter(function(uri) { + doc <- workspace$documents$get(uri, NULL) + !is.null(doc) && isTRUE(doc$is_open) + }, workspace$documents$keys()) + } else { + entry_uri + } + for (entry in entries) { + entry_key <- index_canonical_uri(entry) + queue <- collections::queue() + queue$push(entry_key) + visited <- new.env(hash = TRUE, parent = emptyenv()) + while (queue$size()) { + uri <- queue$pop() + if (exists(uri, envir = visited, inherits = FALSE)) next + assign(uri, TRUE, envir = visited) + if (!index$summaries$has(uri)) { + index$update_path(path_from_uri(uri)) + } + if (!identical(uri, entry_key)) { + self$load_index_document(workspace, uri) + } + for (target in index$source_edges$get(uri, character())) { + queue$push(target) + } + } + } + self$prune_index_documents(workspace) + invisible(NULL) + }, + + prune_index_documents = function(workspace) { + index <- workspace$index + if (is.null(index) || !isTRUE(index$enabled)) return(invisible(NULL)) + document_uris <- workspace$documents$keys() + open_uris <- Filter(function(uri) { + isTRUE(workspace$documents$get(uri)$is_open) + }, document_uris) + keep <- union(index$package_source_uris(), open_uris) + for (uri in open_uris) keep <- union(keep, index$source_closure(uri)) + keep <- unique(vapply(keep, index_canonical_uri, character(1L))) + remove <- document_uris[!vapply(document_uris, function(uri) { + index_canonical_uri(uri) %in% keep + }, logical(1L))] + remove <- Filter(function(uri) { + index$contains_path(path_from_uri(uri)) + }, remove) + for (uri in remove) { + diagnostics_callback(self, uri, NULL, list()) + workspace$documents$remove(uri) + } + if (length(remove)) { + workspace$diagnostics_globals_cache <- NULL + workspace$type_hierarchy_cache$clear() + workspace$update_loaded_packages() + } + invisible(NULL) + }, + + prune_legacy_documents = function(workspace) { + source_dir <- if (is_package(workspace$root)) { + index_normalize_path(file.path(workspace$root, "R")) + } else { + NULL + } + remove <- Filter(function(uri) { + doc <- workspace$documents$get(uri) + if (isTRUE(doc$is_open)) return(FALSE) + path <- index_normalize_path(path_from_uri(uri)) + is.null(source_dir) || !identical(dirname(path), source_dir) + }, workspace$documents$keys()) + for (uri in remove) { + diagnostics_callback(self, uri, NULL, list()) + workspace$documents$remove(uri) + } + if (length(remove)) { + workspace$diagnostics_globals_cache <- NULL + workspace$type_hierarchy_cache$clear() + workspace$update_loaded_packages() + } + invisible(NULL) + }, + load_workspace = function(workspace) { - if (!is_package(workspace$root)) { + if (is.null(workspace$index) || !isTRUE(workspace$index$enabled)) { + if (is_package(workspace$root)) { + source_dir <- file.path(workspace$root, "R") + files <- list.files( + source_dir, pattern = "\\.r$", ignore.case = TRUE) + for (file in files) { + self$load_index_document( + workspace, + path_to_uri(file.path(source_dir, file)) + ) + } + workspace$import_from_namespace_file() + } return(invisible(NULL)) } logger$info("load workspace:", workspace$root) - source_dir <- file.path(workspace$root, "R") - files <- list.files(source_dir, pattern = "\\.r$", ignore.case = TRUE) - for (f in files) { - logger$info("load file:", f) - path <- file.path(source_dir, f) - uri <- path_to_uri(path) - doc <- Document$new(uri, language = "r", version = NULL, content = stringi::stri_read_lines(path)) - workspace$documents$set(uri, doc) - self$text_sync(uri, document = doc, parse = TRUE) + workspace$index$discover() + for (uri in workspace$index$package_source_uris()) { + logger$info("load package file:", path_from_uri(uri)) + if (!workspace$index$summaries$has(uri)) { + workspace$index$update_path(path_from_uri(uri)) + } + self$load_index_document(workspace, uri) } - workspace$import_from_namespace_file() + if (is_package(workspace$root)) workspace$import_from_namespace_file() }, load_workspaces = function() { for (workspace in self$workspaces$values()) { diff --git a/R/namespace.R b/R/namespace.R index c1e57bdb..c3060252 100644 --- a/R/namespace.R +++ b/R/namespace.R @@ -183,15 +183,22 @@ WORKSPACE <- "_workspace_" GlobalEnv <- R6::R6Class("GlobalEnv", public = list( documents = NULL, + document_uris = NULL, package_name = NULL, - initialize = function(documents) { + initialize = function(documents, document_uris = NULL) { self$documents <- documents + self$document_uris <- document_uris self$package_name <- WORKSPACE }, + document_values = function() { + if (is.null(self$document_uris)) return(self$documents$values()) + lapply(self$document_uris, function(uri) self$documents$get(uri)) + }, + exists = function(objname, exported_only = TRUE) { - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (objname %in% doc$parse_data$nonfuncts) { return(TRUE) @@ -204,7 +211,7 @@ GlobalEnv <- R6::R6Class("GlobalEnv", }, exists_funct = function(funct, exported_only = TRUE) { - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (funct %in% doc$parse_data$functs) { return(TRUE) @@ -216,7 +223,7 @@ GlobalEnv <- R6::R6Class("GlobalEnv", get_symbols = function(want_functs = TRUE, exported_only = TRUE) { symbols <- character(0) - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (want_functs) { symbols <- c(symbols, doc$parse_data$functs) @@ -233,7 +240,7 @@ GlobalEnv <- R6::R6Class("GlobalEnv", }, get_signature = function(funct, exported_only = TRUE) { - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (funct %in% doc$parse_data$functs) { return(doc$parse_data$signatures[[funct]]) @@ -244,7 +251,7 @@ GlobalEnv <- R6::R6Class("GlobalEnv", }, get_formals = function(funct, exported_only = TRUE) { - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (funct %in% doc$parse_data$functs) { return(formals(doc$parse_data$functions[[funct]])) @@ -255,7 +262,7 @@ GlobalEnv <- R6::R6Class("GlobalEnv", }, get_documentation = function(topic) { - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (topic %in% doc$parse_data$objects) { return(doc$parse_data$documentation[[topic]]) @@ -266,7 +273,7 @@ GlobalEnv <- R6::R6Class("GlobalEnv", }, get_definition = function(symbol, exported_only = TRUE) { - for (doc in self$documents$values()) { + for (doc in self$document_values()) { if (!is.null(doc$parse_data)) { if (symbol %in% doc$parse_data$objects) { def <- location( diff --git a/R/references.R b/R/references.R index 54bd2480..482e8252 100644 --- a/R/references.R +++ b/R/references.R @@ -216,7 +216,9 @@ references_reply <- function(id, uri, workspace, document, point) { definition_key <- reference_key_at( parse_data$reference_index, token_point, token$token) if (!is.null(definition_key)) { - for (doc_uri in workspace$documents$keys()) { + doc_uris <- workspace_reference_document_uris( + workspace, defn$result$uri, uri) + for (doc_uri in doc_uris) { indexed <- workspace$get_parse_data(doc_uri)$reference_index if (is.null(indexed)) next selected <- which( @@ -233,7 +235,8 @@ references_reply <- function(id, uri, workspace, document, point) { return(Response$new(id, result = result)) } - doc_uris <- workspace$documents$keys() + doc_uris <- workspace_reference_document_uris( + workspace, defn$result$uri, uri) doc_results <- lapply(doc_uris, function(doc_uri) { doc <- workspace$documents$get(doc_uri) xdoc <- workspace$get_parse_data(doc_uri)$xml_doc @@ -255,7 +258,9 @@ references_reply <- function(id, uri, workspace, document, point) { idx <- 0L for (i in seq_along(symbols)) { symbol_point <- list(row = line1[[i]] - 1, col = col1[[i]]) - symbol_defn <- definition_reply(NULL, doc_uri, workspace, doc, symbol_point) + symbol_defn <- definition_reply( + NULL, doc_uri, workspace, doc, symbol_point, + context_uri = uri) if (identical(symbol_defn$result, defn$result)) { idx <- idx + 1L matches[[idx]] <- list( diff --git a/R/settings.R b/R/settings.R index 4ef57b3c..adb1f1bf 100644 --- a/R/settings.R +++ b/R/settings.R @@ -14,6 +14,25 @@ Settings <- R6::R6Class("Settings", diagnostics_delay = 0.75, parse_cache_max_mb = 64, diagnostics_cache_max_mb = 16, + index_mode = "auto", + index_include = "**/*.R", + index_exclude = c( + "**/.git/**", + "**/.svn/**", + "**/.hg/**", + "**/renv/**", + "**/packrat/**", + "**/.Rproj.user/**", + "**/.cache/**", + "**/node_modules/**", + "**/build/**", + "**/dist/**" + ), + index_max_files = 10000L, + index_max_file_size_mb = 2, + index_batch_size = 20L, + index_time_budget_ms = 25, + index_persistent_cache = TRUE, server_capabilities = list(), link_file_size_limit = 16L * 1024L^2, nline_to_break_succession = 2L, diff --git a/R/signature.R b/R/signature.R index ed6c5a06..fa00694b 100644 --- a/R/signature.R +++ b/R/signature.R @@ -411,11 +411,15 @@ signature_reply <- function(id, uri, workspace, document, point) { } if (is.null(sig)) { - sig <- workspace$get_signature(result$token, result$package, - exported_only = result$accessor != ":::") + sig <- call_with_optional_uri( + workspace$get_signature, + result$token, result$package, + exported_only = result$accessor != ":::", uri = uri) logger$info("sig: ", sig) if (!is.null(sig)) { - doc <- workspace$get_documentation(result$token, result$package, isf = TRUE) + doc <- call_with_optional_uri( + workspace$get_documentation, + result$token, result$package, isf = TRUE, uri = uri) doc_string <- NULL if (is.character(doc)) { diff --git a/R/type_hierarchy.R b/R/type_hierarchy.R index e557c539..06a3658e 100644 --- a/R/type_hierarchy.R +++ b/R/type_hierarchy.R @@ -27,7 +27,8 @@ prepare_type_hierarchy_reply <- function(id, uri, workspace, document, point) { selectionRange = type_info$range, data = list( definition = type_info, - classType = type_info$classType + classType = type_info$classType, + contextUri = uri ) ) ) @@ -64,7 +65,8 @@ type_hierarchy_supertypes_reply <- function(id, workspace, item) { selectionRange = supertype$range, data = list( definition = supertype, - classType = supertype$classType + classType = supertype$classType, + contextUri = item$data$contextUri ) ) }) @@ -87,7 +89,10 @@ type_hierarchy_subtypes_reply <- function(id, workspace, item) { result <- list() if (!is.null(item$data$definition)) { - subtypes <- find_type_subtypes(workspace, item$data$definition) + context_uri <- item$data$contextUri + if (is.null(context_uri)) context_uri <- item$uri + subtypes <- find_type_subtypes( + workspace, item$data$definition, context_uri = context_uri) if (length(subtypes) > 0) { result <- lapply(subtypes, function(subtype) { @@ -99,7 +104,8 @@ type_hierarchy_subtypes_reply <- function(id, workspace, item) { selectionRange = subtype$range, data = list( definition = subtype, - classType = subtype$classType + classType = subtype$classType, + contextUri = context_uri ) ) }) @@ -618,10 +624,15 @@ find_s3_supertypes <- function(doc, xdoc, class_name, uri) { #' Find subtypes (child types) that inherit from a given type #' #' @noRd -find_type_subtypes <- function(workspace, type_def) { - cache_key <- paste( - "sub", type_def$uri, type_def$classType, type_def$name, - sep = "\r") +find_type_subtypes <- function(workspace, type_def, context_uri = type_def$uri) { + cache_key <- if (identical(context_uri, type_def$uri)) { + paste("sub", type_def$uri, type_def$classType, type_def$name, + sep = "\r") + } else { + paste( + "sub", context_uri, type_def$uri, type_def$classType, type_def$name, + sep = "\r") + } if (!is.null(workspace$type_hierarchy_cache) && workspace$type_hierarchy_cache$has(cache_key)) { return(workspace$type_hierarchy_cache$get(cache_key)) @@ -632,7 +643,7 @@ find_type_subtypes <- function(workspace, type_def) { parent_name <- type_def$name # Search through all documents for classes that inherit from this one - for (doc_uri in workspace$documents$keys()) { + for (doc_uri in workspace_document_uris(workspace, context_uri)) { doc <- workspace$documents$get(doc_uri) xdoc <- workspace$get_parse_data(doc_uri)$xml_doc diff --git a/R/utils.R b/R/utils.R index dfa28f1f..d7e02f18 100644 --- a/R/utils.R +++ b/R/utils.R @@ -77,6 +77,17 @@ capture_print <- function(x) { paste0(utils::capture.output(print(x)), collapse = "\n") } +#' Call a workspace method with URI context when the implementation supports it +#' @noRd +call_with_optional_uri <- function(fun, ..., uri = NULL) { + args <- list(...) + parameters <- names(formals(fun)) + if (!is.null(uri) && ("uri" %in% parameters || "..." %in% parameters)) { + args$uri <- uri + } + do.call(fun, args) +} + get_expr_type <- function(expr) { if (is.call(expr)) { func <- deparse(expr[[1]], nlines = 1) diff --git a/R/workspace.R b/R/workspace.R index c98af349..d2aa1839 100644 --- a/R/workspace.R +++ b/R/workspace.R @@ -20,6 +20,27 @@ workspace_startup_packages <- local({ } }) +#' Return semantic document scope with compatibility for lightweight fixtures +#' @noRd +workspace_document_uris <- function(workspace, uri = NULL) { + if (is.function(workspace$document_uris_for_context)) { + workspace$document_uris_for_context(uri) + } else { + workspace$documents$keys() + } +} + +#' Return documents that can reference a definition +#' @noRd +workspace_reference_document_uris <- function(workspace, definition_uri, + context_uri = definition_uri) { + if (is.function(workspace$document_uris_for_references)) { + workspace$document_uris_for_references(definition_uri, context_uri) + } else { + workspace_document_uris(workspace, context_uri) + } +} + #' A byte-bounded least-recently-used cache #' @noRd ByteLruCache <- R6::R6Class( @@ -97,6 +118,7 @@ Workspace <- R6::R6Class("Workspace", namespaces = NULL, global_env = NULL, documents = NULL, + index = NULL, # from NAMESPACE importFrom() imported_objects = NULL, @@ -115,6 +137,7 @@ Workspace <- R6::R6Class("Workspace", initialize = function(root) { self$root <- root self$documents <- collections::dict() + self$index <- WorkspaceIndex$new(root) self$imported_objects <- collections::dict() self$imported_packages <- character(0) self$global_env <- GlobalEnv$new(self$documents) @@ -162,15 +185,82 @@ Workspace <- R6::R6Class("Workspace", } }, - guess_namespace = function(object, isf = FALSE) { + document_uris_for_context = function(uri = NULL) { + all_uris <- self$documents$keys() + if (is.null(uri) || !length(uri) || !nzchar(uri) || + is.null(self$index) || !isTRUE(self$index$enabled)) { + return(all_uris) + } + if (!self$index$contains_path(path_from_uri(uri))) { + return(all_uris) + } + package_root <- self$index$package_root_for_uri(uri) + if (!is.null(package_root)) { + return(all_uris[vapply(all_uris, function(document_uri) { + identical( + self$index$package_root_for_uri(document_uri), + package_root + ) + }, logical(1L))]) + } + closure <- self$index$source_closure(uri) + all_uris[vapply(all_uris, function(document_uri) { + index_canonical_uri(document_uri) %in% closure + }, logical(1L))] + }, + + document_uris_for_references = function(definition_uri, + context_uri = definition_uri) { + all_uris <- self$documents$keys() + if (is.null(definition_uri) || !length(definition_uri) || + !nzchar(definition_uri) || is.null(self$index) || + !isTRUE(self$index$enabled)) { + return(self$document_uris_for_context(context_uri)) + } + definition_path <- path_from_uri(definition_uri) + if (!self$index$contains_path(definition_path)) { + return(self$document_uris_for_context(context_uri)) + } + package_root <- self$index$package_root_for_uri(definition_uri) + if (!is.null(package_root)) { + return(all_uris[vapply(all_uris, function(document_uri) { + identical( + self$index$package_root_for_uri(document_uri), + package_root + ) + }, logical(1L))]) + } + closure <- self$index$dependent_closure(definition_uri) + all_uris[vapply(all_uris, function(document_uri) { + index_canonical_uri(document_uri) %in% closure + }, logical(1L))] + }, + + loaded_packages_for_context = function(uri = NULL) { + if (is.null(uri) || !length(uri) || !nzchar(uri) || + is.null(self$index) || !isTRUE(self$index$enabled)) { + return(self$loaded_packages) + } + packages <- union(self$startup_packages, self$imported_packages) + for (document_uri in self$document_uris_for_context(uri)) { + doc <- self$documents$get(document_uri, NULL) + if (!is.null(doc)) packages <- union(packages, doc$loaded_packages) + } + packages + }, + + guess_namespace = function(object, isf = FALSE, uri = NULL) { if (!nzchar(object)) { return(NULL) } - packages <- c(WORKSPACE, rev(self$loaded_packages)) + packages <- c( + WORKSPACE, + rev(self$loaded_packages_for_context(uri)) + ) for (pkgname in packages) { - ns <- self$get_namespace(pkgname) + ns <- self$get_namespace(pkgname, uri = uri) if (isf) { if (!is.null(ns) && ns$exists_funct(object)) { logger$info("guess namespace:", pkgname) @@ -192,9 +282,16 @@ Workspace <- R6::R6Class("Workspace", NULL }, - get_namespace = function(pkgname) { + get_namespace = function(pkgname, uri = NULL) { if (pkgname == WORKSPACE) { - self$global_env + if (is.null(uri)) { + self$global_env + } else { + GlobalEnv$new( + self$documents, + self$document_uris_for_context(uri) + ) + } } else if (self$namespaces$has(pkgname)) { self$namespaces$get(pkgname) } else if (length(find.package(pkgname, quiet = TRUE))) { @@ -206,35 +303,37 @@ Workspace <- R6::R6Class("Workspace", } }, - get_signature = function(funct, pkgname = NULL, exported_only = TRUE) { + get_signature = function(funct, pkgname = NULL, exported_only = TRUE, + uri = NULL) { if (is.null(pkgname)) { - pkgname <- self$guess_namespace(funct, isf = TRUE) + pkgname <- self$guess_namespace(funct, isf = TRUE, uri = uri) if (is.null(pkgname)) { return(NULL) } } - ns <- self$get_namespace(pkgname) + ns <- self$get_namespace(pkgname, uri = uri) if (!is.null(ns)) { ns$get_signature(funct, exported_only = exported_only) } }, - get_formals = function(funct, pkgname = NULL, exported_only = TRUE) { + get_formals = function(funct, pkgname = NULL, exported_only = TRUE, + uri = NULL) { if (is.null(pkgname)) { - pkgname <- self$guess_namespace(funct, isf = TRUE) + pkgname <- self$guess_namespace(funct, isf = TRUE, uri = uri) if (is.null(pkgname)) { return(NULL) } } - ns <- self$get_namespace(pkgname) + ns <- self$get_namespace(pkgname, uri = uri) if (!is.null(ns)) { ns$get_formals(funct, exported_only = exported_only) } }, - get_help = function(topic, pkgname = NULL) { + get_help = function(topic, pkgname = NULL, uri = NULL) { if (is.null(pkgname)) { - pkgname <- self$guess_namespace(topic) + pkgname <- self$guess_namespace(topic, uri = uri) } # note: the parantheses are neccessary hfile <- tryCatch({ @@ -277,27 +376,29 @@ Workspace <- R6::R6Class("Workspace", } }, - get_documentation = function(topic, pkgname = NULL, isf = FALSE) { + get_documentation = function(topic, pkgname = NULL, isf = FALSE, + uri = NULL) { if (is.null(pkgname)) { - pkgname <- self$guess_namespace(topic, isf = isf) + pkgname <- self$guess_namespace(topic, isf = isf, uri = uri) if (is.null(pkgname)) { return(NULL) } } - ns <- self$get_namespace(pkgname) + ns <- self$get_namespace(pkgname, uri = uri) if (!is.null(ns)) { ns$get_documentation(topic) } }, - get_definition = function(symbol, pkgname = NULL, exported_only = TRUE) { + get_definition = function(symbol, pkgname = NULL, exported_only = TRUE, + uri = NULL) { if (is.null(pkgname)) { - pkgname <- self$guess_namespace(symbol, isf = FALSE) + pkgname <- self$guess_namespace(symbol, isf = FALSE, uri = uri) if (is.null(pkgname)) { return(NULL) } } - ns <- self$get_namespace(pkgname) + ns <- self$get_namespace(pkgname, uri = uri) if (!is.null(ns)) { ns$get_definition(symbol, exported_only = exported_only) } @@ -312,8 +413,18 @@ Workspace <- R6::R6Class("Workspace", }, get_definitions_for_query = function(pattern) { - result <- list() - for (doc in self$documents$values()) { + if (!is.null(self$index) && isTRUE(self$index$enabled)) { + result <- self$index$definitions_for_query(pattern) + indexed_uris <- self$index$summaries$keys() + documents <- self$documents$values() + documents <- documents[!vapply(documents, function(doc) { + index_canonical_uri(doc$uri) %in% indexed_uris + }, logical(1L))] + } else { + result <- list() + documents <- self$documents$values() + } + for (doc in documents) { parse_data <- doc$parse_data if (is.null(parse_data)) next symbols <- names(parse_data$definitions) @@ -340,7 +451,25 @@ Workspace <- R6::R6Class("Workspace", self$loaded_packages <- loaded_packages }, - get_diagnostics_globals = function() { + get_diagnostics_globals = function(uri = NULL) { + if (!is.null(uri) && !is.null(self$index) && + isTRUE(self$index$enabled)) { + globals <- new.env(parent = emptyenv()) + package_root <- self$index$package_root_for_uri(uri) + uris <- if (is.null(package_root)) { + self$index$source_closure(uri) + } else { + self$index$package_source_uris(package_root) + } + for (summary_uri in uris) { + summary <- self$index$summaries$get(summary_uri, NULL) + if (is.null(summary)) next + for (symbol in names(summary$definitions)) { + globals[[symbol]] <- NULL + } + } + return(globals) + } if (!is.null(self$diagnostics_globals_cache)) { return(self$diagnostics_globals_cache) } @@ -385,6 +514,22 @@ Workspace <- R6::R6Class("Workspace", } } self$documents$get(uri)$update_parse_data(parse_data) + if (!is.null(self$index) && isTRUE(self$index$enabled)) { + doc <- self$documents$get(uri) + index_uri <- index_canonical_uri(uri) + previous <- self$index$summaries$get(index_uri, NULL) + cacheable <- if (is.null(previous)) { + !isTRUE(doc$is_open) + } else { + !identical(previous$cacheable, FALSE) + } + summary <- self$index$update_content( + uri, doc$content, cacheable = cacheable) + if (!is.null(summary) && !isTRUE(parse_data$parse_error)) { + summary$definitions <- as.list(parse_data$definitions) + self$index$set_summary(summary) + } + } }, import_from_namespace_file = function() { diff --git a/README.md b/README.md index eeef477c..2b364e7c 100644 --- a/README.md +++ b/README.md @@ -190,6 +190,14 @@ settings | default | description `r.lsp.diagnostics_delay` | `0.75` | seconds to debounce diagnostics after the current parse `r.lsp.parse_cache_max_mb` | `64` | maximum memory used by cached document parse versions `r.lsp.diagnostics_cache_max_mb` | `16` | maximum memory used by cached diagnostics +`r.lsp.index_mode` | `"auto"` | index R files in the complete workspace; use `"off"` to restore package-only loading +`r.lsp.index_include` | `"**/*.R"` | glob or character vector of globs included in workspace indexing +`r.lsp.index_exclude` | common VCS, dependency, cache, and output directories | glob or character vector of globs excluded from workspace indexing +`r.lsp.index_max_files` | `10000` | maximum number of eligible R files discovered per workspace +`r.lsp.index_max_file_size_mb` | `2` | maximum size of a file included in the workspace index +`r.lsp.index_batch_size` | `20` | maximum number of shallow summaries built in one idle batch +`r.lsp.index_time_budget_ms` | `25` | approximate event-loop budget for each shallow-index batch +`r.lsp.index_persistent_cache` | `true` | persist validated shallow summaries in the user cache directory `r.lsp.server_capabilities` | `{}` | override server capabilities defined in [capabilities.R](https://github.com/REditorSupport/languageserver/blob/master/R/capabilities.R). See FAQ below. `r.lsp.link_file_size_limit` | 16384 | maximum file size (in bytes) that supports document links @@ -201,6 +209,14 @@ options(languageserver.snippet_support = FALSE) will turn off snippet support globally. LSP configuration settings are always overriden by `options()`. +Project indexing is deliberately two-tiered. Package `R/` files, open files, +and the transitive dependencies of static `source()` or `sys.source()` calls +receive full semantic parsing. Other scripts receive only a lightweight symbol +and source-call summary, so they appear in workspace symbol search without +polluting completion, definition, references, or rename in unrelated scripts. +Static paths built from string literals, `file.path()`, and `here::here()` are +recognized; project code is never executed to resolve a path. + ## FAQ ### Linters diff --git a/tests/testthat/test-call-hierarchy.R b/tests/testthat/test-call-hierarchy.R index b2ddc91f..9fa4e015 100644 --- a/tests/testthat/test-call-hierarchy.R +++ b/tests/testthat/test-call-hierarchy.R @@ -242,7 +242,8 @@ test_that("Call hierarchy outgoing calls works", { legacy_call_hierarchy_fixture <- function() { content <- c( "target <- function() 1", - "caller <- function() { target(); target() }" + "caller <- function() { target(); target() }", + "target()" ) uri <- "file:///legacy-call-hierarchy.R" document <- Document$new(uri, version = 1L, content = content) @@ -317,12 +318,17 @@ test_that("Call hierarchy falls back to XML for incoming calls", { 1L, fixture$workspace, item ) - expect_length(reply$result, 1L) - expect_equal(reply$result[[1L]]$from$name, "caller") - expect_equal(reply$result[[1L]]$from$kind, SymbolKind$Function) - expect_length(reply$result[[1L]]$fromRanges, 2L) + expect_length(reply$result, 2L) + caller <- keep(reply$result, ~ .$from$name == "caller")[[1L]] + expect_equal(caller$from$kind, SymbolKind$Function) + expect_length(caller$fromRanges, 2L) expect_equal( - map_int(reply$result[[1L]]$fromRanges, c("start", "character")), + map_int(caller$fromRanges, c("start", "character")), c(23L, 33L) ) + top_level <- keep( + reply$result, ~ .$from$name == "legacy-call-hierarchy.R")[[1L]] + expect_equal(top_level$from$kind, SymbolKind$File) + expect_equal(top_level$from$detail, "top level") + expect_equal(top_level$fromRanges[[1L]]$start$line, 2L) }) diff --git a/tests/testthat/test-code-lens.R b/tests/testthat/test-code-lens.R index d6cc0058..b65513ae 100644 --- a/tests/testthat/test-code-lens.R +++ b/tests/testthat/test-code-lens.R @@ -20,9 +20,21 @@ test_that("code lenses lazily resolve R function call counts", { expect_equal(resolved$command$title, "2 calls") expect_equal( resolved$command$command, - "editor.showCallHierarchy" + "editor.action.peekLocations" ) - expect_null(resolved$command$arguments) + expect_length(resolved$command$arguments, 3L) + expect_equal(resolved$command$arguments[[1L]]$`$mid`, 1L) + expect_equal(resolved$command$arguments[[1L]]$scheme, "file") + expect_equal( + resolved$command$arguments[[2L]], + list(lineNumber = 1L, column = 1L) + ) + expect_length(resolved$command$arguments[[3L]], 2L) + expect_true(all(vapply( + resolved$command$arguments[[3L]], + function(value) identical(value$uri$`$mid`, 1L), + logical(1L) + ))) }) test_that("code lenses work through the language server after incremental edits", { @@ -46,7 +58,8 @@ test_that("code lenses work through the language server after incremental edits" expect_length(lenses, 1L) resolved <- respond(client, "codeLens/resolve", lenses[[1L]]) expect_equal(resolved$command$title, "1 call") - expect_equal(resolved$command$command, "editor.showCallHierarchy") + expect_equal(resolved$command$command, "editor.action.peekLocations") + expect_length(resolved$command$arguments[[3L]], 1L) notify(client, "textDocument/didChange", list( textDocument = list(uri = uri, version = 2L), diff --git a/tests/testthat/test-index.R b/tests/testthat/test-index.R new file mode 100644 index 00000000..f9457844 --- /dev/null +++ b/tests/testthat/test-index.R @@ -0,0 +1,318 @@ +local_index_settings <- function(...) { + values <- list(...) + old <- lapply(names(values), lsp_settings$get) + names(old) <- names(values) + withr::defer({ + for (name in names(old)) lsp_settings$set(name, old[[name]]) + }, envir = parent.frame()) + for (name in names(values)) lsp_settings$set(name, values[[name]]) +} + +test_that("index globs include R files and prune excluded directories", { + expect_true(index_glob_match("script.R", "**/*.R")) + expect_true(index_glob_match("analysis/script.r", "**/*.R")) + expect_false(index_glob_match("analysis/script.Rmd", "**/*.R")) + expect_true(index_glob_match("renv/", "**/renv/**")) + expect_true(index_glob_match("nested/.git/", "**/.git/**")) +}) + +test_that("shallow summaries extract definitions and static source calls", { + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + dir.create(file.path(root, "R")) + writeLines("first <- function(x) x", file.path(root, "R", "first.R")) + writeLines("second <- 2", file.path(root, "R", "second.R")) + writeLines("third <- 3", file.path(root, "R", "third.R")) + writeLines("fourth <- 4", file.path(root, "R", "fourth.R")) + path <- file.path(root, "main.R") + content <- c( + "source(file.path(\"R\", \"first.R\"))", + "base::source(\"R/second.R\")", + "sys.source(file = here::here(\"R\", \"third.R\"), envir = environment())", + "source(dynamic_path)", + "value <- 1", + "work <- function(x) x" + ) + writeLines(content, path) + + summary <- index_shallow_summary(path, content, root) + expect_setequal(names(summary$definitions), c("value", "work")) + expect_equal(summary$definitions$work$type, "function") + expect_setequal( + basename(vapply(summary$sources, path_from_uri, character(1L))), + c("first.R", "second.R", "third.R") + ) + expect_false(any(grepl("dynamic", summary$sources, fixed = TRUE))) +}) + +test_that("source discovery tolerates missing call arguments", { + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + helper <- file.path(root, "helper.R") + writeLines("helper <- TRUE", helper) + path <- file.path(root, "main.R") + content <- c( + "ordinary_call(, value)", + "source(file = )", + "source(\"helper.R\", )" + ) + writeLines(content, path) + + summary <- index_shallow_summary(path, content, root) + + expect_equal(summary$sources, list(path_to_uri(helper))) +}) + +test_that("source closure is transitive and cycle safe", { + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + writeLines(c("source(\"a.R\")", "main <- TRUE"), + file.path(root, "main.R")) + writeLines(c("source(\"b.R\")", "a <- TRUE"), file.path(root, "a.R")) + writeLines(c("source(\"a.R\")", "b <- TRUE"), file.path(root, "b.R")) + + index <- WorkspaceIndex$new(root) + index$discover() + while (length(index$pending)) index$process_batch() + + closure <- index$source_closure(path_to_uri(file.path(root, "main.R"))) + expect_length(closure, 3L) + expect_setequal( + basename(vapply(closure, path_from_uri, character(1L))), + c("main.R", "a.R", "b.R") + ) + dependents <- index$dependent_closure( + path_to_uri(file.path(root, "b.R"))) + expect_setequal( + basename(vapply(dependents, path_from_uri, character(1L))), + c("main.R", "a.R", "b.R") + ) +}) + +test_that("source edges survive incomplete edits and resolve created targets", { + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + main <- file.path(root, "main.R") + helper <- file.path(root, "helper.R") + future <- file.path(root, "future.R") + writeLines(c("source(\"helper.R\")", "source(\"future.R\")"), main) + writeLines("helper <- TRUE", helper) + + index <- WorkspaceIndex$new(root) + index$discover() + while (length(index$pending)) index$process_batch() + main_uri <- path_to_uri(main) + helper_uri <- index_canonical_uri(path_to_uri(helper)) + expect_true(helper_uri %in% index$source_closure(main_uri)) + + index$update_content(main_uri, c("source(\"helper.R\")", "broken(")) + expect_true(helper_uri %in% index$source_closure(main_uri)) + + # Restore the valid buffer, then create a previously unresolved target. + index$update_content(main_uri, + c("source(\"helper.R\")", "source(\"future.R\")")) + writeLines("future <- TRUE", future) + future_uri <- index_canonical_uri(path_to_uri(future)) + expect_true(index_canonical_uri(main_uri) %in% index$dependents( + future_uri, include_candidates = TRUE)) + index$update_path(main) + expect_true(future_uri %in% index$source_closure(main_uri)) +}) + +test_that("discovery enforces exclusions, file sizes, and file limits", { + local_index_settings( + index_persistent_cache = FALSE, + index_max_files = 2L, + index_max_file_size_mb = 0.0001 + ) + root <- withr::local_tempdir() + dir.create(file.path(root, "renv")) + writeLines("ignored <- 1", file.path(root, "renv", "ignored.R")) + writeLines(strrep("x", 500L), file.path(root, "large.R")) + writeLines("a <- 1", file.path(root, "a.R")) + writeLines("b <- 1", file.path(root, "b.R")) + writeLines("c <- 1", file.path(root, "c.R")) + + index <- WorkspaceIndex$new(root) + index$discover() + paths <- vapply(index$files$values(), `[[`, character(1L), "path") + expect_length(paths, 2L) + expect_false(any(grepl("renv", paths, fixed = TRUE))) + expect_false(any(endsWith(paths, "large.R"))) + expect_true(index$truncated) +}) + +test_that("nested package roots are detected independently", { + root <- withr::local_tempdir() + for (package in c("one", "two")) { + package_root <- file.path(root, package) + dir.create(file.path(package_root, "R"), recursive = TRUE) + writeLines(c( + paste0("Package: ", package), + "Version: 0.0.1" + ), file.path(package_root, "DESCRIPTION")) + writeLines("value <- 1", file.path(package_root, "R", "code.R")) + } + one <- index_package_root(file.path(root, "one", "R", "code.R"), root) + two <- index_package_root(file.path(root, "two", "R", "code.R"), root) + expect_equal(basename(one), "one") + expect_equal(basename(two), "two") + expect_false(identical(one, two)) +}) + +test_that("semantic workspace scope isolates scripts but includes sources", { + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + paths <- file.path(root, c("main.R", "helper.R", "unrelated.R")) + contents <- list( + c("source(\"helper.R\")", "main_fun <- function() helper_fun()"), + "helper_fun <- function() TRUE", + "unrelated_fun <- function() TRUE" + ) + Map(writeLines, contents, paths) + + workspace <- Workspace$new(root) + workspace$index$discover() + while (length(workspace$index$pending)) workspace$index$process_batch() + for (i in seq_along(paths)) { + uri <- path_to_uri(paths[[i]]) + doc <- Document$new(uri, content = contents[[i]]) + parsed <- parse_document(uri, contents[[i]]) + doc$parse_data <- as.list(parsed) + workspace$documents$set(uri, doc) + } + + main_uri <- path_to_uri(paths[[1L]]) + unrelated_uri <- path_to_uri(paths[[3L]]) + main_symbols <- workspace$get_namespace( + WORKSPACE, uri = main_uri)$get_symbols(TRUE) + unrelated_symbols <- workspace$get_namespace( + WORKSPACE, uri = unrelated_uri)$get_symbols(TRUE) + + expect_setequal(main_symbols, c("main_fun", "helper_fun")) + expect_equal(unrelated_symbols, "unrelated_fun") + expect_false("unrelated_fun" %in% main_symbols) + + workspace_symbols <- workspace$get_definitions_for_query("fun") + expect_setequal( + vapply(workspace_symbols, `[[`, character(1L), "name"), + c("main_fun", "helper_fun", "unrelated_fun") + ) +}) + +test_that("plain projects load source closures without merging unrelated scripts", { + skip_on_cran() + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + main <- file.path(root, "main.R") + writeLines(c( + "source(\"helper.R\")", + "helper_fun()", + "unrelated_fun()" + ), main) + writeLines("helper_fun <- function(value = 1) value", + file.path(root, "helper.R")) + writeLines("unrelated_fun <- function(hidden = TRUE) hidden", + file.path(root, "unrelated.R")) + + client <- language_client(root) + client %>% did_open(main) + + sourced <- client %>% respond_signature(main, c(1, 11), + retry_when = function(result) length(result$signatures) == 0L) + expect_length(sourced$signatures, 1L) + expect_match(sourced$signatures[[1L]]$label, "helper_fun\\(value") + + isolated <- client %>% respond_signature(main, c(2, 14), + retry_when = function(result) length(result$signatures) > 0L) + expect_length(isolated$signatures, 0L) + + symbols <- client %>% respond_workspace_symbol("unrelated_fun", + retry_when = function(result) length(result) == 0L) + expect_length(symbols, 1L) +}) + +test_that("references and code lenses include source dependents", { + skip_on_cran() + local_index_settings(index_persistent_cache = FALSE) + root <- withr::local_tempdir() + definition <- file.path(root, "src_test1.R") + caller <- file.path(root, "src_test2.R") + unrelated <- file.path(root, "unrelated.R") + writeLines(c( + "test1 <- 1", + "test2 <- 2", + "fun1 <- function(x) {", + " x + 1", + "}" + ), definition) + writeLines(c( + "source(\"./src_test1.R\")", + "", + "fun1(x)", + "fun1(1)" + ), caller) + writeLines("fun1(x)", unrelated) + + client <- language_client(root, capabilities = list( + textDocument = list(codeLens = list( + resolveSupport = list(properties = list("command")) + )) + )) + client %>% did_open(caller) + client %>% did_open(unrelated) + + from_call <- client %>% respond_references( + caller, c(2, 1), retry_when = function(result) length(result) < 3L) + expect_equal(sum(vapply(from_call, function(value) { + identical(value$uri, path_to_uri(caller)) + }, logical(1L))), 2L) + expect_true(any(vapply(from_call, function(value) { + identical(value$uri, path_to_uri(definition)) + }, logical(1L)))) + + client %>% did_open(definition) + from_definition <- client %>% respond_references( + definition, c(2, 1), + retry_when = function(result) length(result) < 3L) + expect_equal(sum(vapply(from_definition, function(value) { + identical(value$uri, path_to_uri(caller)) + }, logical(1L))), 2L) + expect_true(any(vapply(from_definition, function(value) { + identical(value$uri, path_to_uri(definition)) + }, logical(1L)))) + + lenses <- respond( + client, + "textDocument/codeLens", + list(textDocument = list(uri = path_to_uri(definition))) + ) + expect_length(lenses, 1L) + resolved <- respond(client, "codeLens/resolve", lenses[[1L]]) + expect_equal(resolved$command$title, "2 calls") + expect_equal(resolved$command$command, "editor.action.peekLocations") + expect_length(resolved$command$arguments[[3L]], 2L) + caller_path <- vscode_command_uri(path_to_uri(caller))$path + expect_true(all(vapply( + resolved$command$arguments[[3L]], + function(value) identical(value$uri$path, caller_path), + logical(1L) + ))) + + items <- client %>% respond_prepare_call_hierarchy(definition, c(2, 1)) + incoming <- client %>% respond_call_hierarchy_incoming_calls(items[[1L]]) + expect_length(incoming, 1L) + expect_equal(incoming[[1L]]$from$name, basename(caller)) + expect_equal(incoming[[1L]]$from$kind, SymbolKind$File) + expect_equal(incoming[[1L]]$from$uri, path_to_uri(caller)) + expect_equal(incoming[[1L]]$fromRanges, list( + list( + start = list(line = 2L, character = 0L), + end = list(line = 2L, character = 4L) + ), + list( + start = list(line = 3L, character = 0L), + end = list(line = 3L, character = 4L) + ) + )) +}) diff --git a/tests/testthat/test-symbol.R b/tests/testthat/test-symbol.R index 24be0db4..f1f6c2b2 100644 --- a/tests/testthat/test-symbol.R +++ b/tests/testthat/test-symbol.R @@ -229,10 +229,9 @@ test_that("Document section symbol works", { test_that("Workspace Symbol works", { skip_on_cran() - client <- language_client() - - defn_file <- withr::local_tempfile(fileext = ".R") - defn2_file <- withr::local_tempfile(fileext = ".R") + root <- withr::local_tempdir() + defn_file <- file.path(root, "definitions.R") + defn2_file <- file.path(root, "more-definitions.R") writeLines(c( "f1 <- function(x) {", " x + 1", @@ -253,6 +252,7 @@ test_that("Workspace Symbol works", { ")" ), defn2_file) + client <- language_client(root) client %>% did_open(defn_file) client %>% did_open(defn2_file)