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?

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.