error-specific tryCatch

Question

R doesn't have classed errors, just (for the most part) error and warning, so determining if the error should be caught or passed is up to the programmer. From the python side, I've always appreciated the ability to catch specific errors and pass the rest on, as in an example from the py3 tutorial on Handling Exceptions:

import sys
try:
 f = open('myfile.txt')
 s = f.readline()
 i = int(s.strip())
except OSError as err:
 print("OS error: {0}".format(err))
except ValueError:
 print("Could not convert data to an integer.")
except:
 print("Unexpected error:", sys.exc_info()[0])
 raise

I'm familiar with Adv-R and its discussions of withCallingHandlers and tryCatch, and below is an attempt to provide a single-point for selectively catching errors. Since R does not have classed errors as python does, I believe the "best" way to match specific errors is with regexps on the error message itself. While this is certainly imperfect, I think it's "good enough" (and perhaps the most flexible available).

#' Pattern-matching tryCatch
#'
#' Catch only specific types of errors at the appropriate level.
#' Supports nested use, where errors not matched by inner calls will
#' be passed to outer calls that may (or may not) catch them
#' separately. If no matches found, the error is re-thrown.
#'
#' @param expr expression to be evaluated
#' @param ... named functions, where the name is the regular
#' expression to match the error against, and the function accepts a
#' single argument, the error
#' @param finally expression to be evaluated before returning or
#' exiting
#' @param perl logical, should Perl-compatible regexps be used?
#' @param fixed logical, if 'TRUE', the pattern (name of each handler
#' argument) is a string to be matched as is
#' @return if no errors, the return value from 'expr'; if an error is
#' matched by one of the handlers, the return value from that
#' function; if no matches, the error is propogated up
#' @export
#' @examples
#' 
#' tryCatchPatterns({
#' tryCatchPatterns({
#' stop("no-math-nearby, hello")
#' 99
#' }, "^no-math" = function(e) { cat("in inner\n"); -1L })
#' }, "oops" = function(e) { cat("in outer\n"); -2L })
#' # in inner
#' # [1] -1
#'
#' tryCatchPatterns({
#' tryCatchPatterns({
#' stop("oops")
#' 99
#' }, "^no-math" = function(e) { cat("in inner\n"); -1L })
#' }, "oops" = function(e) { cat("in outer\n"); -2L })
#' # in outer
#' # [1] -2
#'
#' tryCatchPatterns({
#' tryCatchPatterns({
#' stop("neither")
#' 99
#' }, "^no-math" = function(e) { cat("in inner\n"); -1L })
#' }, "oops" = function(e) { cat("in outer\n"); -2L },
#' "." = function(e) { cat("in catch-all\n"); -3L })
#' # in catch-all
#' # [1] -3
#' 
#' \dontrun{
#' tryCatchPatterns({
#' tryCatchPatterns({
#' stop("neither")
#' 99
#' }, "^no-math" = function(e) { cat("in inner\n"); -1L })
#' }, "oops" = function(e) { cat("in outer\n"); -2L })
#' # Error in eval(expr, envir = parentenv) : neither
#' }
#' 
tryCatchPatterns <- function(expr, ..., finally, perl = FALSE, fixed = FALSE) {
 parentenv <- parent.frame()
 handlers <- list(...)
 # ---------------------------------
 # check all handlers are correct
 if (length(handlers) > 0L &&
 (is.null(names(handlers)) || any(!nzchar(names(handlers)))))
 stop("all error handlers must be named")
 if (!all(sapply(handlers, is.function)))
 stop("all error handlers must be functions")
 # ---------------------------------
 # custom error-handler that references 'handlers'
 myerror <- function(e) {
 msg <- conditionMessage(e)
 handled <- FALSE
 for (hndlr in names(handlers)) {
 # can use ptn of "." for catch-all
 if (grepl(hndlr, msg, perl = perl, fixed = fixed)) {
 out <- handlers[[hndlr]](e)
 handled <- TRUE
 break
 }
 }
 if (handled) out else stop(e)
 }
 # ---------------------------------
 # quote some expressions to prevent too-early evaluation
 expr_q <- quote(eval(expr, envir = parentenv))
 finally_q <- if (!missing(finally)) quote(finally)
 tc_args <- list(error = myerror, finally = finally_q)
 # ---------------------------------
 # evaluate!
 do.call("tryCatch", c(list(expr_q), tc_args))
}

The intent is to be able to handle some errors perhaps differently (most likely in side-effect) but not necessarily catch all errors.

I'm particularly interested in these questions:

• context of evaluating expr: I believe quote(eval(expr, envir = parentenv)) is sufficient for ensuring no surprises with namespace and search path, am I missing something?
• context of the error: it would be ideal if traceback() of a not-caught error did not originate in myerror, is there a better way to re-throw the error with (or closer to) the original stack?

• similarly handle warnings: I have another version of this that adds warnings in the same way, so it uses withCallingHandlers and conditional use of invokeRestart("muffleWarning"). The premise is that some warnings I don't care about (I might otherwise use suppressWarnings), some I want to log, and some indicate problems (that could also turn into errors with options(warn=2)). In developing shiny apps, I often use something like this (with a logger::log_* call instead of cat):

  withCallingHandlers({
   warning("foo")
   99
  }, warning = function(w) {
   cat("caught:", conditionMessage(w), "\n")
   invokeRestart("muffleWarning")
  })
  # caught: foo 
  # [1] 99
  

  where it might be nice to "muffle" some warnings and not others. warning typically includes where the warning originated. Similar to the previous bullet, is there a way with warning to preserve (re-use) the original context?

• assumptions: am I making an egregious false assumption in the code?

• Konrad Rudolph: You say "R doesn't have classed errors" ... I’m unsure what you mean by that since you can write virtually the same code as the Python code in R: gist.github.com/klmr/ca110f867c059616ae88d76ceee9d47e
• r2evans: Great point (and big thanks for the demo code), but what errors in base R (and most packages, for that matter) class their exceptions like this?
• Konrad Rudolph: None, unfortunately. I have no idea why this phenomenal condition system was written and never used. For what it’s worth I do use subclassed conditions in my own code.
• r2evans: Can you think of anything I'm mis-assuming or missing in the above function? I appreciate you looking at it!

Answer 1

• I think your evaluation context is correct; and yes, it’s convoluted. In particular it impacts your second point; and ...
• ... unfortunately I’m not aware of a way to improve this. You can manually modify the stack trace by editing the base::.Traceback variable (!). However, this must happen after stop is called so I don’t think it’s helpful here.
• Same answer.
• I think your assumptions are sound.

Two further points: you can slightly simplify your handler by using early exit:

myerror <- function(e) {
 msg <- conditionMessage(e)
 for (hndlr in names(handlers)) {
 # can use ptn of "." for catch-all
 if (grepl(hndlr, msg, perl = perl, fixed = fixed)) {
 return(handlers[[hndlr]](e))
 }
 }
 stop(e)
}

And as you probably know there’s no need to quote tryCatch in the do.call call.

... an afterthought:

Something that simplifies the call stack slightly and circumvents the complex quoting of the expression is the following:

call <- match.call(expand.dots = FALSE)
tc_call <- call("tryCatch", expr = call$expr, error = myerror, finally = call$finally)
eval.parent(tc_call)

This seems to work.

• r2evans: I often quote the function in do.call in part due to rpubs.com/hadley/do-call, for better or worse. Your suggested call <- ... code looks simpler, I'll play with it some more. Many thanks!