Add a link to parse failure location to load_all()

NEWS.md

@@ -1,5 +1,7 @@
 # pkgload (development version)
 
+* `load_all()` now includes a link to the exact location when loading failed (@olivroy, #282).
+
 * User onload hooks are now passed a library path.
 
 * Fixed an error when updating packages on load (@olivroy, #261).

R/source.R

@@ -11,13 +11,10 @@ source_many <- function(files, encoding = "UTF-8", envir = parent.frame()) {
   for (file in files) {
     try_fetch(
       source_one(file, encoding, envir = envir),
-      error = function(cnd) {
-        path <- file.path(basename(dirname(file)), basename(file))
-        msg <- paste0("Failed to load {.file {path}}")
-        cli::cli_abort(msg, parent = cnd, call = quote(load_all()))
-      }
+      error = function(cnd) handle_source_error(cnd, file)
     )
   }
+
   invisible()
 }
 
@@ -26,15 +23,49 @@ source_one <- function(file, encoding, envir = parent.frame()) {
   stopifnot(is.environment(envir))
 
   lines <- read_lines_enc(file, file_encoding = encoding)
-  srcfile <- srcfilecopy(file, lines, file.info(file)[1, "mtime"],
-    isFile = TRUE)
-  exprs <- parse(text = lines, n = -1, srcfile = srcfile)
+  srcfile <- srcfilecopy(file, lines, file.info(file)[1, "mtime"], isFile = TRUE)
 
-  n <- length(exprs)
-  if (n == 0L) return(invisible())
+  withCallingHandlers(
+    exprs <- parse(text = lines, n = -1, srcfile = srcfile),
+    error = function(cnd) handle_parse_error(cnd, file)
+  )
 
-  for (i in seq_len(n)) {
-    eval(exprs[i], envir)
+  for (expr in exprs) {
+    eval(expr, envir)
   }
+
   invisible()
 }
+
+handle_source_error <- function(cnd, file) {
+  path <- file.path(basename(dirname(file)), basename(file))
+  msg <- paste0("Failed to load {.file {path}}")
+  cli::cli_abort(msg, parent = cnd, call = quote(load_all()))
+}
+
+handle_parse_error <- function(cnd, file) {
+  path <- file.path(basename(dirname(file)), basename(file))
+
+  # Tweak base message to be shorter and add link to src location.
+  msg <- conditionMessage(cnd)
+
+  # Extract :<line>:<col> in base message.
+  location <- regmatches(msg, m = regexpr("\\:\\d+\\:\\d+", msg))
+
+  if (length(location) == 0) {
+    return(zap())
+  }
+
+  suffixed_path <- paste0(path, location)
+
+  # Tweak parse() message to include an hyperlink.
+  # Replace full path by relative path + hyperlink
+  path_hyperlink <- cli::format_inline(paste0("At {.file ", suffixed_path, "}:"))
+  msg <- sub(
+    paste0("^.*", suffixed_path, "\\:"),
+    path_hyperlink,
+    msg
+  )
+
+  abort(msg, call = conditionCall(cnd))
+}

tests/testthat/_snaps/source.md

@@ -6,7 +6,7 @@
       Error in `load_all()`:
       ! Failed to load 'testSource/b.R'
       Caused by error in `parse()`:
-      ! testSource/b.R:2:0: unexpected end of input
+      ! At 'testSource/b.R:2:0': unexpected end of input
       1: b <-
          ^