# Quarto-safe helpers for CHV2011 gt tables (forked from ak1991-gt-quarto.R).
# fmt_markdown() is required so HTML <sup>/<br> and $...$ math render in Quarto HTML.
# quarto.disable_processing = TRUE only for row-group tables with fragile empty cells (Table 3, A-1).

chv2011_quarto_blank <- function(x) {
  x <- as.character(x)
  x[is.na(x) | x == ""] <- " "
  x
}

chv2011_quarto_blank_df <- function(df) {
  df |>
    dplyr::mutate(dplyr::across(dplyr::everything(), chv2011_quarto_blank))
}

chv2011_digits <- 4L

chv2011_fmt_num <- function(x, digits = chv2011_digits) {
  sprintf(paste0("%.", digits, "f"), as.numeric(x))
}

chv2011_fmt_br_se <- function(estimate, std.error, digits = chv2011_digits) {
  paste0(
    chv2011_fmt_num(estimate, digits),
    "<br>(",
    chv2011_fmt_num(std.error, digits),
    ")"
  )
}

chv2011_stars <- function(p) {
  dplyr::case_when(
    is.na(p) ~ "",
    p < 0.01 ~ "***",
    p < 0.05 ~ "**",
    p < 0.10 ~ "*",
    TRUE ~ ""
  )
}

chv2011_coef_cell <- function(estimate, std.error, p.sig = NULL, digits = chv2011_digits) {
  stars <- if (!is.null(p.sig)) {
    ifelse(nzchar(p.sig), paste0("<sup>", p.sig, "</sup>"), "")
  } else {
    ""
  }
  paste0(
    chv2011_fmt_num(estimate, digits),
    stars,
    "<br>(",
    chv2011_fmt_num(std.error, digits),
    ")"
  )
}

chv2011_mean_sd_cell <- function(mean, sd, digits = chv2011_digits) {
  paste0(
    chv2011_fmt_num(mean, digits),
    "<br>(",
    chv2011_fmt_num(sd, digits),
    ")"
  )
}

chv2011_fix_legacy_coef_cells <- function(df) {
  dplyr::mutate(
    df,
    dplyr::across(
      dplyr::where(is.character),
      ~ {
        .x <- gsub("<br> \\(", "<br>(", .x, fixed = FALSE)
        gsub("\\$\\^\\{([^}]*)\\}\\$", "<sup>\\1</sup>", .x, perl = TRUE)
      }
    )
  )
}

chv2011_math_columns <- c("weight_formula", "weight", "symbol")

chv2011_ensure_math_md <- function(x) {
  x <- as.character(x)
  blank <- is.na(x) | x == " " | x == ""
  already <- grepl("^\\$.*\\$$", x, perl = TRUE)
  needs <- !blank & !already & (grepl("[_^{}|\\\\]", x, perl = TRUE) | grepl("\\bf_", x, perl = TRUE))
  x[needs] <- paste0("$", x[needs], "$")
  x
}

chv2011_fix_math_cells <- function(df) {
  cols <- intersect(names(df), chv2011_math_columns)
  if (!length(cols)) {
    return(df)
  }
  dplyr::mutate(df, dplyr::across(dplyr::all_of(cols), chv2011_ensure_math_md))
}

chv2011_prepare_gt_data <- function(df) {
  df <- df |>
    chv2011_quarto_blank_df() |>
    chv2011_fix_legacy_coef_cells() |>
    chv2011_fix_math_cells()

  if ("p_value_asymp" %in% names(df)) {
    df$p_value_asymp <- chv2011_fmt_num(df$p_value_asymp)
  }
  if ("p_value" %in% names(df)) {
    df$p_value <- chv2011_fmt_num(df$p_value)
  }
  df
}

chv2011_gt_hide_cols <- function(df) {
  if (!"cell" %in% names(df)) {
    return(character(0))
  }
  intersect(names(df), c("p_value_boot", "p_value"))
}

chv2011_gt_cols_label <- function(names_vec) {
  stats::setNames(lapply(names_vec, gt::html), names_vec)
}

chv2011_fix_gt_tbl <- function(x, disable_quarto = FALSE) {
  x[["_data"]] <- chv2011_prepare_gt_data(x[["_data"]])
  col_names <- names(x[["_data"]])
  hide_cols <- chv2011_gt_hide_cols(x[["_data"]])

  x <- x %>%
    gt::tab_options(quarto.disable_processing = disable_quarto) %>%
    gt::fmt_markdown(columns = gt::everything())

  if (length(hide_cols)) {
    x <- x %>% gt::cols_hide(columns = dplyr::all_of(hide_cols))
  }

  label_updates <- list()
  if ("p_asymp" %in% col_names) {
    label_updates$p_asymp <- gt::html("Asymptotic p-value")
  }
  if ("p_value_asymp" %in% col_names) {
    label_updates$p_value_asymp <- gt::html("Asymptotic p-value")
  }

  gt_cols <- intersect(col_names, unlist(x[["_boxhead"]][["var"]], use.names = FALSE))
  if (!length(gt_cols)) {
    gt_cols <- col_names
  }

  x <- x %>% gt::cols_label(.list = chv2011_gt_cols_label(gt_cols))
  if (length(label_updates)) {
    x <- x %>% gt::cols_label(.list = label_updates)
  }
  x
}