R/validation.R

In asshah4/archetypes: Formula Spells

#' Validate class of objects
#' @keywords internal
#' @noRd
validate_class <- function(x, what) {
  if (!inherits(x, what)) {
    stop(
      deparse(substitute(x)),
      " needs to inherit from `",
      paste("c(", paste(what, collapse = ", "),
        ")",
        sep = ""
      ),
      "`, but is of class `",
      class(x),
      "`.",
      call. = FALSE
    )
  }

  invisible(TRUE)
}

#' Validate if an empty object is given to a function
#' @keywords internal
#' @noRd
validate_empty <- function(x) {
  # x is the primary argument of the parent function
  n <- length(x)

  fn <- deparse(sys.calls()[[sys.nframe() - 1]][[1]])

  # Print message if needed
  if (n == 0) {
    message(
      "`",
      fn,
      "()` recieved an empty `",
      class(x)[1],
      "` argument, returning a [0] length object."
    )
    return(TRUE)
  } else {
    return(FALSE)
  }
}

#' Validate if the models are part of an acceptable/supported type
#' @keywords internal
#' @noRd
validate_models <- function(x) {

  fn <- deparse(sys.calls()[[sys.nframe() - 1]][[1]])

  # Essentially, which items are supported by the rune deconstructor
  # Stored as a raw data file to help maintain consistency
  if (!any(class(x) %in% template_models)) {
    stop(
      "`",
      fn,
      "()` is not defined for a `",
      class(x)[1],
      "` object.",
      call. = FALSE
    )
  }

  invisible(TRUE)
}

#' Identification of formula and formula-adjacent objects
#'
#' @param x Confirmation of an object being of the following classes:
#'
#'   * `rune`
#'   * `formula_archetype`
#'   * `spell`
#'
#' @name check
#' @export
is_rune <- function(x) {
  inherits(x, "rune")
}

#' @rdname check
#' @export
is_spell <- function(x) {
  inherits(x, "spell")
}

#' @rdname check
#' @export
is_formulas <- function(x) {
  inherits(x, "fmls")
}