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)
  )
}

CodePudding user response：

Executing base:: functions is explicitly forbidden, see the RStudio PR and discussion in the issue.

If I understand the test code correctly, you can run code of your own package with:

cli::style_hyperlink("show style code", "ide:run:yourpackage::style()")

If yourpackage is not installed, it should just be copied into the console, but not executed.

I'm not really sure what your use case is, but maybe another option would be to generate a link to a help page or vignette in your package?

cli::style_hyperlink("help page", "ide:help:yourpackage::correct_style")