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
|
#' Evaluate a promise, capturing all types of output.
#'
#' @param code Code to evaluate.
#' @keywords internal
#' @export
#' @return A list containing
#' \item{result}{The result of the function}
#' \item{output}{A string containing all the output from the function}
#' \item{warnings}{A character vector containing the text from each warning}
#' \item{messages}{A character vector containing the text from each message}
#' @examples
#' evaluate_promise({
#' print("1")
#' message("2")
#' warning("3")
#' 4
#' })
evaluate_promise <- function(code, print = FALSE) {
warnings <- Stack$new()
handle_warning <- function(condition) {
if (!is_deprecation(condition)) {
warnings$push(condition)
maybe_restart("muffleWarning")
}
}
messages <- Stack$new()
handle_message <- function(condition) {
messages$push(condition)
maybe_restart("muffleMessage")
}
path <- withr::local_tempfile()
result <- withr::with_output_sink(
path,
withCallingHandlers(
withVisible(code),
warning = handle_warning,
message = handle_message
)
)
if (result$visible && print) {
withr::with_output_sink(path, print(result$value), append = TRUE)
}
output <- paste0(brio::read_lines(path), collapse = "\n")
list(
result = result$value,
output = output,
warnings = get_messages(warnings$as_list()),
messages = get_messages(messages$as_list())
)
}
|
