# Tests for extras() warning behavior with different table types
# Tests that extras() warns appropriately but always succeeds

test_that("extras() completes successfully with normal stratified table", {
  skip_if_not_installed("gtsummary")

  # Should not warn with normal operation
  expect_no_warning(
    gtsummary::trial |>
      gtsummary::tbl_summary(by = trt, include = c(age, grade)) |>
      extras(pval = TRUE, overall = TRUE)
  )
})

test_that("extras() returns valid gtsummary object even if components fail", {
  skip_if_not_installed("gtsummary")

  result <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age) |>
    extras()

  expect_s3_class(result, "gtsummary")
})

# Tests for tbl_regression behavior
# Regression tables silently skip overall/pval — they already
# have model p-values. extras() applies bold_labels, bold_p,
# modify_header, and clean_table.
test_that("tbl_regression does NOT warn with default params", {
  skip_if_not_installed("gtsummary")

  m1 <- glm(response ~ age + grade, data = gtsummary::trial, family = binomial)
  tbl <- gtsummary::tbl_regression(m1)

  expect_no_warning(extras(tbl))
})

test_that("tbl_regression does NOT warn with explicit overall and pval", {
  skip_if_not_installed("gtsummary")

  m1 <- glm(response ~ age + grade, data = gtsummary::trial, family = binomial)
  tbl <- gtsummary::tbl_regression(m1)

  # Silently ignored — no warnings
  expect_no_warning(extras(tbl, overall = TRUE, pval = TRUE))
})

test_that("tbl_regression succeeds with bold_p() applied", {
  skip_if_not_installed("gtsummary")

  m1 <- glm(response ~ age + grade, data = gtsummary::trial, family = binomial)
  tbl <- gtsummary::tbl_regression(m1)

  result <- extras(tbl)

  expect_s3_class(result, "gtsummary")
  expect_s3_class(result, "tbl_regression")

  # bold_p() should have been applied
  bold_info <- result$table_styling$text_format
  has_bold_p <- any(
    bold_info$column == "p.value" & bold_info$format_type == "bold"
  )
  expect_true(has_bold_p)
})

# Tests for tbl_strata warning behavior
test_that("tbl_strata warns when requesting unsupported features", {
  skip_if_not_installed("gtsummary")
  skip_if_not_installed("purrr")

  tbl <- gtsummary::trial |>
    dplyr::select(grade, age, trt) |>
    gtsummary::tbl_strata(
      strata = grade,
      .tbl_fun = ~ .x |>
        gtsummary::tbl_summary(by = trt, include = age)
    )

  expect_warning(
    extras(tbl, overall = TRUE, pval = TRUE),
    class = "extras_strata_limited_support"
  )
})

test_that("tbl_strata succeeds despite warning", {
  skip_if_not_installed("gtsummary")
  skip_if_not_installed("purrr")

  tbl <- gtsummary::trial |>
    dplyr::select(grade, age, trt) |>
    gtsummary::tbl_strata(
      strata = grade,
      .tbl_fun = ~ .x |>
        gtsummary::tbl_summary(by = trt, include = age)
    )

  result <- suppressWarnings(extras(tbl, overall = TRUE, pval = TRUE))

  expect_s3_class(result, "gtsummary")
  expect_s3_class(result, "tbl_strata")
})

test_that("tbl_strata does not warn with default params", {
  skip_if_not_installed("gtsummary")
  skip_if_not_installed("purrr")

  tbl <- gtsummary::trial |>
    dplyr::select(grade, age, trt) |>
    gtsummary::tbl_strata(
      strata = grade,
      .tbl_fun = ~ .x |>
        gtsummary::tbl_summary(by = trt, include = age)
    )

  expect_no_warning(extras(tbl))
})

test_that("tbl_strata does not warn with explicit FALSE params", {
  skip_if_not_installed("gtsummary")
  skip_if_not_installed("purrr")

  tbl <- gtsummary::trial |>
    dplyr::select(grade, age, trt) |>
    gtsummary::tbl_strata(
      strata = grade,
      .tbl_fun = ~ .x |>
        gtsummary::tbl_summary(by = trt, include = age)
    )

  expect_no_warning(extras(tbl, overall = FALSE, pval = FALSE))
})

test_that("tbl_strata does not trigger not-stratified warning", {
  skip_if_not_installed("gtsummary")
  skip_if_not_installed("purrr")

  tbl <- gtsummary::trial |>
    dplyr::select(grade, age, trt) |>
    gtsummary::tbl_strata(
      strata = grade,
      .tbl_fun = ~ .x |>
        gtsummary::tbl_summary(by = trt, include = age)
    )

  # Should ONLY get strata warning, not the not-stratified warning
  expect_warning(
    extras(tbl, overall = TRUE, pval = TRUE),
    class = "extras_strata_limited_support"
  )

  # Verify extras_not_stratified does NOT fire
  warnings_caught <- character(0)
  withCallingHandlers(
    extras(tbl, overall = TRUE, pval = TRUE),
    warning = function(w) {
      warnings_caught <<- c(warnings_caught, class(w)[1])
      invokeRestart("muffleWarning")
    }
  )
  expect_false("extras_not_stratified" %in% warnings_caught)
})

# Tests for tbl_merge behavior
# Merged tables get a helpful message (not warning) guiding
# users to add features before merging.
test_that("tbl_merge warns with default params", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)
  mrg <- suppressMessages(gtsummary::tbl_merge(list(tbl, tbl)))

  expect_warning(
    extras(mrg),
    class = "extras_merged_unsupported"
  )
})

test_that("tbl_merge is silent when overall and pval are FALSE", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)
  mrg <- suppressMessages(gtsummary::tbl_merge(list(tbl, tbl)))

  expect_no_warning(
    extras(mrg, overall = FALSE, pval = FALSE)
  )
})

test_that("tbl_merge does not trigger not-stratified warning", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)
  mrg <- suppressMessages(gtsummary::tbl_merge(list(tbl, tbl)))

  # Should get merged warning, NOT the extras_not_stratified warning
  expect_warning(
    extras(mrg, pval = TRUE, overall = TRUE),
    class = "extras_merged_unsupported"
  )
})

test_that("tbl_merge still applies formatting", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)
  mrg <- suppressMessages(gtsummary::tbl_merge(list(tbl, tbl)))

  result <- suppressWarnings(extras(mrg))

  expect_s3_class(result, "gtsummary")
  label_header <- result$table_styling$header |>
    dplyr::filter(column == "label")
  expect_equal(label_header$label, "")
})

# Tests for non-stratified table warning behavior
test_that("non-stratified tbl_summary warns when requesting overall", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(include = age)

  expect_warning(
    extras(tbl, overall = TRUE, pval = FALSE),
    class = "extras_not_stratified"
  )
})

test_that("non-stratified tbl_summary warns when requesting pval", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(include = age)

  expect_warning(
    extras(tbl, pval = TRUE, overall = FALSE),
    class = "extras_not_stratified"
  )
})

test_that("non-stratified warns when requesting overall and pval", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(include = age)

  expect_warning(
    extras(tbl, overall = TRUE, pval = TRUE),
    class = "extras_not_stratified"
  )
})

test_that("non-stratified tbl_summary succeeds despite warning", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(include = age)

  result <- suppressWarnings(extras(tbl, overall = TRUE, pval = TRUE))

  expect_s3_class(result, "gtsummary")
  expect_s3_class(result, "tbl_summary")
})

test_that("non-stratified does not warn when pval/overall FALSE", {
  skip_if_not_installed("gtsummary")

  expect_no_warning(
    gtsummary::trial |>
      gtsummary::tbl_summary(include = age) |>
      extras(pval = FALSE, overall = FALSE)
  )
})

test_that("extras() with .args parameter works without warnings", {
  skip_if_not_installed("gtsummary")

  extra_args <- list(pval = TRUE, overall = TRUE, last = FALSE)

  expect_no_warning(
    gtsummary::trial |>
      gtsummary::tbl_summary(by = trt, include = age) |>
      extras(.args = extra_args)
  )
})

test_that("extras() with .args parameter warns for non-stratified table", {
  skip_if_not_installed("gtsummary")

  extra_args <- list(pval = TRUE, overall = TRUE)

  expect_warning(
    gtsummary::trial |>
      gtsummary::tbl_summary(include = age) |>
      extras(.args = extra_args),
    class = "extras_not_stratified"
  )
})

test_that(".args silently ignores overall/pval for tbl_regression", {
  skip_if_not_installed("gtsummary")

  m1 <- glm(response ~ age + grade, data = gtsummary::trial, family = binomial)
  tbl <- gtsummary::tbl_regression(m1)

  extra_args <- list(pval = TRUE, overall = TRUE)

  expect_no_warning(extras(tbl, .args = extra_args))
})

test_that("extras() warns with correct class when add_overall fails", {
  skip_if_not_installed("gtsummary")

  # Force add_overall() to fail by calling extras() twice
  # (stat_0 already exists from first call)
  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age) |>
    extras()

  expect_warning(
    extras(tbl),
    class = "extras_overall_failed"
  )
})

test_that("extras() warns with correct class when add_p fails", {
  skip_if_not_installed("gtsummary")

  # Force add_p() to fail by calling extras() twice
  # (p.value column already exists from first call)
  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age) |>
    extras()

  expect_warning(
    extras(tbl, overall = FALSE),
    class = "extras_pvalue_failed"
  )
})

test_that("extras() completes with both pval and overall options", {
  skip_if_not_installed("gtsummary")

  result <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = c(age, grade)) |>
    extras(pval = TRUE, overall = TRUE, last = FALSE)

  expect_s3_class(result, "gtsummary")

  # Verify both features were added
  expect_true("p.value" %in% names(result$table_body))
  expect_true("stat_0" %in% names(result$table_body))
})

test_that("extras() completes with last = TRUE for overall column", {
  skip_if_not_installed("gtsummary")

  result <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age) |>
    extras(overall = TRUE, last = TRUE)

  expect_s3_class(result, "gtsummary")
  expect_true("stat_0" %in% names(result$table_body))
})

# Tests that basic formatting is still applied even when warnings occur
test_that("extras() applies formatting to tbl_regression", {
  skip_if_not_installed("gtsummary")

  m1 <- glm(response ~ age + grade, data = gtsummary::trial, family = binomial)
  tbl <- gtsummary::tbl_regression(m1)

  # Even with explicit overall/pval — silently ignored, formatting applied
  result <- extras(tbl, overall = TRUE, pval = TRUE)

  expect_s3_class(result, "gtsummary")
  label_header <- result$table_styling$header |>
    dplyr::filter(column == "label")
  expect_equal(label_header$label, "")
})

test_that("extras() applies formatting to non-stratified despite warning", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(include = age)

  result <- suppressWarnings(extras(tbl, overall = TRUE, pval = TRUE))

  # Should still have modified the header
  expect_s3_class(result, "gtsummary")
  label_header <- result$table_styling$header |>
    dplyr::filter(column == "label")
  expect_equal(label_header$label, "")
})

test_that("extras() with different regression models applies bold_p", {
  skip_if_not_installed("gtsummary")

  # Test with lm
  m_lm <- lm(age ~ grade + marker, data = gtsummary::trial)
  tbl_lm <- gtsummary::tbl_regression(m_lm)

  # No warnings, even with explicit overall
  expect_no_warning(result_lm <- extras(tbl_lm, overall = TRUE))
  expect_s3_class(result_lm, "gtsummary")

  # bold_p() applied
  bold_info <- result_lm$table_styling$text_format
  has_bold_p <- any(
    bold_info$column == "p.value" & bold_info$format_type == "bold"
  )
  expect_true(has_bold_p)
})

# =============================================================================
# Input validation error tests
# =============================================================================

test_that("extras() errors with non-gtsummary input", {
  skip_if_not_installed("gtsummary")

  expect_error(
    extras(data.frame(a = 1)),
    class = "extras_invalid_input"
  )

  expect_error(
    extras("not a table"),
    class = "extras_invalid_input"
  )
})

test_that("extras() errors with non-list .add_p_args", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)

  expect_error(
    extras(tbl, .add_p_args = "not_a_list"),
    class = "extras_invalid_add_p_args"
  )
})

test_that("extras() errors with non-list .args", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)

  expect_error(
    extras(tbl, .args = "not_a_list"),
    class = "extras_invalid_args"
  )
})

test_that("extras() errors with invalid .args names", {
  skip_if_not_installed("gtsummary")

  tbl <- gtsummary::trial |>
    gtsummary::tbl_summary(by = trt, include = age)

  expect_error(
    extras(tbl, .args = list(fake_arg = TRUE)),
    class = "extras_invalid_arg_names"
  )
})