Background

I've often aspired to prototype an R package which serves as a source of truth for styling conventions in (say) diagnostic output, and which enables central updates to those conventions.

After many failed experiments with crayon::hyperlink(), I was excited to stumble across Console hyperlinks to functions like `rlang::last_error()`

which preview documentation when hovered

and execute the code when clicked!

Attempt

On a whim, I prototyped a family of functions (see Code section below) that make universal provisions for such functionality. By inspecting the source code, I was able to replicate the functionality above for other rlang functions. Here we pipe (|>) my function style_run_call0() through cat()

rlang::quo("test") |> style_run_call0() |> cat()

to display in the Console a hyperlink to live code

which previews documentation when hovered

and executes the code when clicked:

Problem

This all works well enough for rlang functions. But for functions from other packages

base::sum(1:10) |> style_run_call0() |> cat()

it wrongly displays a "broken" link:

Even with rlang, the links are broken for any arguments that are calls themselves

rlang::quo(rlang::as_string("test")) |> style_run_call0() |> cat()

and for all private functions

rlang:::ansi_alert() |> style_run_call0() |> cat()

though the links do work for "simple" arguments with operators:

rlang::quo(TRUE || FALSE) |> style_run_call0() |> cat()
#> `rlang::quo(TRUE || FALSE)`

style_run_expr0(TRUE || FALSE) |> cat()
#> `TRUE || FALSE`

Question

I am 99% sure this problem boils down to the rstudio:run: format

style_rlang_run <- function(code) {
  style_hyperlink(
    paste0("rlang::", code),
    paste0("rstudio:run:rlang::", code)
  )
}

and its limitations for hyperlinking code.

But why would rlang:::style_rlang_run() need to specify "rlang::" if the "rstudio:run:" accommodated only rlang functions and nothing else?

Code

Text Links

These links are generated from character strings.

# Hyperlink to a URL.
style_hyperlink_url <- function (url, text = NULL, params = NULL) {
  # Display text defaults to URL.
  if (is.null(text))
    text <- url
  
  # Underline the link in blue for classic URL style.
  crayon::underline$blue(rlang:::style_hyperlink(text, url, params))
}

# Hyperlink to run code (given as text) interactively in RStudio.
style_run_code <- function(code, text = NULL) {
  # Display text defaults to code in backticks.
  if (is.null(text))
    text <- paste0("`", code, "`")
  
  # Underline the hyperlink in silver to designate code link.
  crayon::underline$silver(rlang:::style_hyperlink(text, paste0("rstudio:run:", code)))
}

Live Code

These code links are generated from R language itself.

# Hyperlink to run a (simple) 'call' object as an interactive command in RStudio.
style_run_call <- function(call, text = NULL) {
  call_expr <- rlang::get_expr(call)
  call_qual <- call_qualify(call_expr)
  
  style_run_code(base::deparse1(call_qual), text)
}

# Hyperlink to run a (simple) literal call as an interactive command in RStudio.
style_run_call0 <- function(call, text = NULL) {
  call_quo <- rlang::enquo0(call)
  
  style_run_call(call_quo, text)
}

# Hyperlink to run a (simple) 'expression' object as an interactive command in RStudio.
style_run_expr <- function(expr, text = NULL) {
  expr_expr <- rlang::get_expr(expr)
  call_quo <- rlang::quo(rlang::eval_bare(!!expr_expr))
  
  # Text defaults to the expression itself, not the code evaluating it.
  if (is.null(text))
    text <- paste0("`", base::deparse1(expr_expr), "`")
  
  style_run_call(call_quo, text)
}

# Hyperlink to run a (simple) literal 'expression' as an interactive command in RStudio.
style_run_expr0 <- function(expr, text = NULL) {
  expr_quo <- rlang::enquo0(expr)
  
  style_run_expr(expr_quo, text)
}

Call Qualification

This function qualifies a call to fn() as pkg::fn().

call_qualify <- function(call) {
  if (!rlang::is_call(call))
    rlang::abort("`call` must be a call")
    
  if (!rlang::is_call_simple(call))
    rlang::abort("`call` must be a simple call")
  
  # Check the namespace that qualifies the function.
  call_ns_name <- rlang::call_ns(call)
  
  # Qualify if necessary.
  if (is.null(call_ns_name)) {
    call_fn <- rlang.call_fn(call)
    call_fn_name <- rlang::call_name(call)
    
    call_ns_name <- rlang::ns_env_name(call_fn)
    call_ns_sym <- rlang::sym(call_ns_name)
    
    call_fn_sym <- rlang::sym(call_fn_name)
    
    # TODO: Check if namespace exports the function.
    if (fn_is_exported(call_fn_name, call_ns_name)) {
      qual_sym <- quote(`::`)
    } else {
      qual_sym <- quote(`:::`)
    }
    
    # Assemble the qualified function name.
    qual_expr <- quote(`::`(pkg = NULL, name = NULL))
    qual_expr[[1]] <- qual_sym
    qual_expr$pkg <- call_ns_sym
    qual_expr$name <- call_fn_sym
    
    
    # Assemble the qualified call.
    call_expr <- rlang::get_expr(call)
    call_expr[[1]] <- qual_expr
    call <- rlang::set_expr(call, call_expr)
  }
  
  # Return the qualified call.
  call
}

Helper Functions

# Function to check if a function is exported (TRUE) from its namespace, or internal (FALSE).
fn_is_exported <- function(fn_name, ns_name) {
  # Placeholder.
  TRUE
  
  # TODO: Figure out an efficient algorithm.
  # Since a function object may be assigned to a new name, perhaps we should match by bytecode instead?
}

# Current styler from "rlang".
.rlang.style_hyperlink <- rlang:::style_hyperlink

# Function to extract the function from a call.  Deprecated in "rlang" and reconstructed here.
.rlang.call_fn <- function(call, env = caller_env()) {
  expr <- rlang::get_expr(call)
  env <- rlang::get_env(call, env)
  if (!rlang::is_call(expr)) {
    rlang:::abort_call_input_type("call")
  }
  switch(rlang:::call_type(expr),
    recursive = rlang::abort("`call` does not call a named or inlined function"), 
    inlined = rlang:::node_car(expr),
    named = , namespaced = ,
    rlang::eval_bare(rlang:::node_car(expr), env)
  )
}