#==========================================================
# Date Check
#==========================================================

#' Check Date Values
#'
#' Checks a Date or POSIXct variable for missing values,
#' dates outside user-defined limits, and optionally future
#' dates.
#'
#' @param data A data.frame.
#' @param variable A single character string specifying the
#'   Date or POSIXct variable to check.
#' @param min_date Optional minimum acceptable date.
#' @param max_date Optional maximum acceptable date.
#' @param allow_future Logical. If FALSE, dates later than
#'   the current date are flagged. Default is TRUE.
#'
#' @return A data.frame of class \code{DateCheck} containing
#'   row-level date diagnostics.
#'
#' @details
#' The selected variable must inherit from \code{Date} or
#' \code{POSIXct}.
#'
#' Missing values are reported separately and are not
#' classified as out-of-range dates.
#'
#' When \code{allow_future = FALSE}, observations later than
#' the current date are flagged in \code{Future}.
#'
#' The \code{min_date} and \code{max_date} arguments may be
#' supplied as Date, POSIXct, or single character strings
#' in ISO format (\code{YYYY-MM-DD}).
#'
#' @examples
#' dat <- data.frame(
#'   Sample_Date = as.Date(c(
#'     "2025-01-01",
#'     "2025-06-01",
#'     "2026-01-01",
#'     NA
#'   ))
#' )
#'
#' date_check(
#'   dat,
#'   variable = "Sample_Date",
#'   min_date = "2025-01-01",
#'   max_date = "2025-12-31"
#' )
#'
#' @export

date_check <- function(
    data,
    variable,
    min_date = NULL,
    max_date = NULL,
    allow_future = TRUE
) {

  #---------------------------------------------
  # Validate data
  #---------------------------------------------
  validate_data(data)

  #---------------------------------------------
  # Validate variable
  #---------------------------------------------
  if (
    missing(variable) ||
    !is.character(variable) ||
    length(variable) != 1L ||
    is.na(variable) ||
    !nzchar(variable)
  ) {

    stop(
      "'variable' must be a single non-empty character string.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Check variable exists
  #---------------------------------------------
  if (!variable %in% names(data)) {

    stop(
      sprintf(
        "Variable '%s' was not found in 'data'.",
        variable
      ),
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Validate allow_future
  #---------------------------------------------
  if (
    !is.logical(allow_future) ||
    length(allow_future) != 1L ||
    is.na(allow_future)
  ) {

    stop(
      "'allow_future' must be TRUE or FALSE.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Extract variable
  #---------------------------------------------
  x <- data[[variable]]

  #---------------------------------------------
  # Validate date class
  #---------------------------------------------
  if (
    !inherits(x, "Date") &&
    !inherits(x, "POSIXct")
  ) {

    stop(
      "'variable' must refer to a Date or POSIXct variable.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Helper: convert date limits
  #---------------------------------------------
  convert_limit <- function(value, argument) {

    # NULL is allowed
    if (is.null(value)) {
      return(NULL)
    }

    # Must contain exactly one non-missing value
    if (
      length(value) != 1L ||
      is.na(value)
    ) {

      stop(
        sprintf(
          "'%s' must contain exactly one non-missing date.",
          argument
        ),
        call. = FALSE
      )
    }

    # POSIXct
    if (inherits(value, "POSIXct")) {

      return(
        as.Date(value)
      )
    }

    # Date
    if (inherits(value, "Date")) {

      return(value)
    }

    # Character date
    if (is.character(value)) {

      converted <- suppressWarnings(
        as.Date(
          value,
          format = "%Y-%m-%d"
        )
      )

      if (is.na(converted)) {

        stop(
          sprintf(
            "'%s' could not be converted to a valid date.",
            argument
          ),
          call. = FALSE
        )
      }

      return(converted)
    }

    # Unsupported input
    stop(
      sprintf(
        "'%s' must be a Date, POSIXct, character date, or NULL.",
        argument
      ),
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Convert date limits
  #---------------------------------------------
  min_date <- convert_limit(
    min_date,
    "min_date"
  )

  max_date <- convert_limit(
    max_date,
    "max_date"
  )

  #---------------------------------------------
  # Validate relationship between limits
  #---------------------------------------------
  if (
    !is.null(min_date) &&
    !is.null(max_date) &&
    min_date > max_date
  ) {

    stop(
      "'min_date' cannot be later than 'max_date'.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Convert observations to Date
  #---------------------------------------------
  date_value <- as.Date(x)

  #---------------------------------------------
  # Missing dates
  #---------------------------------------------
  missing_value <- is.na(date_value)

  #---------------------------------------------
  # Below minimum
  #---------------------------------------------
  below_min <- rep(
    FALSE,
    length(date_value)
  )

  if (!is.null(min_date)) {

    below_min <-
      !missing_value &
      date_value < min_date
  }

  #---------------------------------------------
  # Above maximum
  #---------------------------------------------
  above_max <- rep(
    FALSE,
    length(date_value)
  )

  if (!is.null(max_date)) {

    above_max <-
      !missing_value &
      date_value > max_date
  }

  #---------------------------------------------
  # Future dates
  #---------------------------------------------
  future <- rep(
    FALSE,
    length(date_value)
  )

  if (!allow_future) {

    future <-
      !missing_value &
      date_value > Sys.Date()
  }

  #---------------------------------------------
  # Overall validity
  #---------------------------------------------
  valid_date <-
    !missing_value &
    !below_min &
    !above_max &
    !future

  #---------------------------------------------
  # Construct result
  #---------------------------------------------
  result <- data.frame(
    Row = seq_along(x),
    Value = x,
    Missing = missing_value,
    BelowMin = below_min,
    AboveMax = above_max,
    Future = future,
    ValidDate = valid_date,
    stringsAsFactors = FALSE,
    check.names = FALSE
  )

  #---------------------------------------------
  # Assign class
  #---------------------------------------------
  class(result) <- c(
    "DateCheck",
    "data.frame"
  )

  result
}
