/
adverb-auto-browse.R
68 lines (65 loc) · 1.53 KB
/
adverb-auto-browse.R
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
#' Wrap a function so it will automatically `browse()` on error
#'
#' A function wrapped with `auto_browse()` will automatically enter an
#' interactive debugger using [browser()] when ever it encounters an error.
#'
#' @inheritParams safely
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' # For interactive usage, auto_browse() is useful because it automatically
#' # starts a browser() in the right place.
#' f <- function(x) {
#' y <- 20
#' if (x > 5) {
#' stop("!")
#' } else {
#' x
#' }
#' }
#' if (interactive()) {
#' map(1:6, auto_browse(f))
#' }
#'
auto_browse <- function(.f) {
if (is_primitive(.f)) {
cli::cli_abort(
"{.arg .f} must not be a primitive function.",
arg = ".f"
)
}
function(...) {
withCallingHandlers(
.f(...),
error = function(e) {
# 1: h(simpleError(msg, call))
# 2: .handleSimpleError(function (e) <...>
# 3: stop(...)
frame <- sys.frame(4)
browse_in_frame(frame)
},
warning = function(e) {
if (getOption("warn") >= 2) {
frame <- sys.frame(7)
browse_in_frame(frame)
}
}
)
}
}
browse_in_frame <- function(frame) {
# ESS should problably set `.Platform$GUI == "ESS"`
# In the meantime, check that ESSR is attached
if (is_attached("ESSR")) {
# Workaround ESS issue
with_env(frame, on.exit({
browser()
NULL
}))
return_from(frame)
} else {
eval_bare(quote(browser()), env = frame)
}
}