Add scalable project-wide R indexing

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

R/call_hierarchy.R

@@ -14,12 +14,41 @@
     )
 }
 
+#' 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 @@
         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) *
@@ -53,7 +95,7 @@
             }, numeric(1L))
             definition <- definitions[[containing[[which.min(spans)]]]]
             if (doc_uri == item$uri &&
                 equal_range(definition$range, item$data$definition$range)) {
                 next
             }
 
@@ -72,15 +114,15 @@
                         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,16 +153,19 @@
         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(
             row = index$line[[i]],
             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 @@
                 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 @@
                 selectionRange = defn$range,
                 data = list(
                     definition = defn,
-                    definitionKey = definition_key
+                    definitionKey = definition_key,
+                    contextUri = uri
                 )
             )
         )
@@ -199,7 +248,11 @@
 
     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 @@
 
             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 @@
                                 definition = list(
                                     uri = doc_uri,
                                     range = defn$range
-                                )
+                                ),
+                                contextUri = context_uri
                             )
                         ),
                         fromRanges = list()
@@ -288,6 +344,59 @@
                 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 @@
     }
 
     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 @@
 
     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 @@
                     range = symbol_defn$range,
                     selectionRange = symbol_defn$range,
                     data = list(
-                        definition = symbol_defn
+                        definition = symbol_defn,
+                        contextUri = context_uri
                     )
                 ),
                 fromRanges = list()

R/code_lens.R

@@ -3,8 +3,8 @@
 current_parse_data <- function(uri, workspace, document) {
     parse_data <- workspace$get_parse_data(uri)
     if (is.null(parse_data) ||
         (!is.null(parse_data$version) &&
             !isTRUE(parse_data$version == document$version))) {
         return(NULL)
     }
     parse_data
@@ -12,11 +12,13 @@
 
 #' 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
@@ -44,7 +46,7 @@
                 "not(preceding-sibling::NS_GET or ",
                 "preceding-sibling::NS_GET_INT)]"
             ),
                 token_quote = token_quote)
         )
         if (!length(nodes)) next
 
@@ -68,21 +70,81 @@
     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) {
     symbol <- lens$data$symbol
     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
 }