mirror of https://git.sr.ht/~hrbrmstr/splashr
GitHub
54 changed files with 227 additions and 66 deletions
@ -0,0 +1,2 @@ |
|||
YEAR: 2019 |
|||
COPYRIGHT HOLDER: Bob Rudis |
|||
@ -0,0 +1,21 @@ |
|||
# MIT License |
|||
|
|||
Copyright (c) 2019 Bob Rudis |
|||
|
|||
Permission is hereby granted, free of charge, to any person obtaining a copy |
|||
of this software and associated documentation files (the "Software"), to deal |
|||
in the Software without restriction, including without limitation the rights |
|||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
|||
copies of the Software, and to permit persons to whom the Software is |
|||
furnished to do so, subject to the following conditions: |
|||
|
|||
The above copyright notice and this permission notice shall be included in all |
|||
copies or substantial portions of the Software. |
|||
|
|||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
|||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
|||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
|||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
|||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
|||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
|||
SOFTWARE. |
|||
@ -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