check-types.R

# ============================================================================
# STANDALONE INPUT VALIDATION MODULE - ROXYGEN2 DOCUMENTED VERSION
# ============================================================================
# This file contains a complete, self-contained type-checking system
# with ALL dependencies included. No external imports required!
#
# PURPOSE: Validate function arguments and provide helpful error messages
# USAGE: source("compat-types-check-standalone-ROXYGEN.R")
# THEN: Use any of the check_*() functions like check_bool(), check_string()
#
# FILE STRUCTURE:
# 1. Type checking predicates (is_* functions)
# 2. Caller introspection (get context information)
# 3. Special NA values (different types of missing data)
# 4. Error messaging (format helpful error messages)
# 5. Main validation functions (check_* functions)
# ============================================================================

# ============================================================================
# SECTION 1: TYPE CHECKING PREDICATES
# ============================================================================
# PURPOSE: Fundamental predicates that test if a value is a specific type
# These return TRUE/FALSE based on what type of value they receive
# Used internally by the check_* validation functions
# ============================================================================

#' Test if a Value is a Boolean (TRUE or FALSE)
#'
#' @title Predicate: Is value a boolean?
#' @description
#' Tests whether a value is EXACTLY a boolean (TRUE or FALSE).
#' This is a fundamental type predicate used internally.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a single TRUE or FALSE value (not NA, not vector)
#' FALSE otherwise
#'
#' @examples
#' is_bool(TRUE)              # TRUE
#' is_bool(FALSE)             # TRUE
#' is_bool(1)                 # FALSE (numeric, not boolean)
#' is_bool(c(TRUE, FALSE))    # FALSE (vector, not single)
#' is_bool(NA)                # FALSE (NA is not valid)
#'
#' @keywords internal
#'
is_bool <- function(x) {
  # TEST 1: Is x a logical type (not numeric, not character)?
  is.logical(x) &&
  # TEST 2: AND is it exactly length 1 (single value)?
  length(x) == 1L &&
  # TEST 3: AND is it not NA?
  !is.na(x)
}

#' Test if a Value is a Single Character String
#'
#' @title Predicate: Is value a single string?
#' @description
#' Tests whether a value is a SINGLE character string.
#' Can optionally test if it matches a specific string value.
#'
#' @param x Any R value to test
#' @param string Optional string to match exactly. If NULL, any string accepted.
#'
#' @return
#' TRUE if x is a single character string
#' FALSE if x is not a string, is a vector, or is NA
#' If string parameter provided, TRUE only if x matches that exact string
#'
#' @examples
#' is_string("hello")                    # TRUE
#' is_string("")                         # TRUE (empty string is still a string)
#' is_string("hello", "hello")           # TRUE (matches)
#' is_string("hello", "goodbye")         # FALSE (doesn't match)
#' is_string(123)                        # FALSE (number)
#' is_string(c("a", "b"))                # FALSE (vector)
#'
#' @keywords internal
#'
is_string <- function(x, string = NULL) {
  # Early return: fail if x is not character, or not length 1, or is NA
  if (!is.character(x) || length(x) != 1L || is.na(x)) {
    return(FALSE)
  }

  # If caller provided a string to match against, check for exact match
  if (!is.null(string)) {
    return(identical(x, string))
  }

  # x is a valid string
  TRUE
}

#' Test if a Value is a Character Vector
#'
#' @title Predicate: Is value a character vector?
#' @description
#' Tests whether a value is a character vector.
#' Accepts vectors of ANY length (0, 1, 2, 3, ...).
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a character vector (any length)
#' FALSE if x is not character type
#'
#' @examples
#' is_character("hello")                 # TRUE
#' is_character(c("a", "b", "c"))        # TRUE
#' is_character(c())                     # TRUE (empty vector)
#' is_character(123)                     # FALSE (numeric)
#' is_character(list("a"))               # FALSE (list)
#'
#' @keywords internal
#'
is_character <- function(x) {
  is.character(x)
}

#' Test if a Value is a Symbol
#'
#' @title Predicate: Is value a symbol?
#' @description
#' Tests whether a value is a symbol (unevaluated variable name).
#' Symbols are created with quote() or in function definitions.
#' Used for metaprogramming (code that operates on code).
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a symbol
#' FALSE otherwise
#'
#' @examples
#' is_symbol(quote(x))                   # TRUE
#' is_symbol(quote(my_var))              # TRUE
#' is_symbol(x)                          # FALSE (evaluated)
#' is_symbol("x")                        # FALSE (string)
#'
#' @keywords internal
#'
is_symbol <- function(x) {
  is.symbol(x) || is.name(x)
}

#' Test if a Value is a Call
#'
#' @title Predicate: Is value a call?
#' @description
#' Tests whether a value is a call (unevaluated function call).
#' Calls are created with quote() and represent unevaluated function invocations.
#' Used for metaprogramming.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a call object
#' FALSE otherwise
#'
#' @examples
#' is_call(quote(sum(1, 2)))             # TRUE
#' is_call(quote(f(x, y)))               # TRUE
#' is_call(sum(1, 2))                    # FALSE (already evaluated)
#' is_call(quote(x))                     # FALSE (symbol, not call)
#'
#' @keywords internal
#'
is_call <- function(x) {
  is.call(x)
}

#' Test if a Value is an Environment
#'
#' @title Predicate: Is value an environment?
#' @description
#' Tests whether a value is an environment object.
#' Environments are advanced R objects that store variables.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is an environment
#' FALSE otherwise
#'
#' @examples
#' is_environment(new.env())             # TRUE
#' is_environment(globalenv())           # TRUE
#' is_environment(list())                # FALSE
#'
#' @keywords internal
#'
is_environment <- function(x) {
  is.environment(x)
}

#' Test if a Value is a Function
#'
#' @title Predicate: Is value a function?
#' @description
#' Tests whether a value is ANY kind of function.
#' This includes user-defined functions, built-in functions, and primitives.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a function (any type)
#' FALSE otherwise
#'
#' @examples
#' is_function(function(x) x + 1)        # TRUE (user-defined)
#' is_function(sum)                      # TRUE (built-in)
#' is_function(mean)                     # TRUE (built-in)
#' is_function(123)                      # FALSE
#'
#' @seealso [is_closure()] for user-defined functions only
#'
#' @keywords internal
#'
is_function <- function(x) {
  is.function(x)
}

#' Test if a Value is a Closure
#'
#' @title Predicate: Is value a closure (user-defined function)?
#' @description
#' Tests whether a value is a closure (user-defined function).
#' More restrictive than is_function() - rejects built-in functions and primitives.
#' A closure is a function created with function() { ... }.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a user-defined function (closure)
#' FALSE if x is a built-in, primitive, or not a function
#'
#' @examples
#' is_closure(function(x) x + 1)         # TRUE
#' is_closure(sum)                       # FALSE (built-in)
#' is_closure(mean)                      # FALSE (built-in)
#' is_closure(123)                       # FALSE
#'
#' @seealso [is_function()] for all function types
#'
#' @keywords internal
#'
is_closure <- function(x) {
  is.function(x) && !is.primitive(x)
}

#' Test if a Value is a Formula
#'
#' @title Predicate: Is value a formula?
#' @description
#' Tests whether a value is a formula object (y ~ x format).
#' Formulas describe relationships between variables and are used in statistical modeling.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a formula object
#' FALSE otherwise
#'
#' @examples
#' is_formula(y ~ x)                     # TRUE
#' is_formula(y ~ x + z)                 # TRUE
#' is_formula(~ x)                       # TRUE (no left side)
#' is_formula("y ~ x")                   # FALSE (string)
#'
#' @keywords internal
#'
is_formula <- function(x) {
  inherits(x, "formula")
}

#' Test if a Value is NULL
#'
#' @title Predicate: Is value NULL?
#' @description
#' Tests whether a value is NULL (complete absence of a value).
#' Different from NA (missing value placeholder).
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is NULL
#' FALSE otherwise
#'
#' @examples
#' is_null(NULL)                         # TRUE
#' is_null(NA)                           # FALSE
#' is_null(list())                       # FALSE
#'
#' @keywords internal
#'
is_null <- function(x) {
  is.null(x)
}

#' Test if an Argument Was Provided
#'
#' @title Predicate: Was argument provided?
#' @description
#' Tests whether an argument was provided by the caller.
#' Used in functions to detect if a parameter was explicitly supplied.
#'
#' @param x The argument to test (pass unevaluated)
#'
#' @return
#' TRUE if x was not provided to the function
#' FALSE if x was provided
#'
#' @examples
#' # Inside a function definition:
#' my_func <- function(x = 5) {
#'   if (is_missing(x)) {
#'     # User didn't provide x, using default
#'   } else {
#'     # User provided x
#'   }
#' }
#'
#' @keywords internal
#'
is_missing <- function(x) {
  missing(x)
}

#' Test if a Value is Integerish
#'
#' @title Predicate: Is value a whole number?
#' @description
#' Tests whether a value is a whole number (even if stored as decimal type).
#' Checks the actual VALUE, not the storage type.
#' For example, 5.0 returns TRUE (it's a whole number),
#' but 5.5 returns FALSE (has a decimal part).
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a whole number with no fractional part
#' FALSE if x has decimals, is not numeric, is NA, or is not length 1
#'
#' @examples
#' is_integerish(5)                      # TRUE
#' is_integerish(5.0)                    # TRUE
#' is_integerish(5.5)                    # FALSE
#' is_integerish(3.14159)                # FALSE
#' is_integerish("5")                    # FALSE
#'
#' @keywords internal
#'
is_integerish <- function(x) {
  if (!is.numeric(x) || length(x) != 1 || is.na(x)) {
    return(FALSE)
  }
  x == as.integer(x)
}

#' Test if a Value is a Numeric Vector
#'
#' @title Predicate: Is value a numeric vector?
#' @description
#' Tests whether a value is a numeric vector (integer or double).
#' Accepts vectors of ANY length (0, 1, 2, 3, ...).
#' Returns TRUE for both integer and double storage types.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a numeric vector (any length)
#' FALSE if x is not numeric type
#'
#' @examples
#' is_numeric(5)                         # TRUE
#' is_numeric(c(1.5, 2.7))              # TRUE
#' is_numeric(1L)                        # TRUE (integer is numeric)
#' is_numeric("5")                       # FALSE (character)
#'
#' @keywords internal
#'
is_numeric <- function(x) {
  is.numeric(x)
}

#' Test if a Value is an Integer Vector
#'
#' @title Predicate: Is value an integer vector?
#' @description
#' Tests whether a value is a strict integer vector (storage type integer).
#' More restrictive than is_numeric() - rejects doubles even if whole-valued.
#' Accepts vectors of ANY length (0, 1, 2, 3, ...).
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is an integer vector (any length)
#' FALSE if x is double, character, or other type
#'
#' @examples
#' is_integer_vec(1L)                    # TRUE
#' is_integer_vec(c(1L, 2L, 3L))        # TRUE
#' is_integer_vec(1)                     # FALSE (double, not integer)
#' is_integer_vec(1.5)                   # FALSE
#'
#' @keywords internal
#'
is_integer_vec <- function(x) {
  is.integer(x)
}

#' Test if a Value is a Logical Vector
#'
#' @title Predicate: Is value a logical vector?
#' @description
#' Tests whether a value is a logical vector (any length).
#' Unlike is_bool(), accepts vectors and NA values.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a logical vector (any length, may contain NA)
#' FALSE if x is not logical type
#'
#' @examples
#' is_logical(TRUE)                      # TRUE
#' is_logical(c(TRUE, FALSE, NA))        # TRUE
#' is_logical(logical(0))               # TRUE
#' is_logical(1)                         # FALSE (numeric)
#'
#' @keywords internal
#'
is_logical <- function(x) {
  is.logical(x)
}

#' Test if a Value is a Data Frame
#'
#' @title Predicate: Is value a data.frame?
#' @description
#' Tests whether a value inherits from data.frame.
#' Returns TRUE for data.frames, tibbles, and data.tables.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x inherits from data.frame
#' FALSE otherwise
#'
#' @examples
#' is_data_frame(data.frame(x = 1))     # TRUE
#' is_data_frame(list(x = 1))           # FALSE
#' is_data_frame(matrix(1:4, 2, 2))     # FALSE
#'
#' @keywords internal
#'
is_data_frame <- function(x) {
  inherits(x, "data.frame")
}

#' Test if a Value is a Matrix
#'
#' @title Predicate: Is value a matrix?
#' @description
#' Tests whether a value is a matrix object.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a matrix
#' FALSE otherwise
#'
#' @examples
#' is_matrix(matrix(1:4, 2, 2))         # TRUE
#' is_matrix(data.frame(x = 1))         # FALSE
#' is_matrix(c(1, 2, 3))                # FALSE
#'
#' @keywords internal
#'
is_matrix <- function(x) {
  is.matrix(x)
}

#' Test if a Value is a List (Not Data Frame)
#'
#' @title Predicate: Is value a plain list?
#' @description
#' Tests whether a value is a list but NOT a data.frame.
#' Data.frames are technically lists in R, but annotations using "list"
#' always mean a plain list.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a list and not a data.frame
#' FALSE if x is a data.frame, vector, or other type
#'
#' @examples
#' is_list(list(1, 2, 3))               # TRUE
#' is_list(list())                       # TRUE
#' is_list(data.frame(x = 1))           # FALSE (data.frame excluded)
#' is_list(c(1, 2, 3))                  # FALSE (atomic vector)
#'
#' @keywords internal
#'
is_list <- function(x) {
  is.list(x) && !is.data.frame(x)
}

#' Test if a Value is a Factor
#'
#' @title Predicate: Is value a factor?
#' @description
#' Tests whether a value is a factor (categorical variable).
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is a factor
#' FALSE otherwise
#'
#' @examples
#' is_factor(factor(c("a", "b", "c")))  # TRUE
#' is_factor(c("a", "b", "c"))          # FALSE (character, not factor)
#' is_factor(1:3)                        # FALSE
#'
#' @keywords internal
#'
is_factor <- function(x) {
  is.factor(x)
}

#' Test if a Value is a Date
#'
#' @title Predicate: Is value a Date?
#' @description
#' Tests whether a value is a Date object (inherits from "Date").
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x inherits from Date
#' FALSE otherwise
#'
#' @examples
#' is_date(Sys.Date())                   # TRUE
#' is_date(as.Date("2024-01-01"))        # TRUE
#' is_date("2024-01-01")                 # FALSE (character)
#' is_date(Sys.time())                   # FALSE (POSIXct)
#'
#' @keywords internal
#'
is_date <- function(x) {
  inherits(x, "Date")
}

#' Test if a Value is a POSIXct Datetime
#'
#' @title Predicate: Is value a POSIXct?
#' @description
#' Tests whether a value is a POSIXct datetime object.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x inherits from POSIXct
#' FALSE otherwise
#'
#' @examples
#' is_posixct(Sys.time())               # TRUE
#' is_posixct(as.POSIXct("2024-01-01")) # TRUE
#' is_posixct(Sys.Date())               # FALSE (Date, not POSIXct)
#' is_posixct("2024-01-01")             # FALSE (character)
#'
#' @keywords internal
#'
is_posixct <- function(x) {
  inherits(x, "POSIXct")
}

#' Test if a Value is an Atomic Vector (Not NULL)
#'
#' @title Predicate: Is value an atomic vector?
#' @description
#' Tests whether a value is an atomic vector (numeric, logical, character,
#' integer, complex, or raw). Excludes NULL, which base R considers atomic.
#'
#' @param x Any R value to test
#'
#' @return
#' TRUE if x is an atomic vector (not NULL)
#' FALSE if x is NULL, a list, a function, or other non-atomic type
#'
#' @examples
#' is_atomic_vec(c(1, 2, 3))            # TRUE
#' is_atomic_vec("hello")               # TRUE
#' is_atomic_vec(TRUE)                   # TRUE
#' is_atomic_vec(NULL)                   # FALSE (excluded)
#' is_atomic_vec(list(1))               # FALSE (list, not atomic)
#'
#' @keywords internal
#'
is_atomic_vec <- function(x) {
  is.atomic(x) && !is.null(x)
}

# ============================================================================
# SECTION 2: CALLER INTROSPECTION
# ============================================================================
# PURPOSE: Get information about the context where a function was called
# ============================================================================

#' Get the Name of an Argument
#'
#' @title Get argument name for error messages
#' @description
#' Extracts the name of an argument from the calling context.
#' Used to provide better error messages that include the actual parameter name.
#' Instead of "x must be...", it says "my_var must be...".
#'
#' @param x The argument (passed unevaluated, no quotes)
#'
#' @return
#' String containing the argument name, or "x" if extraction fails
#'
#' @examples
#' # Inside a function:
#' my_func <- function(my_var) {
#'   arg_name <- caller_arg(my_var)  # Gets "my_var"
#' }
#'
#' @keywords internal
#'
caller_arg <- function(x) {
  tryCatch({
    arg_name <- deparse(substitute(x))
    if (arg_name == "x") {
      return("x")
    }
    arg_name
  }, error = function(e) {
    "x"
  })
}

#' Get the Calling Environment
#'
#' @title Get caller's environment
#' @description
#' Gets the environment of the code that called this function.
#' Used for error handling to know where to report the error.
#' Allows error messages to point to the correct line in user's code.
#'
#' @return
#' The environment of the calling function
#'
#' @keywords internal
#'
caller_env <- function() {
  parent.frame(n = 2)
}

# ============================================================================
# SECTION 3: SPECIAL NA VALUES
# ============================================================================
# R has different types of NA for different data types
# ============================================================================

# NA for character vectors (string NA)
na_chr <- NA_character_

# NA for double/numeric vectors (number NA)
na_dbl <- NA_real_

# NA for integer vectors
na_int <- NA_integer_

# ============================================================================
# SECTION 4: ERROR MESSAGING AND FORMATTING
# ============================================================================
# PURPOSE: Create helpful, user-friendly error messages
# ============================================================================

#' Convert a Value to a Human-Readable Type Description
#'
#' @title Format value as type description
#' @description
#' Converts an R object into a human-readable description of its type and value.
#' Used in error messages to tell users what they actually passed.
#' Instead of just "wrong type", says "you passed the number 5".
#'
#' @param x The value to describe
#' @param value If TRUE, include the actual value in the description
#'
#' @return
#' String describing what x is, e.g., "the number 5", "a character vector of length 3"
#'
#' @examples
#' obj_type_friendly(5)                  # "the number 5"
#' obj_type_friendly("hello")            # 'the string "hello"'
#' obj_type_friendly(c(1, 2, 3))         # "a double vector of length 3"
#' obj_type_friendly(NA)                 # "`NA`"
#' obj_type_friendly(NULL)               # "`NULL`"
#'
#' @keywords internal
#'
obj_type_friendly <- function(x, value = TRUE) {
  if (is.null(x)) {
    return("`NULL`")
  }

  if (is.logical(x)) {
    if (length(x) == 0) {
      return("an empty logical vector")
    }
    if (length(x) == 1) {
      if (is.na(x)) {
        return("`NA`")
      }
      return(sprintf("`%s`", x))
    }
    return("a logical vector")
  }

  if (is.integer(x)) {
    if (length(x) == 0) {
      return("an empty integer vector")
    }
    if (length(x) == 1) {
      if (is.na(x)) {
        return("`NA`")
      }
      return(sprintf("the integer %s", x))
    }
    return(sprintf("an integer vector of length %d", length(x)))
  }

  if (is.double(x)) {
    if (length(x) == 0) {
      return("an empty double vector")
    }
    if (length(x) == 1) {
      if (is.na(x)) {
        return("`NA`")
      }
      if (is.nan(x)) {
        return("`NaN`")
      }
      if (is.infinite(x)) {
        return(sprintf("`%s`", x))
      }
      return(sprintf("the number %s", x))
    }
    return(sprintf("a double vector of length %d", length(x)))
  }

  if (is.character(x)) {
    if (length(x) == 0) {
      return("an empty character vector")
    }
    if (length(x) == 1) {
      if (is.na(x)) {
        return("`NA`")
      }
      if (nchar(x) == 0) {
        return('an empty string ("")')
      }
      return(sprintf('the string "%s"', x))
    }
    return(sprintf("a character vector of length %d", length(x)))
  }

  class_name <- class(x)[1]
  if (length(x) == 1) {
    return(sprintf("a %s object", class_name))
  }
  return(sprintf("a %s object of length %d", class_name, length(x)))
}

#' Null Coalescing Operator
#'
#' @title Use first non-NULL value
#' @description
#' Returns left side if not NULL, otherwise returns right side.
#' Useful for providing fallback/default values.
#'
#' @param x The primary value
#' @param y The fallback value (used if x is NULL)
#'
#' @return x if not NULL, otherwise y
#'
#' @examples
#' NULL %||% "default"                   # "default"
#' "actual" %||% "default"               # "actual"
#' get_value() %||% get_default()        # First non-NULL
#'
#' @keywords internal
#'
`%||%` <- function(x, y) {
  if (is.null(x)) y else x
}

#' Format a List Using Oxford Comma
#'
#' @title Format list with proper commas
#' @description
#' Formats a vector of strings using Oxford comma style.
#' Used in error messages like "must be a number, string, or NULL".
#' The Oxford comma (comma before "or") is standard in formal writing.
#'
#' @param chr Vector of strings to format
#' @param sep Separator between items (default: ", ")
#' @param final Final conjunction word (default: "or")
#'
#' @return
#' Formatted string with proper comma placement
#'
#' @examples
#' oxford_comma(c("a"))                  # "a"
#' oxford_comma(c("a", "b"))             # "a or b"
#' oxford_comma(c("a", "b", "c"))        # "a, b, or c"
#' oxford_comma(c("a", "b", "c", "d"))   # "a, b, c, or d"
#'
#' @keywords internal
#'
oxford_comma <- function(chr, sep = ", ", final = "or") {
  n <- length(chr)

  if (n < 2) {
    return(chr)
  }

  head <- chr[seq_len(n - 1)]
  last <- chr[n]
  head <- paste(head, collapse = sep)

  if (n > 2) {
    paste0(head, sep, final, " ", last)
  } else {
    paste0(head, " ", final, " ", last)
  }
}

#' Generate a Type Validation Error Message
#'
#' @title Throw helpful type validation error
#' @description
#' Generates and throws a helpful error message when input type validation fails.
#' Core error reporting mechanism for the entire validation system.
#' Makes error messages clear and actionable for users.
#'
#' @param x The invalid value provided by user
#' @param what String or vector describing what type(s) are acceptable
#' @param allow_na If TRUE, include "`NA`" in acceptable types
#' @param allow_null If TRUE, include "`NULL`" in acceptable types
#' @param show_value If TRUE, include the actual value in error message
#' @param arg The argument name (auto-detected if not provided)
#' @param call The calling environment (auto-detected if not provided)
#'
#' @details
#' This function builds an error message like:
#' "`arg_name` must be TYPE, not ACTUAL_TYPE."
#'
#' Example error message:
#' "`x` must be `TRUE` or `FALSE`, not the string "hello"."
#'
#' @return
#' Throws an error (does not return). Stops execution.
#'
#' @keywords internal
#'
stop_input_type <- function(
  x,
  what,
  ...,
  allow_na = FALSE,
  allow_null = FALSE,
  show_value = TRUE,
  arg = caller_arg(x),
  call = caller_env()
) {
  # Build the list of acceptable types
  if (allow_na) {
    what <- c(what, "`NA`")
  }
  if (allow_null) {
    what <- c(what, "`NULL`")
  }

  # Format acceptable types nicely
  if (length(what) > 0) {
    what <- oxford_comma(what)
  }

  # Build complete error message
  message <- sprintf(
    "%s must be %s, not %s.",
    sprintf("`%s`", arg),
    what,
    obj_type_friendly(x, value = show_value)
  )

  # Throw error
  stop(message, call. = FALSE)
}

# ============================================================================
# SECTION 5: MAIN VALIDATION FUNCTIONS (THE PUBLIC API)
# ============================================================================
# These are the functions users call directly to validate arguments
# ============================================================================

#' Check if Input is a Single Boolean Value
#'
#' @title Validate boolean input
#' @description
#' Validates that input is exactly TRUE or FALSE.
#' Rejects vectors, NA values (unless allowed), and non-boolean types.
#' Returns invisibly if valid, throws error if invalid.
#'
#' @param x The value to validate
#' @param allow_na If TRUE, also accept NA as valid input
#' @param allow_null If TRUE, also accept NULL as valid input
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_bool(TRUE)                      # ✓ Valid
#' check_bool(FALSE)                     # ✓ Valid
#' check_bool(1)                         # ✗ Error (is number)
#' check_bool(c(TRUE, FALSE))            # ✗ Error (is vector)
#'
#' @seealso [check_string()], [check_number_whole()]
#'
check_bool <- function(
  x,
  ...,
  allow_na = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_bool(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
    if (allow_na && identical(x, NA)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    c("`TRUE`", "`FALSE`"),
    allow_na = allow_na,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Boolean or Whole Number
#'
#' @title Validate boolean-or-integer input
#' @description
#' Validates that input is either TRUE/FALSE or a whole number.
#' Used for parameters like `do.trace` that accept both forms:
#' TRUE/FALSE to toggle, or an integer to set a frequency.
#'
#' @param x The value to validate
#' @param allow_na If TRUE, also accept NA as valid input
#' @param allow_null If TRUE, also accept NULL as valid input
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_bool_or_number_whole(TRUE)      # ✓ Valid
#' check_bool_or_number_whole(FALSE)     # ✓ Valid
#' check_bool_or_number_whole(10L)       # ✓ Valid (e.g. trace every 10 trees)
#' check_bool_or_number_whole(1.5)       # ✗ Error (decimal)
#' check_bool_or_number_whole("yes")     # ✗ Error
#'
check_bool_or_number_whole <- function(
  x,
  ...,
  allow_na = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_bool(x) || is_integerish(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
    if (allow_na && identical(x, NA)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    c("`TRUE`", "`FALSE`", "a whole number"),
    ...,
    allow_na = allow_na,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Single String Value
#'
#' @title Validate string input
#' @description
#' Validates that input is exactly one character string (not a vector).
#' By default allows empty strings (""), but this can be controlled.
#' Optionally enforces character-length constraints (min_nchar, max_nchar).
#' Returns invisibly if valid, throws error if invalid.
#'
#' @param x The value to validate (should be single string)
#' @param allow_empty If TRUE (default), accept empty string ""
#' @param min_nchar Minimum number of characters (NULL to skip check)
#' @param max_nchar Maximum number of characters (NULL to skip check)
#' @param allow_na If TRUE, also accept NA as valid
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_string("hello")                 # Valid
#' check_string("")                      # Valid
#' check_string("x", min_nchar = 1, max_nchar = 1)  # Valid (exactly 1 char)
#' check_string(c("a", "b"))             # Error (vector)
#' check_string(123)                     # Error (number)
#'
#' @seealso [check_character()], [check_name()]
#'
check_string <- function(
  x,
  ...,
  allow_empty = TRUE,
  min_nchar = NULL,
  max_nchar = NULL,
  allow_na = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    str_valid <- .check_is_string(
      x,
      allow_empty = allow_empty,
      allow_na = allow_na,
      allow_null = allow_null
    )
    if (str_valid) {
      if (is.character(x) && length(x) == 1L && !is.na(x)) {
        if (!is.null(min_nchar) && nchar(x) < min_nchar) {
          stop(
            sprintf("`%s` must have >= %d characters, not %d.", arg, min_nchar, nchar(x)),
            call. = FALSE
          )
        }
        if (!is.null(max_nchar) && nchar(x) > max_nchar) {
          stop(
            sprintf("`%s` must have <= %d characters, not %d.", arg, max_nchar, nchar(x)),
            call. = FALSE
          )
        }
      }
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a single string",
    allow_na = allow_na,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Helper: Validate if Value is a String
#'
#' @title Internal: Validate string format
#' @description
#' Internal helper used by check_string() and check_name().
#' Separated out because both functions share string validation logic.
#'
#' @param x The value to validate
#' @param allow_empty Whether empty string "" is acceptable
#' @param allow_na Whether NA is acceptable
#' @param allow_null Whether NULL is acceptable
#'
#' @return
#' TRUE if x is valid string format, FALSE otherwise
#'
#' @keywords internal
#'
.check_is_string <- function(x, allow_empty, allow_na, allow_null) {
  if (is_string(x)) {
    if (allow_empty || !is_string(x, "")) {
      return(TRUE)
    }
  }

  if (allow_null && is_null(x)) {
    return(TRUE)
  }

  if (allow_na && (identical(x, NA) || identical(x, na_chr))) {
    return(TRUE)
  }

  FALSE
}

#' Check if Input is a Valid Name
#'
#' @title Validate name input
#' @description
#' Validates that input is a valid name (non-empty string).
#' More restrictive than check_string() - forbids empty strings by default.
#' A "name" must be a non-empty string like a variable name.
#'
#' @param x The value to validate (should be non-empty string)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_name("my_variable")             # ✓ Valid
#' check_name("")                        # ✗ Error (empty)
#' check_name(c("a", "b"))               # ✗ Error (vector)
#'
#' @seealso [check_string()]
#'
check_name <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    is_string <- .check_is_string(
      x,
      allow_empty = FALSE,
      allow_na = FALSE,
      allow_null = allow_null
    )
    if (is_string) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a valid name",
    allow_na = FALSE,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Decimal Number
#'
#' @title Validate decimal number input
#' @description
#' Validates a single numeric value.
#' Allows both integers (1, 2, 3) and decimals (1.5, 2.7).
#' Allows infinite values (Inf, -Inf) by default.
#' Checks bounds if min/max parameters provided.
#'
#' @param x The value to validate (should be single number)
#' @param min Minimum acceptable value (default: -Infinity, no lower limit)
#' @param max Maximum acceptable value (default: Infinity, no upper limit)
#' @param min_exclusive If TRUE, `min` itself is rejected (strict `>` instead of `>=`)
#' @param max_exclusive If TRUE, `max` itself is rejected (strict `<` instead of `<=`)
#' @param allow_infinite If TRUE (default), accept Inf and -Inf
#' @param allow_na If TRUE, also accept NA as valid
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_number_decimal(3.14)            # ✓ Valid
#' check_number_decimal(5)               # ✓ Valid (whole numbers OK)
#' check_number_decimal(Inf)             # ✓ Valid (infinity allowed)
#' check_number_decimal(-0.5)            # ✓ Valid
#' check_number_decimal(-1, min = 0)     # ✗ Error (below minimum)
#' check_number_decimal(0, min = 0, min_exclusive = TRUE)  # ✗ Error (0 excluded)
#'
#' @seealso [check_number_whole()]
#'
check_number_decimal <- function(
  x,
  ...,
  min = -Inf,
  max = Inf,
  min_exclusive = FALSE,
  max_exclusive = FALSE,
  allow_infinite = TRUE,
  allow_na = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  .check_number(
    x,
    ...,
    min = min,
    max = max,
    min_exclusive = min_exclusive,
    max_exclusive = max_exclusive,
    allow_decimal = TRUE,
    allow_infinite = allow_infinite,
    allow_na = allow_na,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Whole Number
#'
#' @title Validate whole number input
#' @description
#' More restrictive than check_number_decimal().
#' Only accepts integers: 1, 2, 3, -5, etc.
#' Rejects decimals (1.5, 2.7) and infinities by default.
#' Checks bounds if min/max parameters provided.
#'
#' @param x The value to validate (should be whole number like 5)
#' @param min Minimum acceptable value (default: -Infinity)
#' @param max Maximum acceptable value (default: Infinity)
#' @param min_exclusive If TRUE, `min` itself is rejected (strict `>` instead of `>=`)
#' @param max_exclusive If TRUE, `max` itself is rejected (strict `<` instead of `<=`)
#' @param allow_na If TRUE, also accept NA as valid
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_number_whole(5)                 # ✓ Valid
#' check_number_whole(5.0)               # ✓ Valid (5.0 is whole)
#' check_number_whole(5.5)               # ✗ Error (has decimal)
#' check_number_whole(Inf)               # ✗ Error (infinity rejected)
#' check_number_whole(0, min = 1)        # ✗ Error (below minimum)
#' check_number_whole(1, min = 1, min_exclusive = TRUE)  # ✗ Error (1 excluded)
#'
#' @seealso [check_number_decimal()]
#'
check_number_whole <- function(
  x,
  ...,
  min = -Inf,
  max = Inf,
  min_exclusive = FALSE,
  max_exclusive = FALSE,
  allow_na = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  .check_number(
    x,
    ...,
    min = min,
    max = max,
    min_exclusive = min_exclusive,
    max_exclusive = max_exclusive,
    allow_decimal = FALSE,
    allow_infinite = FALSE,
    allow_na = allow_na,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Helper: Generic Number Validator
#'
#' @title Internal: Validate number format and bounds
#' @description
#' Internal helper used by check_number_decimal() and check_number_whole().
#' Contains all the bounds checking logic and type validation.
#'
#' @param x The value to validate
#' @param min Minimum acceptable value
#' @param max Maximum acceptable value
#' @param min_exclusive If TRUE, `min` itself is rejected (strict `>` instead of `>=`)
#' @param max_exclusive If TRUE, `max` itself is rejected (strict `<` instead of `<=`)
#' @param allow_decimal Whether decimals (like 1.5) are allowed
#' @param allow_infinite Whether Inf and -Inf are allowed
#' @param allow_na Whether NA is allowed
#' @param allow_null Whether NULL is allowed
#' @param arg The argument name (for error message)
#' @param call The calling environment
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @keywords internal
#'
.check_number <- function(
  x,
  ...,
  min = -Inf,
  max = Inf,
  min_exclusive = FALSE,
  max_exclusive = FALSE,
  allow_decimal = FALSE,
  allow_infinite = FALSE,
  allow_na = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (allow_decimal) {
    what <- "a number"
  } else {
    what <- "a whole number"
  }

  .stop <- function(x, what, ...) {
    stop_input_type(
      x, what, ...,
      allow_na = allow_na,
      allow_null = allow_null,
      arg = arg,
      call = call
    )
  }

  if (!missing(x)) {
    is_number <- .is_number(
      x,
      allow_decimal = allow_decimal,
      allow_infinite = allow_infinite
    )

    if (is_number) {
      if (min > -Inf && max < Inf) {
        what <- sprintf("a number between %s and %s", min, max)
      } else {
        what <- NULL
      }

      below_min <- if (min_exclusive) x <= min else x < min
      if (below_min) {
        bound_what <- if (min_exclusive) {
          sprintf("a number greater than %s", min)
        } else {
          sprintf("a number larger than %s", min)
        }
        what <- what %||% bound_what
        .stop(x, what, ...)
      }

      above_max <- if (max_exclusive) x >= max else x > max
      if (above_max) {
        bound_what <- if (max_exclusive) {
          sprintf("a number less than %s", max)
        } else {
          sprintf("a number smaller than %s", max)
        }
        what <- what %||% bound_what
        .stop(x, what, ...)
      }

      return(invisible(NULL))
    }

    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }

    if (allow_na && (identical(x, NA) || identical(x, na_dbl) || identical(x, na_int))) {
      return(invisible(NULL))
    }
  }

  .stop(x, what, ...)
}

#' Helper: Validate Number Format
#'
#' @title Internal: Check number type and format
#' @description
#' Internal helper that validates basic number properties.
#' Checks if value is the correct type, length, and format.
#' Does NOT check bounds (min/max) - that's done by the caller.
#'
#' @param x The value to validate
#' @param allow_decimal If TRUE, allow decimals like 1.5; if FALSE, require integers
#' @param allow_infinite If TRUE, allow Inf and -Inf; if FALSE, reject them
#'
#' @return
#' TRUE if x is a valid number format
#' FALSE if x fails any format requirement
#'
#' @details
#' Validation steps:
#' 1. Is it numeric type? (integer or double)
#' 2. Is it a single value? (length == 1)
#' 3. Is it NA? (generally invalid)
#' 4. Is it a whole number? (if decimals not allowed)
#' 5. Is it infinite? (if infinities not allowed)
#'
#' @keywords internal
#'
.is_number <- function(x, allow_decimal = FALSE, allow_infinite = FALSE) {
  if (!typeof(x) %in% c("integer", "double")) {
    return(FALSE)
  }

  if (length(x) != 1) {
    return(FALSE)
  }

  if (is.na(x)) {
    return(FALSE)
  }

  if (!allow_decimal && !is_integerish(x)) {
    return(FALSE)
  }

  if (!allow_infinite && is.infinite(x)) {
    return(FALSE)
  }

  TRUE
}

#' Check if Input is a Symbol
#'
#' @title Validate symbol input
#' @description
#' Validates that input is a symbol (unevaluated variable name).
#' Symbols represent names without evaluation, used in metaprogramming.
#'
#' @param x The value to validate (should be a symbol)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_symbol(quote(x))                # ✓ Valid
#' check_symbol("x")                     # ✗ Error (string)
#'
check_symbol <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_symbol(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a symbol",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Valid Argument Name
#'
#' @title Validate argument name input
#' @description
#' Alias of check_symbol(). Argument names must be symbols.
#' Used when a parameter should contain an argument name.
#'
#' @param x The value to validate (should be argument name symbol)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @seealso [check_symbol()]
#'
check_arg <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_symbol(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "an argument name",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Defused Call
#'
#' @title Validate call input
#' @description
#' Validates that input is a defused call (unevaluated function call).
#' Used when you want the call itself, not the result of executing it.
#'
#' @param x The value to validate (should be a call)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_call(quote(sum(1, 2)))          # ✓ Valid
#' check_call(quote(f(x)))               # ✓ Valid
#'
check_call <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_call(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a defused call",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is an Environment
#'
#' @title Validate environment input
#' @description
#' Validates that input is an environment object.
#' Environments are advanced R objects used for variable storage and scope.
#'
#' @param x The value to validate (should be environment)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
check_environment <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_environment(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "an environment",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Function
#'
#' @title Validate function input
#' @description
#' Validates that input is a function (any kind).
#' Accepts user-defined functions, built-in functions, and primitives.
#'
#' @param x The value to validate (should be function)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_function(function(x) x + 1)     # ✓ Valid (user function)
#' check_function(sum)                   # ✓ Valid (built-in)
#' check_function(123)                   # ✗ Error
#'
#' @seealso [check_closure()]
#'
check_function <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_function(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a function",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Closure
#'
#' @title Validate closure input
#' @description
#' More restrictive than check_function().
#' Only accepts closures (user-defined functions).
#' Rejects built-in functions and primitives.
#'
#' @param x The value to validate (should be user-defined function)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_closure(function(x) x + 1)      # ✓ Valid
#' check_closure(sum)                    # ✗ Error (built-in)
#'
#' @seealso [check_function()]
#'
check_closure <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_closure(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "an R function",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Formula
#'
#' @title Validate formula input
#' @description
#' Validates that input is a formula (y ~ x format).
#' Formulas describe relationships between variables in statistical modeling.
#'
#' @param x The value to validate (should be formula)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_formula(y ~ x)                  # ✓ Valid
#' check_formula(y ~ x + z)              # ✓ Valid
#' check_formula("y ~ x")                # ✗ Error
#'
check_formula <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_formula(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a formula",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Character Vector
#'
#' @title Validate character vector input
#' @description
#' Validates that input is a character vector (any length).
#' Unlike check_string(), accepts vectors of ANY length (0, 1, 2, 3, ...).
#' Useful for parameters like `cols = c("name", "age", "city")`.
#'
#' @param x The value to validate (should be character vector)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_character("")                   # ✓ Valid (length 1)
#' check_character(c("a", "b", "c"))     # ✓ Valid (length 3)
#' check_character(c())                  # ✓ Valid (length 0)
#' check_character(123)                  # ✗ Error
#'
#' @seealso [check_string()]
#'
check_character <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_character(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a character vector",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Helper: Validate Vector Length Constraints
#'
#' @title Internal: Check vector length bounds
#' @description
#' Internal helper used by vector checkers (check_numeric, check_integer,
#' check_logical, check_atomic) to validate length constraints.
#'
#' @param x The value whose length to check
#' @param min_len Minimum acceptable length (NULL to skip)
#' @param max_len Maximum acceptable length (NULL to skip)
#' @param arg The argument name (for error message)
#' @param call The calling environment
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if length is out of bounds
#'
#' @keywords internal
#'
.check_length <- function(x, min_len = NULL, max_len = NULL, arg = "x", call = caller_env()) {
  n <- length(x)

  if (!is.null(min_len) && n < min_len) {
    stop(
      sprintf("`%s` must have length >= %d, not %d.", arg, min_len, n),
      call. = FALSE
    )
  }

  if (!is.null(max_len) && n > max_len) {
    stop(
      sprintf("`%s` must have length <= %d, not %d.", arg, max_len, n),
      call. = FALSE
    )
  }

  invisible(NULL)
}

#' Check if Input is a Numeric Vector
#'
#' @title Validate numeric vector input
#' @description
#' Validates that input is a numeric vector (integer or double).
#' Unlike check_number_decimal(), accepts vectors of ANY length.
#' Optionally enforces length constraints.
#'
#' @param x The value to validate (should be numeric vector)
#' @param min_len Minimum acceptable length (NULL to skip check)
#' @param max_len Maximum acceptable length (NULL to skip check)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_numeric(c(1, 2, 3))             # Valid
#' check_numeric(1L)                     # Valid (integer is numeric)
#' check_numeric(c(1, 2), min_len = 2)   # Valid
#' check_numeric("a")                    # Error
#' check_numeric(c(1), min_len = 2)      # Error (too short)
#'
#' @seealso [check_number_decimal()], [check_integer()]
#'
check_numeric <- function(
  x,
  ...,
  min_len = NULL,
  max_len = NULL,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_numeric(x)) {
      .check_length(x, min_len = min_len, max_len = max_len, arg = arg, call = call)
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a numeric vector",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is an Integer Vector
#'
#' @title Validate integer vector input
#' @description
#' Validates that input is a strict integer vector (storage type integer).
#' More restrictive than check_numeric() - rejects doubles even if whole-valued.
#' Optionally enforces length constraints.
#'
#' @param x The value to validate (should be integer vector)
#' @param min_len Minimum acceptable length (NULL to skip check)
#' @param max_len Maximum acceptable length (NULL to skip check)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_integer(1L)                     # Valid
#' check_integer(c(1L, 2L, 3L))         # Valid
#' check_integer(1)                      # Error (double, not integer)
#'
#' @seealso [check_number_whole()], [check_numeric()]
#'
check_integer <- function(
  x,
  ...,
  min_len = NULL,
  max_len = NULL,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_integer_vec(x)) {
      .check_length(x, min_len = min_len, max_len = max_len, arg = arg, call = call)
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "an integer vector",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Logical Vector
#'
#' @title Validate logical vector input
#' @description
#' Validates that input is a logical vector (any length, may contain NA).
#' Unlike check_bool(), accepts vectors and NA values.
#' Optionally enforces length constraints.
#'
#' @param x The value to validate (should be logical vector)
#' @param min_len Minimum acceptable length (NULL to skip check)
#' @param max_len Maximum acceptable length (NULL to skip check)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_logical(c(TRUE, FALSE))         # Valid
#' check_logical(c(TRUE, NA, FALSE))     # Valid (NA allowed in vector)
#' check_logical(c(1, 0))               # Error (numeric, not logical)
#'
#' @seealso [check_bool()]
#'
check_logical <- function(
  x,
  ...,
  min_len = NULL,
  max_len = NULL,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_logical(x)) {
      .check_length(x, min_len = min_len, max_len = max_len, arg = arg, call = call)
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a logical vector",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is an Atomic Vector
#'
#' @title Validate atomic vector input
#' @description
#' Validates that input is an atomic vector (numeric, logical, character,
#' integer, complex, or raw). Rejects lists, data.frames, and NULL.
#' Optionally enforces length constraints.
#'
#' @param x The value to validate (should be atomic vector)
#' @param min_len Minimum acceptable length (NULL to skip check)
#' @param max_len Maximum acceptable length (NULL to skip check)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_atomic(c(1, 2, 3))             # Valid (numeric)
#' check_atomic("hello")                # Valid (character)
#' check_atomic(TRUE)                    # Valid (logical)
#' check_atomic(list(1, 2))             # Error (list)
#'
check_atomic <- function(
  x,
  ...,
  min_len = NULL,
  max_len = NULL,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_atomic_vec(x)) {
      .check_length(x, min_len = min_len, max_len = max_len, arg = arg, call = call)
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "an atomic vector",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Data Frame
#'
#' @title Validate data.frame input
#' @description
#' Validates that input inherits from data.frame.
#' Accepts data.frames, tibbles, and data.tables.
#' Optionally enforces minimum row/column counts and required column names.
#'
#' @param x The value to validate (should be data.frame)
#' @param required_cols Character vector of column names that must be present (NULL to skip)
#' @param min_rows Minimum acceptable number of rows (NULL to skip check)
#' @param min_cols Minimum acceptable number of columns (NULL to skip check)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_data_frame(data.frame(x = 1))  # Valid
#' check_data_frame(data.frame(x = 1:3), min_rows = 2)  # Valid (3 >= 2)
#' check_data_frame(data.frame(Rate = 1, Loss = 2), required_cols = c("Rate", "Loss"))  # Valid
#' check_data_frame(data.frame(x = 1), required_cols = c("Rate", "Loss"))  # Error
#' check_data_frame(list(x = 1))        # Error (plain list)
#'
check_data_frame <- function(
  x,
  ...,
  required_cols = NULL,
  min_rows = NULL,
  min_cols = NULL,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_data_frame(x)) {
      if (!is.null(required_cols)) {
        missing_cols <- setdiff(required_cols, names(x))
        if (length(missing_cols) > 0) {
          stop(
            sprintf(
              "`%s` is missing required column%s: %s.",
              arg,
              if (length(missing_cols) > 1) "s" else "",
              paste0('"', missing_cols, '"', collapse = ", ")
            ),
            call. = FALSE
          )
        }
      }
      if (!is.null(min_rows) && nrow(x) < min_rows) {
        stop(
          sprintf("`%s` must have >= %d rows, not %d.", arg, min_rows, nrow(x)),
          call. = FALSE
        )
      }
      if (!is.null(min_cols) && ncol(x) < min_cols) {
        stop(
          sprintf("`%s` must have >= %d columns, not %d.", arg, min_cols, ncol(x)),
          call. = FALSE
        )
      }
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a data frame",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Matrix
#'
#' @title Validate matrix input
#' @description
#' Validates that input is a matrix.
#' Optionally checks numeric type, exact dimensions, and squareness.
#'
#' @param x The value to validate (should be matrix)
#' @param numeric_only If TRUE, additionally require the matrix to be numeric
#' @param nrow Expected number of rows (NULL to skip check)
#' @param ncol Expected number of columns (NULL to skip check)
#' @param square If TRUE, require nrow(x) == ncol(x)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_matrix(matrix(1:4, 2, 2))      # Valid
#' check_matrix(matrix(1:4, 2, 2), square = TRUE)  # Valid (2x2)
#' check_matrix(matrix(1:6, 2, 3), nrow = 2, ncol = 3)  # Valid
#' check_matrix(matrix(1:6, 2, 3), square = TRUE)  # Error (2x3)
#' check_matrix(data.frame(x = 1))      # Error
#'
check_matrix <- function(
  x,
  ...,
  numeric_only = FALSE,
  nrow = NULL,
  ncol = NULL,
  square = FALSE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_matrix(x)) {
      if (numeric_only && !is.numeric(x)) {
        stop(
          sprintf("`%s` must be a numeric matrix, not a %s matrix.", arg, typeof(x)),
          call. = FALSE
        )
      }
      if (square && base::nrow(x) != base::ncol(x)) {
        stop(
          sprintf("`%s` must be a square matrix, but has dimensions %d x %d.",
                  arg, base::nrow(x), base::ncol(x)),
          call. = FALSE
        )
      }
      if (!is.null(nrow) && base::nrow(x) != nrow) {
        stop(
          sprintf("`%s` must have %d rows, not %d.", arg, nrow, base::nrow(x)),
          call. = FALSE
        )
      }
      if (!is.null(ncol) && base::ncol(x) != ncol) {
        stop(
          sprintf("`%s` must have %d columns, not %d.", arg, ncol, base::ncol(x)),
          call. = FALSE
        )
      }
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  what <- if (numeric_only) "a numeric matrix" else "a matrix"
  stop_input_type(
    x,
    what,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a List (Not Data Frame)
#'
#' @title Validate list input
#' @description
#' Validates that input is a plain list (not a data.frame).
#' Data.frames are technically lists in R, but this checker treats them
#' as distinct types matching how type annotations use "list".
#'
#' @param x The value to validate (should be list)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_list(list(1, 2, 3))            # Valid
#' check_list(list())                    # Valid
#' check_list(data.frame(x = 1))        # Error (data.frame, not plain list)
#' check_list(c(1, 2, 3))               # Error (atomic vector)
#'
check_list <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_list(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a list",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a Factor
#'
#' @title Validate factor input
#' @description
#' Validates that input is a factor (categorical variable).
#'
#' @param x The value to validate (should be factor)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_factor(factor(c("a", "b")))    # Valid
#' check_factor(c("a", "b"))            # Error (character, not factor)
#'
check_factor <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_factor(x)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    "a factor",
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a String from a Fixed Set of Choices
#'
#' @title Validate string against allowed choices
#' @description
#' Validates that input is a single string AND matches one of the allowed
#' values. Covers type annotations like:
#' - character scalar, one of "a" | "b" | "c"
#' - character scalar in \{"linear", "constant"\}
#' Unlike match.arg(), does NOT do partial matching.
#'
#' @param x The value to validate (should be one of choices)
#' @param choices Character vector of allowed values
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_string_choice("linear", c("linear", "constant"))  # Valid
#' check_string_choice("cubic", c("linear", "constant"))   # Error
#' check_string_choice(123, c("a", "b"))                   # Error (not string)
#'
check_string_choice <- function(
  x,
  choices,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_string(x) && x %in% choices) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  choices_fmt <- paste0('"', choices, '"')
  what <- sprintf("one of %s", oxford_comma(choices_fmt))

  if (!missing(x) && is_string(x)) {
    # x is a valid string but not in choices
    stop(
      sprintf('`%s` must be %s, not "%s".', arg, what, x),
      call. = FALSE
    )
  }

  stop_input_type(
    x,
    what,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input Inherits from a Class
#'
#' @title Validate object class
#' @description
#' Validates that input inherits from a specified class.
#' A single generic function that handles all class-based type annotations
#' like "randomForest object", "survfit object", "DSConnection object", etc.
#'
#' @param x The value to validate (should inherit from class_name)
#' @param class_name String or character vector of acceptable class names.
#'   If a character vector, x must inherit from at least one of them.
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_class(lm(y ~ x, data.frame(x = 1:3, y = 1:3)), "lm")  # Valid
#' check_class(data.frame(), "data.frame")   # Valid
#' check_class(list(), "data.frame")         # Error
#'
check_class <- function(
  x,
  class_name,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (inherits(x, class_name)) {
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  if (length(class_name) == 1L) {
    what <- sprintf("a <%s> object", class_name)
  } else {
    classes_fmt <- paste0("<", class_name, ">")
    what <- sprintf("a %s object", oxford_comma(classes_fmt))
  }

  stop_input_type(
    x,
    what,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is Named
#'
#' @title Validate that object has names
#' @description
#' Validates that input has names and all names are non-empty.
#' Use after a type check to enforce "named list", "named character vector", etc.
#'
#' @param x The value to validate (should have names)
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_named(c(a = 1, b = 2))         # Valid
#' check_named(list(x = 1, y = 2))      # Valid
#' check_named(c(1, 2))                  # Error (no names)
#' check_named(c(a = 1, 2))             # Error (incomplete names)
#'
check_named <- function(
  x,
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
    nms <- names(x)
    if (!is.null(nms) && length(nms) > 0 && all(nzchar(nms))) {
      return(invisible(NULL))
    }
  }

  stop(
    sprintf("`%s` must be named (all elements must have non-empty names).", arg),
    call. = FALSE
  )
}

#' Check if Input is a Date
#'
#' @title Validate Date input
#' @description
#' Validates that input is a Date object (inherits from "Date").
#' Optionally requires exactly one date (scalar).
#'
#' @param x The value to validate (should be Date)
#' @param scalar If TRUE (default), require exactly one date value
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_date(Sys.Date())               # Valid
#' check_date(as.Date("2024-01-01"))    # Valid
#' check_date("2024-01-01")             # Error (character)
#'
check_date <- function(
  x,
  ...,
  scalar = TRUE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_date(x)) {
      if (scalar && length(x) != 1L) {
        stop(
          sprintf("`%s` must be a single Date value, not a Date vector of length %d.",
                  arg, length(x)),
          call. = FALSE
        )
      }
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  what <- if (scalar) "a Date scalar" else "a Date vector"
  stop_input_type(
    x,
    what,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check if Input is a POSIXct Datetime
#'
#' @title Validate POSIXct input
#' @description
#' Validates that input is a POSIXct datetime object.
#' Optionally requires exactly one datetime (scalar).
#'
#' @param x The value to validate (should be POSIXct)
#' @param scalar If TRUE (default), require exactly one datetime value
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if invalid
#'
#' @examples
#' check_posixct(Sys.time())             # Valid
#' check_posixct(as.POSIXct("2024-01-01"))  # Valid
#' check_posixct("2024-01-01")           # Error (character)
#'
check_posixct <- function(
  x,
  ...,
  scalar = TRUE,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (is_posixct(x)) {
      if (scalar && length(x) != 1L) {
        stop(
          sprintf("`%s` must be a single POSIXct value, not a POSIXct vector of length %d.",
                  arg, length(x)),
          call. = FALSE
        )
      }
      return(invisible(NULL))
    }
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }
  }

  what <- if (scalar) "a POSIXct datetime" else "a POSIXct vector"
  stop_input_type(
    x,
    what,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check Element-Wise Constraints on a Vector
#'
#' @title Validate element values in a vector
#' @description
#' Validates that ALL elements in a vector satisfy given constraints.
#' Covers annotations like "all values in [0, 1]", "all values in \{0, 1\}",
#' "no NAs allowed", and custom predicates.
#' Call this AFTER a type check (e.g., check_numeric) to enforce element constraints.
#'
#' @param x The vector to validate element-wise
#' @param min All elements must be >= min (NULL to skip)
#' @param max All elements must be <= max (NULL to skip)
#' @param min_exclusive If TRUE, use > instead of >= for min
#' @param max_exclusive If TRUE, use < instead of <= for max
#' @param allowed Set of allowed values; all elements must be in this set (NULL to skip)
#' @param no_na If TRUE, reject any NA values in x
#' @param predicate Custom function returning TRUE for valid elements (NULL to skip)
#' @param predicate_msg Description of predicate for error messages
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if any element fails
#'
#' @examples
#' check_values(c(0.2, 0.5, 0.8), min = 0, max = 1)  # Valid (all in [0,1])
#' check_values(c(0, 1, 1, 0), allowed = c(0, 1))     # Valid (all in {0,1})
#' check_values(c(1, 2, NA), no_na = TRUE)             # Error (contains NA)
#' check_values(c(1, -1, 2), min = 0)                  # Error (-1 < 0)
#'
check_values <- function(
  x,
  ...,
  min = NULL,
  max = NULL,
  min_exclusive = FALSE,
  max_exclusive = FALSE,
  allowed = NULL,
  no_na = FALSE,
  predicate = NULL,
  predicate_msg = "satisfy the predicate",
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (allow_null && is_null(x)) {
    return(invisible(NULL))
  }

  if (no_na && any(is.na(x))) {
    n_na <- sum(is.na(x))
    stop(
      sprintf("`%s` must not contain NA values (%d NA%s found).",
              arg, n_na, if (n_na > 1) "s" else ""),
      call. = FALSE
    )
  }

  # For range/allowed checks, work with non-NA values
  vals <- x[!is.na(x)]

  if (!is.null(min)) {
    if (min_exclusive) {
      bad <- any(vals <= min)
      op <- ">"
    } else {
      bad <- any(vals < min)
      op <- ">="
    }
    if (bad) {
      stop(
        sprintf("`%s` must have all values %s %s.", arg, op, min),
        call. = FALSE
      )
    }
  }

  if (!is.null(max)) {
    if (max_exclusive) {
      bad <- any(vals >= max)
      op <- "<"
    } else {
      bad <- any(vals > max)
      op <- "<="
    }
    if (bad) {
      stop(
        sprintf("`%s` must have all values %s %s.", arg, op, max),
        call. = FALSE
      )
    }
  }

  if (!is.null(allowed)) {
    bad_vals <- vals[!vals %in% allowed]
    if (length(bad_vals) > 0) {
      allowed_str <- paste0(allowed, collapse = ", ")
      bad_str <- paste0(unique(bad_vals)[1:min(3, length(unique(bad_vals)))], collapse = ", ")
      stop(
        sprintf("`%s` must have all values in {%s}; found: %s.", arg, allowed_str, bad_str),
        call. = FALSE
      )
    }
  }

  if (!is.null(predicate)) {
    if (!all(vapply(vals, predicate, logical(1)))) {
      stop(
        sprintf("`%s` has elements that do not %s.", arg, predicate_msg),
        call. = FALSE
      )
    }
  }

  invisible(NULL)
}

#' Check that Multiple Arguments Have the Same Length
#'
#' @title Validate matching vector lengths
#' @description
#' Validates that all provided arguments have equal length.
#' Covers annotations like "same length as lat_orig".
#' Pass arguments as named values.
#'
#' @param ... Named arguments to compare lengths. Names are used in error messages.
#'
#' @return
#' Invisibly returns NULL if all lengths match
#' Throws an error listing mismatched lengths
#'
#' @examples
#' check_same_length(x = 1:3, y = 4:6, z = 7:9)  # Valid (all length 3)
#' check_same_length(x = 1:3, y = 4:5)            # Error (3 vs 2)
#'
check_same_length <- function(...) {
  args <- list(...)
  nms <- names(args)
  if (is.null(nms) || any(nms == "")) {
    stop("All arguments to check_same_length() must be named.", call. = FALSE)
  }

  lens <- vapply(args, length, integer(1))
  if (length(unique(lens)) > 1L) {
    parts <- paste0("`", nms, "` (", lens, ")", collapse = ", ")
    stop(
      sprintf("All arguments must have the same length: %s.", parts),
      call. = FALSE
    )
  }

  invisible(NULL)
}

#' Check that Two Arguments Have the Same Class
#'
#' @title Validate matching classes
#' @description
#' Validates that two arguments share the same class (first element of class()).
#' Covers annotations like "must be same class as b".
#'
#' @param x First value
#' @param y Second value
#' @param x_arg Name for x in error messages
#' @param y_arg Name for y in error messages
#'
#' @return
#' Invisibly returns NULL if classes match
#' Throws an error if classes differ
#'
#' @examples
#' check_same_class(1:3, 4:6)                    # Valid (both integer)
#' check_same_class(c(1, 2), c(3, 4))            # Valid (both numeric)
#' check_same_class(1:3, c("a", "b"))            # Error (integer vs character)
#'
check_same_class <- function(
  x,
  y,
  x_arg = caller_arg(x),
  y_arg = caller_arg(y)
) {
  cls_x <- class(x)[1]
  cls_y <- class(y)[1]
  if (!identical(cls_x, cls_y)) {
    stop(
      sprintf("`%s` (%s) and `%s` (%s) must have the same class.",
              x_arg, cls_x, y_arg, cls_y),
      call. = FALSE
    )
  }

  invisible(NULL)
}

#' Check that Exactly One of Several Arguments is Non-NULL
#'
#' @title Validate mutually exclusive parameters
#' @description
#' Validates that exactly one of the provided arguments is non-NULL.
#' Covers annotations like "mutually exclusive with dir and text".
#' Pass arguments as named values.
#'
#' @param ... Named arguments to check. Names are used in error messages.
#' @param required If TRUE (default), exactly one must be non-NULL.
#'   If FALSE, zero or one may be non-NULL (all-NULL is allowed).
#'
#' @return
#' Invisibly returns NULL if constraint is satisfied
#' Throws an error if zero or more than one is non-NULL
#'
#' @examples
#' check_exclusive(paths = "file.txt", dir = NULL, text = NULL)  # Valid
#' check_exclusive(paths = NULL, dir = NULL, text = NULL, required = FALSE)  # Valid
#' check_exclusive(paths = "file.txt", dir = "src/", text = NULL)  # Error (two)
#' check_exclusive(paths = NULL, dir = NULL, text = NULL)  # Error (none, required)
#'
check_exclusive <- function(..., required = TRUE) {
  args <- list(...)
  nms <- names(args)
  if (is.null(nms) || any(nms == "")) {
    stop("All arguments to check_exclusive() must be named.", call. = FALSE)
  }

  provided <- nms[!vapply(args, is.null, logical(1))]
  n <- length(provided)

  if (n > 1L) {
    stop(
      sprintf("Only one of %s can be provided, but got: %s.",
              oxford_comma(paste0("`", nms, "`")),
              paste0("`", provided, "`", collapse = ", ")),
      call. = FALSE
    )
  }

  if (required && n == 0L) {
    stop(
      sprintf("Exactly one of %s must be provided.",
              oxford_comma(paste0("`", nms, "`"))),
      call. = FALSE
    )
  }

  invisible(NULL)
}

#' Check that a List Contains Elements of a Specific Type
#'
#' @title Validate homogeneous list elements
#' @description
#' Validates that input is a list and every element passes a given check.
#' Covers annotations like "list of language objects",
#' "list of data.frames", "list of numeric vectors".
#'
#' @param x The value to validate (should be a list)
#' @param check_fn A function that validates a single element (e.g., check_numeric).
#'   Must throw an error on invalid input and return invisibly on valid input.
#' @param element_desc Description of expected elements for error messages
#'   (e.g., "numeric vectors", "language objects")
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if valid
#' Throws an error if x is not a list or any element fails the check
#'
#' @examples
#' check_list_of(list(1:3, 4:6), check_numeric, "numeric vectors")  # Valid
#' check_list_of(list("a", "b"), check_string, "strings")           # Valid
#' check_list_of(list(1, "a"), check_numeric, "numeric vectors")    # Error (element 2)
#' check_list_of(c(1, 2), check_numeric, "numeric vectors")         # Error (not a list)
#'
check_list_of <- function(
  x,
  check_fn,
  element_desc = "valid elements",
  ...,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }

    if (!is.list(x)) {
      stop_input_type(
        x,
        sprintf("a list of %s", element_desc),
        allow_null = allow_null,
        arg = arg,
        call = call
      )
    }

    for (i in seq_along(x)) {
      tryCatch(
        check_fn(x[[i]]),
        error = function(e) {
          idx_label <- if (!is.null(names(x)) && nzchar(names(x)[i])) {
            sprintf('$%s', names(x)[i])
          } else {
            sprintf('[[%d]]', i)
          }
          stop(
            sprintf("`%s%s` is not valid: %s", arg, idx_label, conditionMessage(e)),
            call. = FALSE
          )
        }
      )
    }

    return(invisible(NULL))
  }

  stop_input_type(
    x,
    sprintf("a list of %s", element_desc),
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

#' Check that a Value Satisfies at Least One of Several Type Checks
#'
#' @title Validate union / alternation types
#' @description
#' Tries each check function in order. If any succeeds, the value is valid.
#' If all fail, throws an error with the combined description.
#' Covers annotations like "function | call | name | atomic" and
#' "integer vector (length 2) | matrix[2,2] | table[2,2]".
#'
#' @param x The value to validate
#' @param ... Check functions to try (each takes one argument, throws on failure)
#' @param msg Description of what x should be, used in error message.
#'   E.g., "a function, a call, a symbol, or an atomic vector".
#' @param allow_null If TRUE, also accept NULL as valid
#' @param arg The argument name (auto-detected) used in error messages
#' @param call The calling environment (auto-detected) for error context
#'
#' @return
#' Invisibly returns NULL if any check passes
#' Throws an error if all checks fail
#'
#' @examples
#' check_any(sum, check_function, check_string, msg = "a function or a string")  # Valid
#' check_any("hi", check_function, check_string, msg = "a function or a string")  # Valid
#' check_any(123, check_function, check_string, msg = "a function or a string")  # Error
#'
check_any <- function(
  x,
  ...,
  msg,
  allow_null = FALSE,
  arg = caller_arg(x),
  call = caller_env()
) {
  if (!missing(x)) {
    if (allow_null && is_null(x)) {
      return(invisible(NULL))
    }

    checks <- list(...)
    for (chk in checks) {
      result <- tryCatch({ chk(x); TRUE }, error = function(e) FALSE)
      if (result) return(invisible(NULL))
    }
  }

  stop_input_type(
    x,
    msg,
    allow_null = allow_null,
    arg = arg,
    call = call
  )
}

# ============================================================================
# END OF ROXYGEN2-DOCUMENTED VALIDATION MODULE
# ============================================================================
# This file is now 100% self-contained with professional roxygen2 documentation!
#
# USAGE:
#   source("compat-types-check-standalone-ROXYGEN.R")
#   check_bool(x)
#   check_string(x)
#   # ... use any validation function
#
# DOCUMENTATION STYLE: roxygen2 (@title, @description, @param, @return, @examples)
# ============================================================================