feat(sess): resolve hover and completion targets without evaluating them

arity.toml

@@ -18,6 +18,8 @@ ignore = [
   "coalesce",
   # Calls to unexported functions with `:::` are deliberate here.
   "internal-function",
+  # Development versions such as 3.4.9000.9000 follow the tidyverse convention.
+  "description-malformed-version",
   # Existing findings that are not addressed yet.
   "roxygen-param",
   "roxygen-return",

sess/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: sess
 Type: Package
 Title: High-Performance IPC Bridge for R Sessions
-Version: 3.4.0.9006
+Version: 3.4.9000.9000
 Authors@R: c(
     person(given = "Randy",
            family = "Lai",
@@ -37,7 +37,9 @@ Suggests:
     systemfonts,
     httpgd,
     jgd,
+    R6,
     rstudioapi,
+    S7,
     svglite,
     tinytest
 NeedsCompilation: no

sess/R/handlers.R

@@ -704,6 +704,11 @@ handle_complete <- function(expr_str, trigger = NULL) {
     error = function(e) NULL
   )
 
+  completion_items(obj, trigger)
+}
+
+# Completion items for the members of `obj` after the `trigger` operator.
+completion_items <- function(obj, trigger = NULL) {
   if (is.null(obj) || is.null(trigger)) {
     return(NULL)
   }
@@ -727,6 +732,9 @@ handle_complete <- function(expr_str, trigger = NULL) {
     }))
   }
 
+  # TODO: S7 objects are not S4, so their properties are not offered after `@`
+  # yet. They can be recognised without S7 (class "S7_object"), but listing
+  # property names needs S7::prop_names() or S7 internals.
   if (trigger == "@" && isS4(obj)) {
     nms <- methods::slotNames(obj)
     return(lapply(nms, function(n) {

sess/R/inspection.R

@@ -0,0 +1,184 @@
+# Hover and completion targets that editors may request without evaluating code.
+#
+# Requests carry the text in front of the cursor (for example `x`, `df$col`, or
+# `obj@slot`). The text is parsed but never evaluated. It is accepted only when
+# it is a single name, a single constant, or a chain of `$` and `@` accesses on
+# a name, and is then resolved by looking the name up and applying fixed
+# accessor operations.
+#
+# Why requests must not evaluate arbitrary expressions:
+# - Hover and completion run without an explicit user action, so evaluating the
+#   request runs code just because the cursor moved or `$` was typed. Clients
+#   cannot be relied on to send only names: the editor's extraction allows
+#   spaces, so hovering `x` in `repeat x <- x + 1` sends `repeat x`, which
+#   parses and would loop forever. R's own completion (utils rcompgen) likewise
+#   does not evaluate a prefix that contains an explicit function call, and
+#   IPython limits completion to side-effect-free evaluation by default.
+# - Validating requests here keeps the guarantee independent of the client.
+#   This also allows exposing these handlers to other clients later, for
+#   example as arf IPC handlers, which run outside arf's evaluation policy and
+#   approval.
+#
+# Constants are accepted because evaluating them runs no code, and the editor
+# already requests hover for them.
+#
+# Not evaluating the request does not make inspection free of side effects:
+# promises, active bindings, S3 `$` methods, and methods of `str()` or
+# `.DollarNames()` run code that is already defined in the session. They are
+# kept so that hover and completion keep working for lazy data, R6 objects and
+# classes with custom accessors.
+
+inspection_invalid <- function(message) {
+  stop(structure(
+    class = c("sess_inspection_invalid", "error", "condition"),
+    list(message = message, call = NULL)
+  ))
+}
+
+inspection_is_constant <- function(expr) {
+  is.null(expr) || (is.atomic(expr) && length(expr) == 1L && is.null(attributes(expr)))
+}
+
+inspection_is_name <- function(expr) {
+  # `...` and `..1` are not bindings that can be looked up by name.
+  is.symbol(expr) && !grepl("^\\.\\.(\\.|[0-9]+)$", as.character(expr))
+}
+
+# Parse a request into list(root, path) without evaluating it.
+#
+# Parsing is done in R so that the accepted syntax, such as numeric literals
+# and spacing around `$`, matches R exactly and is validated in one place.
+inspection_target <- function(expr) {
+  if (!is.character(expr) || length(expr) != 1L || is.na(expr)) {
+    inspection_invalid("expr must be a single string")
+  }
+  exprs <- tryCatch(
+    parse(text = expr, keep.source = FALSE),
+    error = function(e) inspection_invalid("expr is not valid R syntax")
+  )
+  # Earlier versions evaluated only the first of several expressions.
+  if (length(exprs) != 1L) {
+    inspection_invalid("expr must be a single expression")
+  }
+  node <- exprs[[1L]]
+  if (inspection_is_constant(node)) {
+    return(list(root = list(kind = "constant", value = node), path = list()))
+  }
+  path <- list()
+  while (is.call(node)) {
+    operator <- node[[1L]]
+    if (
+      length(node) != 3L || !(identical(operator, quote(`$`)) || identical(operator, quote(`@`)))
+    ) {
+      inspection_invalid("expr must be a name or a chain of $ and @ accesses")
+    }
+    member <- node[[3L]]
+    if (is.symbol(member)) {
+      member <- as.character(member)
+    } else if (!is.character(member) || length(member) != 1L || is.na(member)) {
+      inspection_invalid("$ and @ must be followed by a name")
+    }
+    # A quoted member such as `x$""` must still be a valid symbol name.
+    if (!nzchar(member) || nchar(member, type = "bytes") > 10000L) {
+      inspection_invalid("$ and @ must be followed by a non-empty name")
+    }
+    path[[length(path) + 1L]] <- list(operator = as.character(operator), name = member)
+    node <- node[[2L]]
+  }
+  if (!inspection_is_name(node)) {
+    inspection_invalid("expr must start with a name")
+  }
+  # Accessors were collected from the outermost one.
+  list(root = list(kind = "name", name = as.character(node)), path = rev(path))
+}
+
+# Apply one accessor with the base operator, regardless of any `$` or `@`
+# defined in the global environment.
+#
+# The operators do not evaluate their member argument, so the call is built
+# with the member as a symbol. The operator is embedded as a function object so
+# that masking definitions are not looked up, and the object is bound in a
+# private environment so that it is never re-evaluated. The environment's
+# parent is the global environment so that S3 methods defined there still
+# dispatch, as they would for `x$name` typed at the console. `@` is used rather
+# than methods::slot() so that its own dispatch (S4 slots, S7 properties) is
+# kept.
+inspection_access <- function(object, operator, name) {
+  if (operator == "$" && is.atomic(object) && !is.object(object)) {
+    # A plain vector has no members; `$` would signal an error.
+    return(list(found = FALSE))
+  }
+  if (operator == "@") {
+    if (isS4(object) && !inspection_has_slot(object, name)) {
+      return(list(found = FALSE))
+    }
+    if (!isS4(object) && !is.object(object)) {
+      return(list(found = FALSE))
+    }
+  }
+  fun <- if (operator == "$") base::`$` else base::`@`
+  env <- new.env(parent = .GlobalEnv)
+  assign(".object", object, envir = env)
+  value <- eval(as.call(list(fun, as.name(".object"), as.name(name))), env)
+  list(found = TRUE, value = value)
+}
+
+# Whether base `@` reads `name` from an S4 object rather than signalling that
+# there is no such slot. methods::.hasSlot() covers stored slots and other
+# attributes; `@` also reads the data part `.Data`, the S3 class `.S3Class`, and
+# `names` of a list-based object, even when they are not stored as attributes.
+inspection_has_slot <- function(object, name) {
+  methods::.hasSlot(object, name) ||
+    name %in% c(".Data", ".S3Class") ||
+    (identical(name, "names") && typeof(object) == "list")
+}
+
+# Resolve a parsed target to list(found, value). Each step reads its binding
+# once, so an active binding or promise on the path runs at most once.
+# Errors and interrupts from the session's own code are not caught.
+inspection_resolve <- function(target) {
+  root <- target$root
+  if (identical(root$kind, "constant")) {
+    return(list(found = TRUE, value = root$value))
+  }
+  # exists() does not force promises or call active bindings.
+  if (!exists(root$name, envir = .GlobalEnv, inherits = TRUE)) {
+    return(list(found = FALSE))
+  }
+  object <- get(root$name, envir = .GlobalEnv, inherits = TRUE)
+  for (step in target$path) {
+    result <- inspection_access(object, step$operator, step$name)
+    if (!isTRUE(result$found)) {
+      return(result)
+    }
+    object <- result$value
+  }
+  list(found = TRUE, value = object)
+}
+
+# Hover text for a request, or NULL when nothing is found. Invalid requests
+# signal a `sess_inspection_invalid` error.
+inspection_hover <- function(expr) {
+  resolved <- inspection_resolve(inspection_target(expr))
+  if (!isTRUE(resolved$found)) {
+    return(NULL)
+  }
+  list(str = capture_str(resolved$value))
+}
+
+# Completion items after `$` or `@`, or NULL when nothing is found.
+inspection_completion <- function(expr, trigger = NULL) {
+  if (!is.null(trigger) && (!is.character(trigger) || length(trigger) != 1L || is.na(trigger))) {
+    inspection_invalid("trigger must be a single string")
+  }
+  target <- inspection_target(expr)
+  # Without a member operator there are no items, so do not read any binding.
+  if (is.null(trigger) || !trigger %in% c("$", "@")) {
+    return(NULL)
+  }
+  resolved <- inspection_resolve(target)
+  if (!isTRUE(resolved$found)) {
+    return(NULL)
+  }
+  completion_items(resolved$value, trigger)
+}