boB Rudis
6 years ago
7 changed files with 124 additions and 28 deletions
@ -0,0 +1,90 @@ |
|||
# Less cool counterparts to purrr's side-effect capture-rs |
|||
# |
|||
# Most of the helper functions are 100% from output.R in purrr repo |
|||
# |
|||
# @param quiet Hide errors (`TRUE`, the default), or display them |
|||
# as they occur? |
|||
# @param otherwise Default value to use when an error occurs. |
|||
# |
|||
# @return `safely`: wrapped function instead returns a list with |
|||
# components `result` and `error`. One value is always `NULL`. |
|||
# |
|||
# `quietly`: wrapped function instead returns a list with components |
|||
# `result`, `output`, `messages` and `warnings`. |
|||
# |
|||
# `possibly`: wrapped function uses a default value (`otherwise`) |
|||
# whenever an error occurs. |
|||
safely <- function(.f, otherwise = NULL, quiet = TRUE) { |
|||
function(...) capture_error(.f(...), otherwise, quiet) |
|||
} |
|||
|
|||
quietly <- function(.f) { |
|||
function(...) capture_output(.f(...)) |
|||
} |
|||
|
|||
possibly <- function(.f, otherwise, quiet = TRUE) { |
|||
force(otherwise) |
|||
function(...) { |
|||
tryCatch(.f(...), |
|||
error = function(e) { |
|||
if (!quiet) |
|||
message("Error: ", e$message) |
|||
otherwise |
|||
}, |
|||
interrupt = function(e) { |
|||
stop("Terminated by user", call. = FALSE) |
|||
} |
|||
) |
|||
} |
|||
} |
|||
|
|||
capture_error <- function(code, otherwise = NULL, quiet = TRUE) { |
|||
tryCatch( |
|||
list(result = code, error = NULL), |
|||
error = function(e) { |
|||
if (!quiet) |
|||
message("Error: ", e$message) |
|||
|
|||
list(result = otherwise, error = e) |
|||
}, |
|||
interrupt = function(e) { |
|||
stop("Terminated by user", call. = FALSE) |
|||
} |
|||
) |
|||
} |
|||
|
|||
capture_output <- function(code) { |
|||
warnings <- character() |
|||
wHandler <- function(w) { |
|||
warnings <<- c(warnings, w$message) |
|||
invokeRestart("muffleWarning") |
|||
} |
|||
|
|||
messages <- character() |
|||
mHandler <- function(m) { |
|||
messages <<- c(messages, m$message) |
|||
invokeRestart("muffleMessage") |
|||
} |
|||
|
|||
temp <- file() |
|||
sink(temp) |
|||
on.exit({ |
|||
sink() |
|||
close(temp) |
|||
}) |
|||
|
|||
result <- withCallingHandlers( |
|||
code, |
|||
warning = wHandler, |
|||
message = mHandler |
|||
) |
|||
|
|||
output <- paste0(readLines(temp, warn = FALSE), collapse = "\n") |
|||
|
|||
list( |
|||
result = result, |
|||
output = output, |
|||
warnings = warnings, |
|||
messages = messages |
|||
) |
|||
} |
Loading…
Reference in new issue