8.6 Applications

Now that you’ve learned the basic tools of R’s condition system, it’s time to dive into some applications. The goal of this section is not to show every possible usage of tryCatch() and withCallingHandlers() but to illustrate some common patterns that frequently crop up. Hopefully these will get your creative juices flowing, so when you encounter a new problem you can come up with a useful solution.

8.6.1 Failure value

There are a few simple, but useful, tryCatch() patterns based on returning a value from the error handler. The simplest case is a wrapper to return a default value if an error occurs:

fail_with <- function(expr, value = NULL) {
  tryCatch(
    error = function(cnd) value,
    expr
  )
}

fail_with(log(10), NA_real_)
#> [1] 2.3
fail_with(log("x"), NA_real_)
#> [1] NA

A more sophisticated application is base::try(). Below, try2() extracts the essence of base::try(); the real function is more complicated in order to make the error message look more like what you’d see if tryCatch() wasn’t used.

try2 <- function(expr, silent = FALSE) {
  tryCatch(
    error = function(cnd) {
      msg <- conditionMessage(cnd)
      if (!silent) {
        message("Error: ", msg)
      }
      structure(msg, class = "try-error")
    },
    expr
  )
}

try2(1)
#> [1] 1
try2(stop("Hi"))
#> Error: Hi
#> [1] "Hi"
#> attr(,"class")
#> [1] "try-error"
try2(stop("Hi"), silent = TRUE)
#> [1] "Hi"
#> attr(,"class")
#> [1] "try-error"

8.6.2 Success and failure values

We can extend this pattern to return one value if the code evaluates successfully (success_val), and another if it fails (error_val). This pattern just requires one small trick: evaluating the user supplied code, then success_val. If the code throws an error, we’ll never get to success_val and will instead return error_val.

foo <- function(expr) {
  tryCatch(
    error = function(cnd) error_val,
    {
      expr
      success_val
    }
  )
}

We can use this to determine if an expression fails:

does_error <- function(expr) {
  tryCatch(
    error = function(cnd) TRUE,
    {
      expr
      FALSE
    }
  )
}

Or to capture any condition, like just rlang::catch_cnd():

catch_cnd <- function(expr) {
  tryCatch(
    condition = function(cnd) cnd, 
    {
      expr
      NULL
    }
  )
}

We can also use this pattern to create a try() variant. One challenge with try() is that it’s slightly challenging to determine if the code succeeded or failed. Rather than returning an object with a special class, I think it’s slightly nicer to return a list with two components result and error.

safety <- function(expr) {
  tryCatch(
    error = function(cnd) {
      list(result = NULL, error = cnd)
    },
    list(result = expr, error = NULL)
  )
}

str(safety(1 + 10))
#> List of 2
#>  $ result: num 11
#>  $ error : NULL
str(safety(stop("Error!")))
#> List of 2
#>  $ result: NULL
#>  $ error :List of 2
#>   ..$ message: chr "Error!"
#>   ..$ call   : language doTryCatch(return(expr), name, parentenv, handler)
#>   ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

(This is closely related to purrr::safely(), a function operator, which we’ll come back to in Section 11.2.1.)

8.6.3 Resignal

As well as returning default values when a condition is signalled, handlers can be used to make more informative error messages. One simple application is to make a function that works like options(warn = 2) for a single block of code. The idea is simple: we handle warnings by throwing an error:

warning2error <- function(expr) {
  withCallingHandlers(
    warning = function(cnd) abort(conditionMessage(cnd)),
    expr
  )
}
warning2error({
  x <- 2 ^ 4
  warn("Hello")
})
#> Error: Hello

You could write a similar function if you were trying to find the source of an annoying message. More on this in Section 22.6.

8.6.4 Record

Another common pattern is to record conditions for later investigation. The new challenge here is that calling handlers are called only for their side-effects so we can’t return values, but instead need to modify some object in place.

catch_cnds <- function(expr) {
  conds <- list()
  add_cond <- function(cnd) {
    conds <<- append(conds, list(cnd))
    cnd_muffle(cnd)
  }
  
  withCallingHandlers(
    message = add_cond,
    warning = add_cond,
    expr
  )
  
  conds
}

catch_cnds({
  inform("a")
  warn("b")
  inform("c")
})
#> [[1]]
#> <message: a
#> >
#> 
#> [[2]]
#> <warning: b>
#> 
#> [[3]]
#> <message: c
#> >

What if you also want to capture errors? You’ll need to wrap the withCallingHandlers() in a tryCatch(). If an error occurs, it will be the last condition.

catch_cnds <- function(expr) {
  conds <- list()
  add_cond <- function(cnd) {
    conds <<- append(conds, list(cnd))
    cnd_muffle(cnd)
  }
  
  tryCatch(
    error = function(cnd) {
      conds <<- append(conds, list(cnd))
    },
    withCallingHandlers(
      message = add_cond,
      warning = add_cond,
      expr
    )
  )
  
  conds
}

catch_cnds({
  inform("a")
  warn("b")
  abort("C")
})
#> [[1]]
#> <message: a
#> >
#> 
#> [[2]]
#> <warning: b>
#> 
#> [[3]]
#> <error/rlang_error>
#> C
#> Backtrace:
#>  1. global::catch_cnds(...)
#>  6. base::withCallingHandlers(...)

This is the key idea underlying the evaluate package (Wickham and Xie 2018) which powers knitr: it captures every output into a special data structure so that it can be later replayed. As a whole, the evaluate package is quite a lot more complicated than the code here because it also needs to handle plots and text output.

8.6.5 No default behaviour

A final useful pattern is to signal a condition that doesn’t inherit from message, warning or error. Because there is no default behaviour, this means the condition has no effect unless the user specifically requests it. For example, you could imagine a logging system based on conditions:

log <- function(message, level = c("info", "error", "fatal")) {
  level <- match.arg(level)
  signal(message, "log", level = level)
}

When you call log() a condition is signalled, but nothing happens because it has no default handler:

log("This code was run")

To activate logging you need a handler that does something with the log condition. Below I define a record_log() function that will record all logging messages to a file:

record_log <- function(expr, path = stdout()) {
  withCallingHandlers(
    log = function(cnd) {
      cat(
        "[", cnd$level, "] ", cnd$message, "\n", sep = "",
        file = path, append = TRUE
      )
    },
    expr
  )
}

record_log(log("Hello"))
#> [info] Hello

You could even imagine layering with another function that allows you to selectively suppress some logging levels.

ignore_log_levels <- function(expr, levels) {
  withCallingHandlers(
    log = function(cnd) {
      if (cnd$level %in% levels) {
        cnd_muffle(cnd)
      }
    },
    expr
  )
}

record_log(ignore_log_levels(log("Hello"), "info"))

If you create a condition object by hand, and signal it with signalCondition(), cnd_muffle() will not work. Instead you need to call it with a muffle restart defined, like this:

withRestarts(signalCondition(cond), muffle = function() NULL)

Restarts are currently beyond the scope of the book, but I suspect will be included in the third edition.

8.6.6 Exercises

  1. Create suppressConditions() that works like suppressMessages() and suppressWarnings() but suppresses everything. Think carefully about how you should handle errors.

  2. Compare the following two implementations of message2error(). What is the main advantage of withCallingHandlers() in this scenario? (Hint: look carefully at the traceback.)

    message2error <- function(code) {
      withCallingHandlers(code, message = function(e) stop(e))
    }
    message2error <- function(code) {
      tryCatch(code, message = function(e) stop(e))
    }
  3. How would you modify the catch_cnds() definition if you wanted to recreate the original intermingling of warnings and messages?

  4. Why is catching interrupts dangerous? Run this code to find out.

    bottles_of_beer <- function(i = 99) {
      message(
        "There are ", i, " bottles of beer on the wall, ", 
        i, " bottles of beer."
      )
      while(i > 0) {
        tryCatch(
          Sys.sleep(1),
          interrupt = function(err) {
            i <<- i - 1
            if (i > 0) {
              message(
                "Take one down, pass it around, ", i, 
                " bottle", if (i > 1) "s", " of beer on the wall."
              )
            }
          }
        )
      }
      message(
        "No more bottles of beer on the wall, ", 
        "no more bottles of beer."
      )
    }

References

Wickham, Hadley, and Yihui Xie. 2018. Evaluate: Parsing and Evaluation Tools That Provide More Details Than the Default. https://github.com/r-lib/evaluate.