1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
source_many <- function(files, encoding = "UTF-8", envir = parent.frame()) {
stopifnot(is.character(files))
stopifnot(is.environment(envir))
local_options(
keep.source = TRUE,
show.error.locations = TRUE,
topLevelEnvironment = as.environment(envir)
)
for (file in files) {
try_fetch(
source_one(file, encoding, envir = envir),
error = function(cnd) handle_source_error(cnd, file)
)
}
invisible()
}
source_one <- function(file, encoding, envir = parent.frame()) {
stopifnot(file.exists(file))
stopifnot(is.environment(envir))
lines <- read_lines_enc(file, file_encoding = encoding)
srcfile <- srcfilecopy(
file,
lines,
file.info(file)[1, "mtime"],
isFile = TRUE
)
withCallingHandlers(
exprs <- parse(text = lines, n = -1, srcfile = srcfile),
error = function(cnd) handle_parse_error(cnd, file)
)
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))
}
|
