Move format_traceback() to harp

Author: lionel-

crates/ark/src/errors.rs

@@ -7,6 +7,7 @@
 
 use harp::object::RObject;
 use harp::r_symbol;
+use harp::session::r_format_traceback;
 use libr::R_GlobalEnv;
 use libr::R_NilValue;
 use libr::Rf_eval;
@@ -43,6 +44,11 @@ unsafe extern "C" fn ps_record_error(evalue: SEXP, traceback: SEXP) -> anyhow::R
     Ok(R_NilValue)
 }
 
+#[harp::register]
+unsafe extern "C" fn ps_format_traceback(calls: SEXP) -> anyhow::Result<SEXP> {
+    Ok(r_format_traceback(calls.into())?.sexp)
+}
+
 pub unsafe fn initialize() {
     // Must be called after the public Positron function environment is set up
     info!("Initializing global error handler");

crates/ark/src/modules/positron/errors.R

@@ -137,99 +137,8 @@ handle_error_base <- function(cnd) {
 }
 
 #' @param traceback A list of calls.
-format_traceback <- function(traceback = list()) {
-    n <- length(traceback)
-
-    # TODO: This implementation prints the traceback in the same ordering
-    # as rlang, i.e. with call 1 on the stack being the first thing you
-    # see. `traceback()` prints in the reverse order, so users may want a
-    # way to reverse both our display ordering and rlang's (requiring a
-    # new `rlang::format()` argument).
-
-    # Collect source location, if there is any
-    srcrefs <- lapply(traceback, function(call) attr(call, "srcref"))
-    srcrefs <- vapply(srcrefs, src_loc, FUN.VALUE = character(1))
-    has_srcref <- nchar(srcrefs) != 0L
-    srcrefs[has_srcref] <- vec_paste0(" at ", srcrefs[has_srcref])
-
-    # Converts to a list of quoted calls to a list of deparsd calls.
-    # Respects global options `"traceback.max.lines"` and `"deparse.max.lines"`!
-    traceback <- .traceback(traceback)
-
-    # Prepend the stack number to each deparsed call, padding multiline calls as needed,
-    # and then collapse multiline calls into one line
-    prefixes <- vec_paste0(seq_len(n), ". ")
-    prefixes <- format(prefixes, justify = "right")
-
-    traceback <- mapply(prepend_prefix, traceback, prefixes, SIMPLIFY = FALSE)
-    traceback <- lapply(traceback, function(lines) paste0(lines, collapse = "\n"))
-    traceback <- as.character(traceback)
-
-    paste0(traceback, srcrefs)
-}
-
-prepend_prefix <- function(lines, prefix) {
-    n_lines <- length(lines)
-
-    if (n_lines == 0L) {
-        return(lines)
-    }
-
-    # First line gets the prefix
-    line <- lines[[1L]]
-    line <- vec_paste0(prefix, line)
-
-    # Other lines are padded with whitespace as needed
-    padding <- strrep(" ", times = nchar(prefix))
-
-    lines <- lines[-1L]
-    lines <- vec_paste0(padding, lines)
-
-    lines <- c(line, lines)
-
-    lines
-}
-
-src_loc <- function(srcref) {
-    # Adapted from `rlang:::src_loc()`
-    if (is.null(srcref)) {
-        return("")
-    }
-
-    srcfile <- attr(srcref, "srcfile")
-    if (is.null(srcfile)) {
-        return("")
-    }
-
-    # May be:
-    # - An actual file path
-    # - `""` for user defined functions in the console
-    # - `"<text>"` for `parse()`d functions
-    # We only try and display the source location for file paths
-    file <- srcfile$filename
-    if (identical(file, "") || identical(file, "<text>")) {
-        return("")
-    }
-
-    file_trimmed <- path_trim_prefix(file, 3L)
-
-    first_line <- srcref[[1L]]
-    first_column <- srcref[[5L]]
-
-    # TODO: We could generate file hyperlinks here like `rlang:::src_loc()`
-    paste0(file_trimmed, ":", first_line, ":", first_column)
-}
-
-path_trim_prefix <- function(path, n) {
-    # `rlang:::path_trim_prefix()`
-    split <- strsplit(path, "/")[[1]]
-    n_split <- length(split)
-
-    if (n_split <= n) {
-        path
-    } else {
-        paste(split[seq(n_split - n + 1, n_split)], collapse = "/")
-    }
+format_traceback <- function(calls = list()) {
+    .ps.Call("ps_format_traceback", calls)
 }
 
 handle_error_rlang <- function(cnd) {

crates/harp/src/modules/init.R

@@ -45,8 +45,6 @@ safe_evalq <- function(expr, env) {
     )
 }
 
-# ?FIXME: Can we reuse the following in Ark?
-
 #' @param traceback A list of calls.
 format_traceback <- function(traceback = list()) {
     n <- length(traceback)

crates/harp/src/session.rs

@@ -12,6 +12,8 @@ use stdext::unwrap;
 
 use crate::exec::r_parse;
 use crate::exec::RFunction;
+use crate::exec::RFunctionExt;
+use crate::modules::HARP_ENV;
 use crate::object::RObject;
 use crate::protect::RProtect;
 use crate::r_lang;
@@ -218,6 +220,12 @@ fn stack_shift(stack: &mut Vec<FrameInfo>, pointer: FrameInfo) {
     }
 }
 
+pub fn r_format_traceback(calls: RObject) -> crate::Result<RObject> {
+    RFunction::new("", "format_traceback")
+        .add(calls)
+        .call_in(unsafe { HARP_ENV.unwrap() })
+}
+
 fn init_interface() {
     unsafe {
         let nframe_call = r_lang!(r_symbol!("sys.nframe"));