#' Fit a Stan model using cmdstanr
#' @keywords internal
fit_cmdstanr <- function(model_name, stan_data, chains, iter, warmup,
                         seed, adapt_delta, max_treedepth, refresh, ...) {

  if (!requireNamespace("cmdstanr", quietly = TRUE)) {
    stop("cmdstanr is required but not installed. Run mlumr_engine('cmdstanr') to set up.",
         call. = FALSE)
  }

  # Locate .stan file from installed package
  stan_file <- system.file("stan", paste0(model_name, ".stan"), package = "mlumr")
  if (stan_file == "") {
    # Development mode fallback
    stan_file <- file.path("inst", "stan", paste0(model_name, ".stan"))
  }
  if (!file.exists(stan_file)) {
    stop(sprintf("Cannot find Stan model file: %s.stan", model_name), call. = FALSE)
  }

  # Keep CmdStan executables out of inst/stan. cmdstanr's default executable
  # path is next to the .stan file, which pollutes the source tree in
  # development and installed package directories in some workflows.
  compile_dir <- .cmdstanr_compile_dir(model_name, stan_file)
  mod <- cmdstanr::cmdstan_model(stan_file, dir = compile_dir)

  # Sample (note arg name differences from rstan).
  # Default parallel_chains to mirror rstan's behavior (which uses mc.cores).
  # cmdstanr defaults parallel_chains = 1, so chains run serially unless we
  # set it explicitly. Cap at `chains` so we never request more workers than
  # chains. Honor any user override passed through `...`.
  dots <- list(...)
  if (!"parallel_chains" %in% names(dots)) {
    dots$parallel_chains <- min(chains,
                                max(1L, as.integer(getOption("mc.cores", 1L))))
  }

  sample_args <- c(
    list(
      data = stan_data,
      chains = chains,
      iter_sampling = iter - warmup,
      iter_warmup = warmup,
      seed = seed,
      adapt_delta = adapt_delta,
      max_treedepth = max_treedepth,
      refresh = refresh
    ),
    dots
  )
  fit <- do.call(mod$sample, sample_args)

  # Extract draws as plain data.frame (drop metadata columns)
  draws_df <- as.data.frame(fit$draws(format = "df"))
  meta_cols <- c(".chain", ".iteration", ".draw")
  draws_df <- draws_df[, !names(draws_df) %in% meta_cols, drop = FALSE]

  # Build summary matching rstan column names:
  # variable, mean, se_mean, sd, 2.5%, 25%, 50%, 75%, 97.5%, n_eff, Rhat
  if (requireNamespace("posterior", quietly = TRUE)) {
    cmdstan_summ <- fit$summary(
      variables = NULL,
      mean = mean,
      se_mean = function(.x) stats::sd(.x) / sqrt(posterior::ess_bulk(.x)),
      sd = stats::sd,
      `2.5%` = function(.x) stats::quantile(.x, 0.025),
      `25%` = function(.x) stats::quantile(.x, 0.25),
      `50%` = function(.x) stats::quantile(.x, 0.50),
      `75%` = function(.x) stats::quantile(.x, 0.75),
      `97.5%` = function(.x) stats::quantile(.x, 0.975),
      n_eff = posterior::ess_bulk,
      Rhat = posterior::rhat
    )
    summary_df <- as.data.frame(cmdstan_summ)
  } else {
    # Fallback when posterior is not installed: basic summary with NA for
    # ESS and Rhat. We deliberately do NOT impute n_eff with the total
    # draw count (or any other plug-in) because that would silently report
    # wildly optimistic sample sizes and mask autocorrelation. Installing
    # 'posterior' is required for valid convergence diagnostics.
    warning(
      "posterior package not installed. ESS (n_eff) and Rhat will be NA. ",
      "Install with: install.packages('posterior') for valid diagnostics.",
      call. = FALSE
    )
    var_names <- colnames(draws_df)
    summary_df <- data.frame(
      variable = var_names,
      mean = vapply(draws_df, mean, numeric(1)),
      se_mean = rep(NA_real_, length(var_names)),
      sd = vapply(draws_df, stats::sd, numeric(1)),
      `2.5%` = vapply(draws_df, function(.x) stats::quantile(.x, 0.025), numeric(1)),
      `25%` = vapply(draws_df, function(.x) stats::quantile(.x, 0.25), numeric(1)),
      `50%` = vapply(draws_df, function(.x) stats::quantile(.x, 0.50), numeric(1)),
      `75%` = vapply(draws_df, function(.x) stats::quantile(.x, 0.75), numeric(1)),
      `97.5%` = vapply(draws_df, function(.x) stats::quantile(.x, 0.975), numeric(1)),
      n_eff = rep(NA_real_, length(var_names)),
      Rhat = rep(NA_real_, length(var_names)),
      check.names = FALSE, stringsAsFactors = FALSE
    )
  }

  # Diagnostics
  diag <- fit$diagnostic_summary(quiet = TRUE)
  n_divergent <- sum(diag$num_divergent)
  n_max_td <- sum(diag$num_max_treedepth)

  list(
    native_fit = fit,
    draws = draws_df,
    summary_df = summary_df,
    n_divergent = n_divergent,
    n_max_td = n_max_td
  )
}


#' Cache directory for cmdstanr-compiled model executables
#' @keywords internal
.cmdstanr_compile_dir <- function(model_name, stan_file) {
  stan_dir <- dirname(stan_file)
  include_dir <- file.path(stan_dir, "include")
  include_files <- if (dir.exists(include_dir)) {
    sort(list.files(include_dir, pattern = "[.]stan$", full.names = TRUE))
  } else {
    character()
  }

  source_files <- c(stan_file, include_files)
  source_hash <- paste(unname(tools::md5sum(source_files)), collapse = "")
  cache_key <- substr(source_hash, 1L, 32L)
  cache_dir <- file.path(.cmdstanr_cache_root(), paste0(model_name, "-", cache_key))

  if (!dir.exists(cache_dir)) {
    dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE)
  }
  if (!dir.exists(cache_dir) || file.access(cache_dir, mode = 2L) != 0L) {
    stop("Could not create a writable cmdstanr cache directory.", call. = FALSE)
  }
  cache_dir
}


#' Resolve a writable cmdstanr cache root
#' @keywords internal
.cmdstanr_cache_root <- function() {
  candidates <- c(
    file.path(tools::R_user_dir("mlumr", "cache"), "cmdstanr"),
    file.path(tempdir(), "mlumr", "cmdstanr")
  )

  selected <- NULL
  for (cache_root in candidates) {
    if (!dir.exists(cache_root)) {
      dir.create(cache_root, recursive = TRUE, showWarnings = FALSE)
    }
    if (dir.exists(cache_root) && file.access(cache_root, mode = 2L) == 0L) {
      selected <- cache_root
      break
    }
  }

  if (!is.null(selected)) {
    selected
  } else {
    stop("Could not create a writable cmdstanr cache root.", call. = FALSE)
  }
}
