#' Print
#'
#' `r lifecycle::badge('experimental')`\cr
#' Print method for objects of class 'card'
#'
#' @param x (`data.frame`)\cr
#'   object of class 'card'
#' @param n (`integer`)\cr
#'   integer specifying the number of rows to print
#' @param columns (`string`)\cr
#'   string indicating whether to print a selected number of columns or all.
#' @param n_col (`integer`)\cr
#'   some columns are removed when there are more than a threshold of
#'   columns present. This argument sets that threshold. This is only used
#'   when `columns='auto'` and default is `6L`.
#'   Columns `'error'`, `'warning'`, `'context'`, and `'fmt_fun'` *may* be removed
#'   from the print. All other columns will be printed, even if more than `n_col`
#'   columns are present.
#' @param ... ([`dynamic-dots`][rlang::dyn-dots])\cr
#'   not used
#'
#' @return an ARD data frame of class 'card' (invisibly)
#' @name print.card
#' @keywords internal
#'
#' @examples
#' ard_tabulate(ADSL, variables = AGEGR1) |>
#'   print()
NULL

#' @export
#' @rdname print.card
print.card <- function(x, n = NULL, columns = c("auto", "all"), n_col = 6L, ...) {
  set_cli_abort_call()

  # convert to a data frame so the list columns print the values in the list ---
  x_print <- as.data.frame(x)

  # number of rows to print (modeled after tibbles print) ----------------------
  n <- n %||% ifelse(nrow(x_print) > 20L, 10L, nrow(x_print))
  x_print <- utils::head(x_print, n = n)

  # remove columns -------------------------------------------------------------
  if (arg_match(columns) %in% "auto") {
    x_print <-
      dplyr::select(
        x_print, all_ard_groups(), all_ard_variables(),
        any_of(c(
          "context", "stat_name", "stat_label", "stat", "stat_fmt",
          "fmt_fun", "warning", "error"
        ))
      )

    # remove warning and error columns if nothing to report
    if (ncol(x_print) > n_col && "warning" %in% names(x_print) && every(x_print[["warning"]], is.null)) {
      x_print[["warning"]] <- NULL
    }
    if (ncol(x_print) > n_col && "error" %in% names(x_print) && every(x_print[["error"]], is.null)) {
      x_print[["error"]] <- NULL
    }

    # remove 'fmt_fun' col if there are many cols
    if (ncol(x_print) > n_col) {
      x_print[["fmt_fun"]] <- NULL
    }
    # remove 'context' col if there are many cols
    if (ncol(x_print) > n_col) {
      x_print[["context"]] <- NULL
    }
  }

  # truncate the 'group##_level', 'variable_level', 'stat_label', and 'context' columns ------
  x_print <-
    tryCatch(
      x_print |>
        dplyr::mutate(
          across(
            c(
              all_ard_groups("levels"),
              all_ard_variables("levels"),
              any_of(c("context", "stat_label", "warning", "error"))
            ),
            function(x) {
              lapply(
                x,
                function(e) {
                  e <- as.character(e) |> paste(collapse = ", ")
                  ifelse(nchar(e) > 9, paste0(substr(e, 1, 8), "\u2026"), e)
                }
              )
            }
          )
        ),
      error = function(e) x_print
    )

  # for the statistics, round to 3 decimal places ------------------------------
  if ("stat" %in% names(x_print)) {
    x_print$stat <- lapply(
      x_print$stat,
      function(x) {
        if (isTRUE(is.numeric(x))) {
          res <- round5(x, digits = 3)
        } else {
          res <- as.character(x)
        }

        if (is_string(res) && nchar(res) > 9) {
          res <- paste0(substr(res, 1, 8), "\u2026")
        }
        res
      }
    )
  }

  # for the formatting function column, abbreviate the print of proper functions
  if ("fmt_fun" %in% names(x_print)) {
    x_print$fmt_fun <- lapply(
      x_print$fmt_fun,
      function(x) {
        if (isTRUE(is.function(x))) {
          return("<fn>")
        }
        x
      }
    )
  }

  # final printing --------------------------------------------------------------
  cli::cli_text(cli::col_grey("{{cards}} data frame: {nrow(x)} x {ncol(x)}"))
  print(x_print)
  if (nrow(x) > n) {
    cli::cli_alert_info(cli::col_grey("{nrow(x) - n} more rows"))
    cli::cli_alert_info(cli::col_grey("Use {.code print(n = ...)} to see more rows"))
  }
  if (ncol(x) > ncol(x_print)) {
    missing_cols <- names(x) |> setdiff(names(x_print))
    cli::cli_alert_info(cli::col_grey(
      "{length(missing_cols)} more variable{?s}: {paste(missing_cols, collapse = ', ')}"
    ))
  }
  invisible(x)
}


#' @export
#' @rdname print.card
print.compare_ard <- function(x, ...) {
  # print comparison details ---------------------------------------------------
  cli::cli_inform("The comparison {.arg keys} are {.val {x$keys}}.")
  cli::cli_inform("The comparison columns are {.val {x$columns}}.")

  # print the mismatches rows --------------------------------------------------
  cli::cli_h1("Mis-matched Rows")
  if (nrow(x$rows_in_x_not_y) == 0L) {
    cli::cli_alert_success("No rows in {.arg x} that do not appear in {.arg y}.")
  } else {
    cli::cli_h3("Rows in {.arg x} that do not appear in {.arg y}.")
    as.data.frame(x$rows_in_x_not_y)
  }
  if (nrow(x$rows_in_y_not_x) == 0L) {
    cli::cli_alert_success("No rows in {.arg y} that do not appear in {.arg x}.")
  } else {
    cli::cli_h3("Rows in {.arg y} that do not appear in {.arg x}.")
    as.data.frame(x$rows_in_y_not_x) |> print()
  }

  # print comparison results ---------------------------------------------------
  cli::cli_h1("Comparison Results")
  for (i in seq_along(x$comparison)) {
    if (nrow(x$comparison[[i]]) == 0L) {
      cli::cli_alert_success("No differences found in column {.val {names(x$comparison[i])}}.")
      next
    }
    cli::cli_alert_warning("Differences found in column {.val {names(x$comparison[i])}} for {.val {nrow(x$comparison[[i]])}} rows.")
    as.data.frame(x$comparison[[i]]) |>
      utils::head(n = 10) |>
      print()
  }

  # return input invisibly -----------------------------------------------------
  invisible(x)
}
