# Combined tests from ci/
# Auto-generated by workspace refactor script

# ===== BEGIN ci/test-site-map-tools.R =====
skip_if_not_test_level("ci")

find_package_root <- function() {
  source_root <- Sys.getenv("DPMIXGPD_SOURCE_ROOT", unset = "")
  if (nzchar(source_root)) {
    source_root <- normalizePath(source_root, winslash = "/", mustWork = FALSE)
    if (file.exists(file.path(source_root, "DESCRIPTION")) &&
        file.exists(file.path(source_root, "tools", "site-map", "extract_site_map.R"))) {
      return(source_root)
    }
  }

  current <- normalizePath(getwd(), winslash = "/", mustWork = TRUE)
  for (i in 0:8) {
    candidate <- current
    if (file.exists(file.path(candidate, "DESCRIPTION"))) {
      return(candidate)
    }
    current <- dirname(current)
  }
  stop("Could not locate package root for site-map tests.")
}

pkg_root <- find_package_root()
source(file.path(pkg_root, "tools", "site-map", "extract_site_map.R"), local = TRUE)
source(file.path(pkg_root, "tools", "site-map", "analyze_site_map.R"), local = TRUE)

write_fixture_file <- function(path, lines) {
  dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
  writeLines(lines, con = path, useBytes = TRUE)
}

make_workflow_pages <- function(docs_root, break_chain = FALSE) {
  for (i in 1:20) {
    file_path <- file.path(docs_root, "workflows", sprintf("v%02d-topic.html", i))
    link_html <- ""
    if (i < 20) {
      if (!(break_chain && i == 10)) {
        link_html <- sprintf("<a href=\"v%02d-topic.html\">next</a>", i + 1L)
      }
    }
    write_fixture_file(
      file_path,
      c(
        "<html><body>",
        sprintf("<h1>v%02d</h1>", i),
        link_html,
        "</body></html>"
      )
    )
  }
}

test_that("extract_site_map handles strict internal links and normalization", {
  tmp_root <- tempfile("site_map_extract_")
  docs_root <- file.path(tmp_root, "docs")
  out_root <- file.path(tmp_root, "out")
  dir.create(docs_root, recursive = TRUE, showWarnings = FALSE)

  write_fixture_file(
    file.path(docs_root, "index.html"),
    c(
      "<html><body>",
      "<a href=\"workflows/v01-start-here.html\">workflow</a>",
      "<a href=\"missing-page.html\">broken</a>",
      "<a href=\"workflows/\">workflows-dir</a>",
      "<a href=\"https://example.com\">external</a>",
      "<a href=\"mailto:test@example.com\">mail</a>",
      "<a href=\"javascript:void(0)\">js</a>",
      "<a href=\"#top\">anchor</a>",
      "</body></html>"
    )
  )
  write_fixture_file(
    file.path(docs_root, "workflows", "index.html"),
    c("<html><body>", "<a href=\"../index.html\">home</a>", "</body></html>")
  )
  write_fixture_file(
    file.path(docs_root, "workflows", "v01-start-here.html"),
    c(
      "<html><body>",
      "<a href=\"../index.html#intro\">back-home</a>",
      "<a href=\"v02-introduction\">next-no-ext</a>",
      "</body></html>"
    )
  )
  write_fixture_file(
    file.path(docs_root, "workflows", "v02-introduction.html"),
    c("<html><body>", "ok", "</body></html>")
  )

  extract_site_map(site_root = docs_root, output_dir = out_root, verbose = FALSE)
  edges <- read.csv(file.path(out_root, "website_link_edges.csv"), stringsAsFactors = FALSE)

  expect_true(any(edges$href_raw == "missing-page.html" & !as.logical(edges$target_exists)))
  expect_true(any(edges$href_raw == "../index.html#intro" & edges$target == "index.html"))
  expect_true(any(edges$href_raw == "v02-introduction" & edges$target == "workflows/v02-introduction.html"))
  expect_true(any(edges$href_raw == "workflows/" & edges$target == "workflows/index.html"))

  # External/anchor hrefs are intentionally ignored by extractor.
  expect_false(any(grepl("^https?://", edges$href_raw)))
  expect_false(any(grepl("^mailto:", edges$href_raw)))
  expect_false(any(grepl("^javascript:", edges$href_raw)))
  expect_false(any(grepl("^#", edges$href_raw)))
})

test_that("analyze_site_map gate follows broken-link and workflow-chain policy", {
  tmp_root <- tempfile("site_map_analyze_")
  docs_root <- file.path(tmp_root, "docs")
  out_root <- file.path(tmp_root, "out")
  dir.create(docs_root, recursive = TRUE, showWarnings = FALSE)

  write_fixture_file(
    file.path(docs_root, "index.html"),
    c(
      "<html><body>",
      "<a href=\"workflows/v01-topic.html\">start</a>",
      "</body></html>"
    )
  )
  make_workflow_pages(docs_root = docs_root, break_chain = FALSE)

  extract_site_map(site_root = docs_root, output_dir = out_root, verbose = FALSE)
  ok_result <- analyze_site_map(site_root = docs_root, output_dir = out_root, verbose = FALSE)

  expect_true(isTRUE(ok_result$summary$gate_pass))
  expect_equal(ok_result$summary$broken_link_count, 0)
  expect_equal(ok_result$summary$workflow_chain_break_count, 0)

  # Rebuild with a broken chain and a broken link.
  unlink(tmp_root, recursive = TRUE, force = TRUE)
  dir.create(docs_root, recursive = TRUE, showWarnings = FALSE)
  write_fixture_file(
    file.path(docs_root, "index.html"),
    c(
      "<html><body>",
      "<a href=\"workflows/v01-topic.html\">start</a>",
      "<a href=\"does-not-exist.html\">broken</a>",
      "</body></html>"
    )
  )
  make_workflow_pages(docs_root = docs_root, break_chain = TRUE)

  extract_site_map(site_root = docs_root, output_dir = out_root, verbose = FALSE)
  bad_result <- analyze_site_map(site_root = docs_root, output_dir = out_root, verbose = FALSE)

  expect_false(isTRUE(bad_result$summary$gate_pass))
  expect_gt(bad_result$summary$broken_link_count, 0)
  expect_gt(bad_result$summary$workflow_chain_break_count, 0)
})

# ===== END ci/test-site-map-tools.R =====

# ===== BEGIN ci/test-vignette-coverage.R =====
# test-vignette-coverage.R
# =============================================================================
# Tests that exercise code paths from vignettes for coverage
# These tests use short MCMC runs to be fast while still exercising the code
# =============================================================================

# Use package's test level system - these run at "ci" level and above
# They will run during coverage calculation (DPMIXGPD_TEST_LEVEL="ci")
# but skip during R CMD check (DPMIXGPD_TEST_LEVEL="cran")

# Short MCMC settings for fast execution
mcmc_short <- list(niter = 50, nburnin = 10, thin = 1, nchains = 1, seed = 1)

# Helper to suppress MCMC output
quiet_run <- function(expr) {

  nullfile <- if (.Platform$OS.type == "windows") "NUL" else "/dev/null"
  utils::capture.output(result <- force(expr), file = nullfile)
  result
}

# =============================================================================
# Unconditional Models (from v05-v09 vignettes)
# =============================================================================

test_that("unconditional CRP bulk model works (v05 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_pos200_k3", package = "CausalMixGPD")
  y <- nc_pos200_k3$y[1:50]  # Use subset for speed

  bundle <- build_nimble_bundle(
    y = y,
    backend = "crp",
    kernel = "gamma",
    GPD = FALSE,
    components = 3,
    monitor_latent = TRUE,
    mcmc = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_bundle")

  # Test print and summary
  expect_output(print(bundle))
  expect_output(print(summary(bundle)))

  # Run MCMC
  fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
  expect_s3_class(fit, "mixgpd_fit")

  # Test S3 methods
  expect_output(print(fit))
  summ <- summary(fit)
  expect_s3_class(summ, "mixgpd_summary")
  expect_output(print(summ))

  # Test params
  p <- params(fit)
  expect_s3_class(p, "mixgpd_params")
  expect_output(print(p))

  # Test predict methods
  pred_q <- predict(fit, type = "quantile", index = c(0.5, 0.9))
  expect_s3_class(pred_q, "mixgpd_predict")

  pred_d <- predict(fit, y = y[1:5], type = "density")
  expect_s3_class(pred_d, "mixgpd_predict")

  pred_s <- predict(fit, y = y[1:5], type = "survival")
  expect_s3_class(pred_s, "mixgpd_predict")
})

test_that("unconditional SB bulk model works (v07 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_pos200_k3", package = "CausalMixGPD")
  y <- nc_pos200_k3$y[1:50]

  bundle <- build_nimble_bundle(
    y = y,
    backend = "sb",
    kernel = "lognormal",
    GPD = FALSE,
    components = 3,
    mcmc = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_bundle")

  fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
  expect_s3_class(fit, "mixgpd_fit")
  # fitted() not supported for unconditional; use predict() only
})

test_that("unconditional SB GPD model works (v09 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_pos200_k3", package = "CausalMixGPD")
  y <- nc_pos200_k3$y[1:50]

  bundle <- build_nimble_bundle(
    y = y,
    backend = "sb",
    kernel = "gamma",
    GPD = TRUE,
    components = 3,
    mcmc = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_bundle")

  fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
  expect_s3_class(fit, "mixgpd_fit")
})

# =============================================================================
# Conditional Models (from v10-v13 vignettes)
# =============================================================================

test_that("conditional SB bulk model works (v11 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_posX100_p3_k2", package = "CausalMixGPD")
  y <- nc_posX100_p3_k2$y[1:40]
  X <- as.matrix(nc_posX100_p3_k2$X[1:40, ])

  bundle <- build_nimble_bundle(
    y = y,
    X = X,
    backend = "sb",
    kernel = "lognormal",
    GPD = FALSE,
    components = 3,
    mcmc = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_bundle")

  fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
  expect_s3_class(fit, "mixgpd_fit")

  # Test conditional predict
  x_new <- X[1:5, , drop = FALSE]
  pred_mean <- predict(fit, newdata =x_new, type = "mean", nsim_mean = 20)
  expect_s3_class(pred_mean, "mixgpd_predict")
})

test_that("conditional SB GPD model works (v13 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_posX100_p3_k2", package = "CausalMixGPD")
  y <- nc_posX100_p3_k2$y[1:40]
  X <- as.matrix(nc_posX100_p3_k2$X[1:40, ])

  bundle <- build_nimble_bundle(
    y = y,
    X = X,
    backend = "sb",
    kernel = "lognormal",
    GPD = TRUE,
    components = 3,
    mcmc = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_bundle")

  fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
  expect_s3_class(fit, "mixgpd_fit")
})

# =============================================================================
# Causal Models (from v14-v19 vignettes)
# =============================================================================

test_that("causal no-X CRP model works (v14 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("causal_alt_real500_p4_k2", package = "CausalMixGPD")
  y <- abs(causal_alt_real500_p4_k2$y[1:80]) + 0.01
  T_vec <- causal_alt_real500_p4_k2$A[1:80]

  bundle <- build_causal_bundle(
    y = y,
    A = T_vec,
    X = NULL,
    kernel = "gamma",
    backend = "crp",
    PS = FALSE,
    GPD = FALSE,
    components = 3,
    monitor_latent = TRUE,
    mcmc_outcome = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_causal_bundle")
  expect_output(print(bundle))
  expect_output(print(summary(bundle)))

  fit <- quiet_run(run_mcmc_causal(bundle, show_progress = FALSE))
  expect_s3_class(fit, "causalmixgpd_causal_fit")

  # Test causal S3 methods
  expect_output(print(fit))
  expect_output(print(summary(fit)))

  # Test causal params
  p <- params(fit)
  expect_s3_class(p, "mixgpd_params_pair")
  expect_output(print(p))

  # Test causal predict
  pred <- predict(fit, type = "mean", nsim_mean = 20)
  expect_s3_class(pred, "causalmixgpd_causal_predict")

  # Test QTE
  qte_result <- qte(fit, probs = c(0.5), interval = "credible")
  expect_s3_class(qte_result, "causalmixgpd_qte")
  expect_output(print(qte_result))
  summ_qte <- summary(qte_result)
  expect_output(print(summ_qte))

  # Test ATE
  ate_result <- ate(fit, interval = "credible", nsim_mean = 20)
  expect_s3_class(ate_result, "causalmixgpd_ate")
  expect_output(print(ate_result))
  summ_ate <- summary(ate_result)
  expect_output(print(summ_ate))
})

test_that("causal X no-PS SB model works (v15 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("causal_alt_real500_p4_k2", package = "CausalMixGPD")
  y <- abs(causal_alt_real500_p4_k2$y[1:80]) + 0.01
  T_vec <- causal_alt_real500_p4_k2$A[1:80]
  X <- as.matrix(causal_alt_real500_p4_k2$X[1:80, 1:2])

  bundle <- build_causal_bundle(
    y = y,
    A = T_vec,
    X = X,
    kernel = "lognormal",
    backend = "sb",
    PS = FALSE,
    GPD = FALSE,
    components = 3,
    mcmc_outcome = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_causal_bundle")

  fit <- quiet_run(run_mcmc_causal(bundle, show_progress = FALSE))
  expect_s3_class(fit, "causalmixgpd_causal_fit")

  # Test causal predict with multiple types
  pred_q <- predict(fit, type = "quantile", p = c(0.25, 0.75))
  expect_s3_class(pred_q, "causalmixgpd_causal_predict")

  pred_d <- predict(fit, newdata =X[1:5, , drop = FALSE], y = y[1:5], type = "density")
  expect_s3_class(pred_d, "causalmixgpd_causal_predict")

  pred_s <- predict(fit, newdata =X[1:5, , drop = FALSE], y = y[1:5], type = "survival")
  expect_s3_class(pred_s, "causalmixgpd_causal_predict")
})

test_that("causal no-X SB model works (v16 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("causal_alt_real500_p4_k2", package = "CausalMixGPD")
  y <- abs(causal_alt_real500_p4_k2$y[1:80]) + 0.01
  T_vec <- causal_alt_real500_p4_k2$A[1:80]

  bundle <- build_causal_bundle(
    y = y,
    A = T_vec,
    X = NULL,
    kernel = "lognormal",
    backend = "sb",
    PS = FALSE,
    GPD = FALSE,
    components = 3,
    mcmc_outcome = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_causal_bundle")

  fit <- quiet_run(run_mcmc_causal(bundle, show_progress = FALSE))
  expect_s3_class(fit, "causalmixgpd_causal_fit")

  # Test QTE with multiple quantiles
  qte_result <- qte(fit, probs = c(0.25, 0.5, 0.75), interval = "credible")
  expect_s3_class(qte_result, "causalmixgpd_qte")

  # Test plot methods for QTE (returns plot objects)
  qte_plots <- plot(qte_result)
  expect_type(qte_plots, "list")

  # Test ATE with HPD interval
  ate_result <- ate(fit, interval = "hpd", nsim_mean = 20)
  expect_s3_class(ate_result, "causalmixgpd_ate")

  # Test plot methods for ATE
  ate_plots <- plot(ate_result)
  expect_type(ate_plots, "list")
})

test_that("causal with GPD tails works (v17 coverage)", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("causal_alt_real500_p4_k2", package = "CausalMixGPD")
  y <- abs(causal_alt_real500_p4_k2$y[1:60]) + 0.01
  T_vec <- causal_alt_real500_p4_k2$A[1:60]

  bundle <- build_causal_bundle(
    y = y,
    A = T_vec,
    X = NULL,
    kernel = "gamma",
    backend = "sb",
    PS = FALSE,
    GPD = TRUE,
    components = 3,
    mcmc_outcome = mcmc_short
  )

  expect_s3_class(bundle, "causalmixgpd_causal_bundle")

  fit <- quiet_run(run_mcmc_causal(bundle, show_progress = FALSE))
  expect_s3_class(fit, "causalmixgpd_causal_fit")

  # Test predict with mean type (uses simulation fallback for gamma+GPD)
  pred_loc <- predict(fit, type = "mean", nsim_mean = 20L)
  expect_s3_class(pred_loc, "causalmixgpd_causal_predict")
})

test_that("causal fit plot method works", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("causal_alt_real500_p4_k2", package = "CausalMixGPD")
  y <- abs(causal_alt_real500_p4_k2$y[1:60]) + 0.01
  T_vec <- causal_alt_real500_p4_k2$A[1:60]

  bundle <- build_causal_bundle(
    y = y,
    A = T_vec,
    X = NULL,
    kernel = "gamma",
    backend = "crp",
    PS = FALSE,
    GPD = FALSE,
    components = 3,
    monitor_latent = TRUE,
    mcmc_outcome = mcmc_short
  )

  fit <- quiet_run(run_mcmc_causal(bundle, show_progress = FALSE))

  # Test plot method for causal fit
  fit_plots <- plot(fit, arm = "both")
  expect_type(fit_plots, "list")

  # Test plot for treatment arm only
  fit_plots_trt <- plot(fit, arm = "trt")
  expect_type(fit_plots_trt, "list")

  # Test plot for control arm only
  fit_plots_con <- plot(fit, arm = "con")
  expect_type(fit_plots_con, "list")
})

test_that("causal predict plot method works", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("causal_alt_real500_p4_k2", package = "CausalMixGPD")
  y <- abs(causal_alt_real500_p4_k2$y[1:60]) + 0.01
  T_vec <- causal_alt_real500_p4_k2$A[1:60]

  bundle <- build_causal_bundle(
    y = y,
    A = T_vec,
    X = NULL,
    kernel = "gamma",
    backend = "crp",
    PS = FALSE,
    GPD = FALSE,
    components = 3,
    monitor_latent = TRUE,
    mcmc_outcome = mcmc_short
  )

  fit <- quiet_run(run_mcmc_causal(bundle, show_progress = FALSE))

  # Test predict plot
  pred <- predict(fit, type = "quantile", p = 0.5)
  pred_plots <- plot(pred)
  expect_type(pred_plots, "list")
})

# =============================================================================
# Kernel Coverage (all 7 kernels)
# =============================================================================

test_that("all kernel types work with SB backend", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_pos200_k3", package = "CausalMixGPD")
  y_pos <- nc_pos200_k3$y[1:30]
  y_real <- y_pos - mean(y_pos)  # Center for real-support kernels

  # Positive support kernels
  for (kernel in c("gamma", "lognormal", "invgauss")) {
    bundle <- build_nimble_bundle(
      y = y_pos,
      backend = "sb",
      kernel = kernel,
      GPD = FALSE,
      components = 2,
      mcmc = list(niter = 30, nburnin = 5, thin = 1, nchains = 1, seed = 1)
    )
    expect_s3_class(bundle, "causalmixgpd_bundle")

    fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
    expect_s3_class(fit, "mixgpd_fit")
  }

  # Real support kernels
  for (kernel in c("normal", "laplace", "cauchy")) {
    bundle <- build_nimble_bundle(
      y = y_real,
      backend = "sb",
      kernel = kernel,
      GPD = FALSE,
      components = 2,
      mcmc = list(niter = 30, nburnin = 5, thin = 1, nchains = 1, seed = 1)
    )
    expect_s3_class(bundle, "causalmixgpd_bundle")

    fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
    expect_s3_class(fit, "mixgpd_fit")
  }
})

test_that("amoroso kernel works", {
  skip_if_not_test_level("ci")
  skip_if_not_installed("nimble")

  data("nc_pos200_k3", package = "CausalMixGPD")
  y <- nc_pos200_k3$y[1:30]

  bundle <- build_nimble_bundle(
    y = y,
    backend = "sb",
    kernel = "amoroso",
    GPD = FALSE,
    components = 2,
    mcmc = list(niter = 30, nburnin = 5, thin = 1, nchains = 1, seed = 1)
  )
  expect_s3_class(bundle, "causalmixgpd_bundle")

  fit <- quiet_run(run_mcmc_bundle_manual(bundle, show_progress = FALSE))
  expect_s3_class(fit, "mixgpd_fit")
})

# ===== END ci/test-vignette-coverage.R =====


