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)
0 Comments:
Post a Comment
Note: Only a member of this blog may post a comment.