[FIXED] How can I combine errors?

Issue

It's frustrating to have to fix issues one by one when the code had all the info to give exhaustive help from the first run.

and1 <- function(a , b) {
  stopifnot(is.logical(a), is.logical(b))
  a & b
}

and1(0, 1)     # nope
#> Error in and1(1, 2): is.logical(a) is not TRUE

# fix it
and1(FALSE, 1) # still not good
#> Error in and1(FALSE, 2): is.logical(b) is not TRUE

# fix again
and1(FALSE, TRUE) # finally works
#> [1] FALSE

We can design complex combination but this looks bad and with more checks it would become very complicated very fast.

and2 <- function(a , b) {
  if (!is.logical(a)) {
    if (!is.logical(b)) {
      stop("\n`a` must be logical\n`b` must be logical")
    }
    stop("`a` must be logical")
  }
  if (!is.logical(b)) {
    stop("`b` must be logical")
  }
  stopifnot(is.logical(a), is.logical(b))
  a & b
}

and2(1,2)
#> Error in and2(1, 2): 
#> `a` must be logical
#> `b` must be logical

What's a good way to do this without the messy code ?

Solution

Here's a solution using {rlang}.

We feed unnamed expressions to the dots, they are tried separately and error messages are combined.

It wraps rlang::abort() and forwards its arguments to it (including named arguments passed to dots, such as class for instance).

I've added an optional header argument too.

combine_errors <- function(
    ..., # unnamed expressions and named args to forward to abort()
    class = NULL,
    call,
    header = NULL,
    body = NULL,
    footer = NULL,
    trace = NULL,
    parent = NULL,
    use_cli_format = NULL,
    .internal = FALSE,
    .file = NULL,
    .frame = parent.frame(),
    .trace_bottom = NULL) {
  env <- parent.frame()
  dots <- eval(substitute(alist(...)))
  unnamed_dots <- dots[rlang::names2(dots) == ""]
  named_dots <- dots[rlang::names2(dots) != ""]
  named_dots <- eval(named_dots, env)
  err <- header
  for (expr in unnamed_dots) {
    new_err <- try(eval(expr, env), silent = TRUE)
    if (inherits(new_err, "try-error")) {
      err <- c(err, "!" = attr(new_err, "condition")$message)
    }
  }
  if (!is.null(err)) {
    names(err)[1] <- ""
    do.call(rlang::abort, c(list(
      err, 
      class = class,
      call = if (missing(call)) env else call,
      body = body,
      footer = footer,
      trace = trace,
      parent = parent,
      use_cli_format = use_cli_format,
      .internal = .internal,
      .file = .file,
      .frame = .frame,
      .trace_bottom = .trace_bottom
    ),
    named_dots))
  }
}

and3 <- function(a , b) {
  # should work with rlang or base
  combine_errors(
    header = "Multiple issues found:",
    if (!is.logical(a)) rlang::abort(c("`a` must be logical", i = "some info")),
    if (!is.logical(b)) stop("`b` must be logical")
  )
  a & b
}

and3(1,TRUE)
#> Error in `and3()`:
#> ! Multiple issues found:
#> ! `a` must be logical
#> ℹ some info
and3(FALSE,2)
#> Error in `and3()`:
#> ! Multiple issues found:
#> ! `b` must be logical
and3(1,2) 
#> Error in `and3()`:
#> ! Multiple issues found:
#> ! `a` must be logical
#> ℹ some info
#> ! `b` must be logical

Answered By - moodymudskipper

Answer Checked By - Terry (PHPFixing Volunteer)