#' Get the names of columns in model_out_tbl corresponding to task IDs
#'
#' @param model_out_tbl Model output tibble with predictions
#'
#' @return character vector of column names
#'
#' @noRd
get_task_id_cols <- function(model_out_tbl) {
  model_out_cols <- colnames(model_out_tbl)
  # To-do: hubUtils::std_colnames (non-task id cols)
  non_task_cols <- c(
    "model_id",
    "output_type",
    "output_type_id",
    "value",
    "model_abbr",
    "team_abbr"
  )
  task_id_cols <- model_out_cols[!model_out_cols %in% non_task_cols]

  task_id_cols
}

#' Validate model_out_tbl and oracle_output arguments to transform functions
#'
#' @param model_out_tbl Model output tibble with predictions
#' @param oracle_output Predictions that would have been generated by an oracle
#' model that knew the observed target data values in advance
#'
#' @return The input `model_out_tbl`, possibly modified to ensure it has S3 class `model_out_tbl`
#'
#' @noRd
validate_model_oracle_out <- function(model_out_tbl, oracle_output) {
  # check that: model_out_tbl contains columns: model_id, output_type, output_type_id, value
  req_cols <- c("model_id", "output_type", "output_type_id", "value")
  if (!all(req_cols %in% colnames(model_out_tbl))) {
    cli::cli_abort(
      "model_out_tbl does not contain required columns: model_id, output_type, output_type_id, value:
      {.val {colnames(model_out_tbl)}}"
    )
  }

  # check that model_out_tbl and oracle_output have compatible columns
  task_id_cols <- get_task_id_cols(model_out_tbl)
  if (length(task_id_cols[task_id_cols %in% colnames(oracle_output)]) == 0) {
    cli::cli_abort(
      "model_out_tbl and oracle_output do not have compatible columns"
    )
  }
  t_o_cols <- colnames(oracle_output)
  expected_cols_superset <- c(
    task_id_cols,
    "output_type",
    "output_type_id",
    "oracle_value"
  )
  unexpected_cols <- t_o_cols[!t_o_cols %in% expected_cols_superset]
  if (length(unexpected_cols) > 0) {
    cli::cli_abort(
      c(
        "`oracle_output` had {length(unexpected_cols)} unexpected column{?s} {.val {unexpected_cols}};",
        " expected the columns of `oracle_output` to be a subset of {.val {expected_cols_superset}}."
      )
    )
  }

  if (!c("oracle_value") %in% colnames(oracle_output)) {
    cli::cli_abort(
      "oracle_output does not have oracle_value column"
    )
  }

  if (!inherits(model_out_tbl, "model_out_tbl")) {
    model_out_tbl <- hubUtils::as_model_out_tbl(model_out_tbl)
  }

  model_out_tbl
}


#' Check that model_out_tble has a single `output_type` that is one of the
#' `output_types` that is supported by this function.
#'
#' @return if valid, the output_type in model_out_tbl
#'
#' @noRd
validate_output_type <- function(model_out_tbl) {
  output_type <- unique(model_out_tbl$output_type)
  if (length(output_type) != 1) {
    cli::cli_abort(
      "model_out_tbl must contain a single output_type, but it has multiple:
      {.val {output_type}}"
    )
  }

  error_if_invalid_output_type(output_type)

  output_type
}


error_if_invalid_output_type <- function(output_type) {
  supported_types <- c("mean", "median", "pmf", "quantile", "sample")
  if (!output_type %in% supported_types) {
    cli::cli_abort(
      "Provided `model_out_tbl` contains `output_type` {.val {output_type}};
      hubEvals currently only supports the following types:
      {.val {supported_types}}"
    )
  }
}


#' Validate relative metrics
#'
#' @noRd
validate_relative_metrics <- function(relative_metrics, metrics, by) {
  if (any(is_interval_coverage_metric(relative_metrics))) {
    cli::cli_abort(
      "Interval coverage metrics are not supported for relative skill scores."
    )
  }

  if ("bias" %in% relative_metrics) {
    cli::cli_abort(
      c(
        "{.val bias} is not supported for relative skill scores.",
        "i" = "Bias is a signed quantity, so a geometric-mean pairwise ratio has no clean interpretation.",
        "i" = "Drop {.val bias} from {.arg relative_metrics} (it can still be requested via {.arg metrics})."
      )
    )
  }

  if (length(relative_metrics) > 0 && !"model_id" %in% by) {
    cli::cli_abort(
      "Relative metrics require 'model_id' to be included in {.arg by}."
    )
  }

  extra_metrics <- setdiff(relative_metrics, metrics)
  if (length(extra_metrics) > 0) {
    cli::cli_abort(c(
      "Relative metrics must be a subset of the metrics.",
      "x" = "The following {.arg relative_metrics} are not in {.arg metrics}: {.val {extra_metrics}}"
    ))
  }
}


#' Infer transform label from function expression
#'
#' Extracts a label for the transformation function, either from user input
#' or by inferring it from the function name.
#'
#' @param transform_expr The captured expression for the transform argument,
#'   obtained via `rlang::enexpr(transform)` in the calling function.
#' @param transform_label User-provided label, or NULL to auto-generate
#' @param call The call to use in error messages (for cli::cli_abort)
#'
#' @return Character string label (e.g., "log_shift", "sqrt")
#'
#' @details
#' When `transform_label` is NULL, the function name is extracted from the
#' expression. For namespaced calls like `scoringutils::log_shift`, only the
#' function name ("log_shift") is used. Anonymous functions require an
#' explicit `transform_label`.
#'
#' @noRd
get_transform_label <- function(
  transform_expr,
  transform_label,
  call = rlang::caller_env()
) {
  if (!is.null(transform_label)) {
    return(transform_label)
  }

  # Check if transform was passed as a named function:
  # - is_symbol: bare function name like `sqrt` or `log_shift`
  # - is_call(, "::"): namespaced function like `scoringutils::log_shift`
  if (
    rlang::is_symbol(transform_expr) || rlang::is_call(transform_expr, "::")
  ) {
    # Extract function name, stripping namespace if present
    # e.g., "scoringutils::log_shift" -> "log_shift"
    return(sub(".*::", "", rlang::as_label(transform_expr)))
  }

  # Anonymous functions (e.g., function(x) log(x + 1)) don't have a name
  # to infer, so require explicit label
  cli::cli_abort(
    "{.arg transform_label} is required when using an anonymous transform function.",
    call = call
  )
}


#' Validate transformation parameters
#'
#' @param transform A transformation function or NULL
#' @param transform_label User-provided label or NULL
#' @param output_type The output_type from the model_out_tbl
#' @param call The call to use in error messages (for cli::cli_abort)
#'
#' @return TRUE (invisibly), or errors with informative message
#'
#' @noRd
validate_transform <- function(
  transform,
  transform_label,
  output_type,
  call = rlang::caller_env()
) {
  if (is.null(transform)) {
    return(invisible(TRUE))
  }

  if (!is.function(transform)) {
    cli::cli_abort(
      c(
        "{.arg transform} must be a function or NULL.",
        "x" = "Got {.cls {class(transform)}} instead."
      ),
      call = call
    )
  }

  if (!is.null(transform_label) && !is.character(transform_label)) {
    cli::cli_abort(
      c(
        "{.arg transform_label} must be a character string or NULL.",
        "x" = "Got {.cls {class(transform_label)}} instead."
      ),
      call = call
    )
  }

  if (output_type == "pmf") {
    cli::cli_abort(
      c(
        "Scale transformations are not supported for pmf output types.",
        "i" = "Transformations can only be applied to quantile, mean, median, or sample forecasts."
      ),
      call = call
    )
  }

  invisible(TRUE)
}


#' Validate transformed forecast values for non-finite entries
#'
#' Checks `predicted` and `observed` columns of a transformed scoringutils
#' forecast object for `NaN` and `Inf` values, which would silently corrupt
#' downstream scoring results.
#'
#' @param forecast A scoringutils forecast object (after `transform_forecasts()`).
#' @param call The call to use in error messages (for cli::cli_abort).
#'
#' @return `forecast` (invisibly), or errors with informative message.
#'
#' @noRd
validate_transform_values <- function(forecast, call = rlang::caller_env()) {
  cols_to_check <- intersect(c("predicted", "observed"), colnames(forecast))

  n_nan <- sum(purrr::map_int(cols_to_check, \(col) {
    sum(is.nan(forecast[[col]]))
  }))
  n_inf <- sum(purrr::map_int(cols_to_check, \(col) {
    sum(is.infinite(forecast[[col]]))
  }))

  if (n_nan == 0 && n_inf == 0) {
    return(invisible(forecast))
  }

  # nolint next: object_usage_linter
  affected_cols <- cols_to_check[purrr::map_lgl(
    cols_to_check,
    \(col) any(!is.finite(forecast[[col]]))
  )]

  cli::cli_abort(
    c(
      "Scale transformation produced non-finite values in
       {.field {affected_cols}}: {n_nan} NaN{?s} and {n_inf} Inf{?s}.",
      "x" = "Scoring results would be invalid with non-finite values.",
      "i" = "Use a transform that is valid for all values in the data."
    ),
    call = call
  )
}


#' Validate compound_taskid_set and check data consistency
#'
#' @param data Joined model output + oracle data, filtered to samples.
#' @param compound_taskid_set Character vector of task IDs that stay constant
#'   within each sample draw.
#' @param task_id_cols Character vector of all task ID column names.
#' @param call Calling environment for error messages.
#'
#' @noRd
validate_compound_taskid_set <- function(
  data,
  compound_taskid_set,
  task_id_cols,
  call = rlang::caller_env()
) {
  if (!is.character(compound_taskid_set) || length(compound_taskid_set) == 0) {
    cli::cli_abort(
      "{.arg compound_taskid_set} must be a non-empty character vector.",
      call = call
    )
  }

  invalid_cols <- setdiff(compound_taskid_set, task_id_cols)
  if (length(invalid_cols) > 0) {
    cli::cli_abort(
      c(
        "{.arg compound_taskid_set} contains invalid column{?s}: {.val {invalid_cols}}.",
        "i" = "Valid task ID columns: {.val {task_id_cols}}"
      ),
      call = call
    )
  }

  joint_across <- setdiff(task_id_cols, compound_taskid_set)
  if (length(joint_across) == 0) {
    cli::cli_abort(
      c(
        "{.arg compound_taskid_set} includes all task ID columns.",
        "i" = "At least one task ID column must be left out for joint scoring."
      ),
      call = call
    )
  }

  # A draw is identified by compound_taskid_set + output_type_id.
  # Sample IDs are only unique within each compound group, not globally.
  draw_group <- c(compound_taskid_set, "output_type_id")

  # Non-compound (joint_across) task IDs must vary within draws
  n_unique_per_draw <- data |>
    dplyr::group_by(dplyr::across(dplyr::all_of(draw_group))) |>
    dplyr::summarise(
      dplyr::across(
        dplyr::all_of(joint_across),
        dplyr::n_distinct
      ),
      .groups = "drop"
    )

  # Draws where ALL non-compound task IDs are constant (no joint structure)
  bad <- n_unique_per_draw |>
    dplyr::filter(dplyr::if_all(dplyr::all_of(joint_across), \(.x) .x == 1L))

  if (nrow(bad) > 0L) {
    bad_samples <- bad[["output_type_id"]] # nolint: object_usage_linter
    cli::cli_abort(
      c(
        "Non-compound task IDs must vary within sample draws for joint scoring,
         but {nrow(bad)} draw{?s} have no variation.",
        "i" = "First failing sample ID{?s}: {.val {utils::head(unique(bad_samples), 5)}}"
      ),
      call = call
    )
  }

  invisible(TRUE)
}
