Skip to content

Instantly share code, notes, and snippets.

@jmbarbone
Created August 6, 2021 14:17
Show Gist options
  • Save jmbarbone/4eaf763a44a051e4c9e2acb54d8cdb73 to your computer and use it in GitHub Desktop.
Save jmbarbone/4eaf763a44a051e4c9e2acb54d8cdb73 to your computer and use it in GitHub Desktop.
simple parameter checking
`%must_be%` <- function(x, value) {
pr <- parent.frame()
var_must_be(x, value, .call = match.call())
}
var_must_be <- function(x, value, .call = NULL) {
mc <- if (is.null(.call)) match.call() else .call
# maybe must_be_like? where class(value) is in class(x) etc?
ok <-
identical(class(x), class(value)) &
identical(typeof(x), typeof(value)) &
identical(length(x), length(value))
if (!ok) {
print(mc)
msg <- sprintf("%s is not %s", deparse(as.list(mc)$x), deparse(as.list(mc)$value))
stop(argsError(msg))
}
invisible()
}
argsError <- function(msg, call = NULL) {
cl <- c("argsError", "simpleError", "error", "condition")
structure(list(message = msg, call = call), class = cl)
}
foo <- 1:3
try(foo %must_be% integer(4))
c(1, 3, 2) %must_be% double(3)
try(c(1, 3, 2) %must_be% double(2))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment