Add a link to parse failure location to load_all() (#282)

olivroy · web-flow · commit dfd3846f2a1f · 2024-06-25T17:35:00.000+02:00
Co-authored-by: Lionel Henry &lt;lionel.hry@proton.me&gt;

* Handle parse errors more accurately
diff --git a/NEWS.md b/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).
diff --git a/R/source.R b/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))
+}
diff --git a/tests/testthat/_snaps/source.md b/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 <-
          ^
 

Original file line number	Diff line number	Diff line change
`@@ -6,7 +6,7 @@`
`6`	`6`	Error in `load_all()`:
`7`	`7`	`! Failed to load 'testSource/b.R'`
`8`	`8`	Caused by error in `parse()`:
`9`		`- ! testSource/b.R:2:0: unexpected end of input`
	`9`	`+ ! At 'testSource/b.R:2:0': unexpected end of input`
`10`	`10`	`1: b <-`
`11`	`11`	`^`
`12`	`12`