#' @title Try Catch
#'
#' @description Friendlier try catch functions
#'
#' @details try_catch handles errors and warnings the way you specify. try_catch_df
#' returns a tibble with the call, the error message if any, the warning message if
#' any, and the value of the evaluated expression.
#'
#' @export
#'
#' @param expr for simple try catch, the expression to be evaluated
#' @param l for map_* function, a list of arguments
#' @param fun for map_* function, a function to try with the list \code{l}
#' @param .e a one side formula or a function evaluated when an error occurs
#' @param .w a one side formula or a function evaluated when a warning occurs
#' @param .f a one side formula or an expression evaluated before returning or exiting
#'
#' @importFrom rlang lang splice as_function
#' @rdname try_catch
#'
#' @examples
#' \dontrun{
#' try_catch(log("a"), .e = ~ paste0("There was an error: ", .x))
#' try_catch(log(1), .f = ~ print("finally"))
#' try_catch(log(1), .f = function() print("finally"))
#' map_try_catch(list(1, 2, "a"), log, .e = ~ paste0("There was an error: ", .x))
#' map_try_catch_df(list(1, 2, "a"), log)
#' }
#'
try_catch <- function(
expr,
.e = NULL,
.w = NULL,
.f = NULL
) {
if (!is.null(.f)) as_function(.f)()
if (is.null(.e) & is.null(.w)) {
tryCatch(expr)
} else if (!is.null(.e) & is.null(.w)) {
tryCatch(
expr,
error = as_function(.e)
)
} else if (is.null(.e) & !is.null(.w)) {
tryCatch(
expr,
warning = as_function(.w)
)
} else if (!is.null(.e) & !is.null(.w)) {
tryCatch(
expr,
error = as_function(.e),
warning = as_function(.w)
)
}
}
#' @rdname try_catch
#' @export
try_catch_df <- function(expr) {
default <- list(
call = deparse(substitute(expr)),
error = NA,
warning = NA,
value = NA
)
a <- tryCatch(
eval(expr),
error = function(err) {
default$error <<- err$message
return("error")
},
warning = function(war) {
default$warning <<- war$message
return(suppressWarnings(eval(expr)))
}
)
default$value <- list(a)
structure(
default,
.Names = c("call", "error", "warning", "value"),
class = c("tbl_df", "tbl", "data.frame"),
row.names = c(NA, -1L)
)
}
#' @rdname try_catch
#' @export
map_try_catch <- function(
l,
fun,
.e = NULL,
.w = NULL,
.f = NULL
) {
lapply(
l,
as_function(
~ eval(
try_catch_builder(
.x,
fun,
.e = .e,
.w = .e,
.f = .f
)
)
)
)
}
#' @rdname try_catch
#' @export
map_try_catch_df <- function(
l,
fun
) {
do.call(
rbind,
lapply(
l,
function(x) eval(try_catch_df_builder(x, fun))
)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.