#==========================================================
# Audit Rules
#==========================================================

#' Create Data Audit Rules
#'
#' Creates a structured collection of user-defined data
#' validation rules for use with DataAudit.
#'
#' @param range Named list. Each element specifies the
#'   acceptable numeric range for a variable as a numeric
#'   vector of length two.
#' @param category Named list. Each element contains the
#'   allowed values for a variable.
#' @param unique Character vector containing variables that
#'   should contain unique values.
#' @param required Character vector containing variables
#'   that should not contain missing values.
#' @param pattern Named list. Each element specifies a
#'   regular expression that values of a variable should
#'   satisfy.
#'
#' @return An object of class \code{DataAuditRules}.
#'
#' @details
#' \code{audit_rules()} defines validation requirements but
#' does not evaluate a dataset. The resulting object can be
#' supplied to functions that apply DataAudit rules.
#'
#' Variable names are not checked against a dataset when the
#' rule object is created because the same rule specification
#' may be reused across multiple datasets.
#'
#' @examples
#' rules <- audit_rules(
#'   range = list(
#'     Age = c(0, 30),
#'     Weight = c(0, 100)
#'   ),
#'   category = list(
#'     Species = c("Dog", "Cat", "Cattle")
#'   ),
#'   unique = "Animal_ID",
#'   required = c("Animal_ID", "Species"),
#'   pattern = list(
#'     Animal_ID = "^A[0-9]+$"
#'   )
#' )
#'
#' rules
#'
#' @export

audit_rules <- function(
    range = NULL,
    category = NULL,
    unique = NULL,
    required = NULL,
    pattern = NULL
) {

  #---------------------------------------------
  # Helper: validate named list
  #---------------------------------------------
  validate_named_list <- function(
    x,
    argument
  ) {

    if (is.null(x)) {
      return(invisible(TRUE))
    }

    if (!is.list(x)) {
      stop(
        sprintf(
          "'%s' must be a named list or NULL.",
          argument
        ),
        call. = FALSE
      )
    }

    if (length(x) == 0L) {
      return(invisible(TRUE))
    }

    nms <- names(x)

    if (
      is.null(nms) ||
      any(is.na(nms)) ||
      any(!nzchar(nms))
    ) {
      stop(
        sprintf(
          "'%s' must be a named list with non-empty names.",
          argument
        ),
        call. = FALSE
      )
    }

    if (anyDuplicated(nms)) {
      stop(
        sprintf(
          "'%s' contains duplicated variable names.",
          argument
        ),
        call. = FALSE
      )
    }

    invisible(TRUE)
  }

  #---------------------------------------------
  # Helper: validate variable vector
  #---------------------------------------------
  validate_variables <- function(
    x,
    argument
  ) {

    if (is.null(x)) {
      return(invisible(TRUE))
    }

    if (
      !is.character(x) ||
      anyNA(x) ||
      any(!nzchar(x))
    ) {
      stop(
        sprintf(
          "'%s' must be a character vector of non-empty variable names or NULL.",
          argument
        ),
        call. = FALSE
      )
    }

    if (anyDuplicated(x)) {
      stop(
        sprintf(
          "'%s' contains duplicated variable names.",
          argument
        ),
        call. = FALSE
      )
    }

    invisible(TRUE)
  }

  #---------------------------------------------
  # Validate range
  #---------------------------------------------
  validate_named_list(
    range,
    "range"
  )

  if (!is.null(range)) {

    for (variable in names(range)) {

      limits <- range[[variable]]

      if (
        !is.numeric(limits) ||
        length(limits) != 2L ||
        anyNA(limits) ||
        any(!is.finite(limits))
      ) {
        stop(
          sprintf(
            "Range rule for '%s' must contain two finite numeric values.",
            variable
          ),
          call. = FALSE
        )
      }

      if (limits[1L] > limits[2L]) {
        stop(
          sprintf(
            "Minimum range value cannot exceed maximum for '%s'.",
            variable
          ),
          call. = FALSE
        )
      }
    }
  }

  #---------------------------------------------
  # Validate category
  #---------------------------------------------
  validate_named_list(
    category,
    "category"
  )

  if (!is.null(category)) {

    for (variable in names(category)) {

      allowed <- category[[variable]]

      if (
        !is.atomic(allowed) ||
        length(allowed) == 0L
      ) {
        stop(
          sprintf(
            "Category rule for '%s' must contain a non-empty atomic vector.",
            variable
          ),
          call. = FALSE
        )
      }

      if (anyNA(allowed)) {
        stop(
          sprintf(
            "Category rule for '%s' cannot contain missing values.",
            variable
          ),
          call. = FALSE
        )
      }
    }
  }

  #---------------------------------------------
  # Validate unique and required
  #---------------------------------------------
  validate_variables(
    unique,
    "unique"
  )

  validate_variables(
    required,
    "required"
  )

  #---------------------------------------------
  # Validate pattern
  #---------------------------------------------
  validate_named_list(
    pattern,
    "pattern"
  )

  if (!is.null(pattern)) {

    for (variable in names(pattern)) {

      regex <- pattern[[variable]]

      if (
        !is.character(regex) ||
        length(regex) != 1L ||
        is.na(regex) ||
        !nzchar(regex)
      ) {
        stop(
          sprintf(
            "Pattern rule for '%s' must be a single non-empty character string.",
            variable
          ),
          call. = FALSE
        )
      }

      valid_regex <- tryCatch(
        {
          suppressWarnings(
            grepl(
              regex,
              "",
              perl = TRUE
            )
          )
          TRUE
        },
        error = function(e) {
          FALSE
        }
      )

      if (!valid_regex) {
        stop(
          sprintf(
            "Pattern rule for '%s' is not a valid regular expression.",
            variable
          ),
          call. = FALSE
        )
      }
    }
  }

  #---------------------------------------------
  # Construct object
  #---------------------------------------------
  result <- list(
    range = range,
    category = category,
    unique = unique,
    required = required,
    pattern = pattern
  )

  class(result) <- c(
    "DataAuditRules",
    "list"
  )

  result
}
