tests/testthat/test-session-hub.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    expect_equal,
    expect_false,
    expect_length,
    expect_null,
    expect_true,
    test_that
  ]
)

box::use(
  artma / interactive / hub[
    adjustable_option_defs,
    describe_option_state,
    help_menu_items,
    hub_menu_items,
    merge_run_results,
    option_affects_data,
    run_adjust_options,
    run_session_hub,
    settings_menu_items
  ],
  artma / interactive / menu[compose_menu_choices],
  artma / interactive / preview[count_studies]
)

# The options file a bound hub session runs on; the tests never touch it, it
# only keeps the session out of the unbound state.
SESSION_FILE <- "session.yaml"


# A prepared frame small enough to summarize in tests.
hub_df <- function() {
  data.frame(
    study_id = c("s1", "s1", "s2"),
    effect = c(0.5, 0.3, 0.7),
    se = c(0.1, 0.15, 0.12),
    stringsAsFactors = FALSE
  )
}

# The columns of a build_methods_table(available_for = ...) frame the picker
# and the Help submenu's methods overview read.
hub_methods_frame <- function() {
  data.frame(
    method = c("bma", "funnel_plot"),
    description = c("Bayesian model averaging", "Funnel plot"),
    required_columns = c("effect, se", "effect, se"),
    depends_on = c("", ""),
    suggests = c("BMS", ""),
    missing_packages = c("", ""),
    opt_in = c(FALSE, FALSE),
    missing_columns = c("", ""),
    stringsAsFactors = FALSE
  )
}

# Sequenced single-select backend: each call consumes the next entry of the
# script and returns the value of the first label containing it; NA cancels
# the menu.
make_select_fn <- function(script) {
  index <- 0L
  function(choices, prompt, selected = NULL, descriptions = NULL) {
    index <<- index + 1L
    stopifnot(index <= length(script))
    pattern <- script[[index]]
    if (is.na(pattern)) {
      return(character(0))
    }
    labels <- names(choices) %||% choices
    matches <- unname(choices[grepl(pattern, labels, fixed = TRUE)])
    stopifnot(length(matches) >= 1L)
    matches[[1]]
  }
}

# Checkbox backend selecting methods by name (the values of the picker are the
# method names); counts its invocations and records each call's `selected`
# argument so tests can assert the picker was not reopened and whether it was
# preselected.
make_checkbox_fn <- function(methods, counter = new.env()) {
  counter$calls <- 0L
  counter$selected <- list()
  fn <- function(choices, prompt, selected, allow_select_all, descriptions = NULL) {
    counter$calls <- counter$calls + 1L
    counter$selected <- c(counter$selected, list(selected))
    unname(choices[choices %in% methods])
  }
  list(fn = fn, counter = counter)
}

# Stubbed run pipeline: records the selections it was handed and returns one
# "<method>-result" per method with the run_info attribute execute_run() sets.
make_run_methods <- function(log = new.env()) {
  log$calls <- list()
  fn <- function(methods) {
    log$calls <- c(log$calls, list(methods))
    results <- stats::setNames(
      lapply(methods, function(m) paste0(m, "-result")),
      methods
    )
    attr(results, "run_info") <- list(
      methods_requested = methods,
      seed = 42L,
      output_files = list()
    )
    results
  }
  list(fn = fn, log = log)
}

abort_if_called <- function(what) {
  function(...) stop(what, " must not be called")
}

# An options_list(details = TRUE) frame for the options-file picker.
hub_details <- function(files = c("a.yaml", "b.yaml")) {
  data.frame(
    file = files,
    data_source_path = paste0("/data/", tools::file_path_sans_ext(files), ".csv"),
    modified = as.POSIXct(rep("2026-08-01 10:00:00", length(files))),
    last_run = as.POSIXct(rep(NA_character_, length(files))),
    n_non_default = rep(0L, length(files)),
    stringsAsFactors = FALSE
  )
}

# File-management actions for the options-file menu: only the listing is real,
# and every management action fails loudly if a test reaches one it did not
# override.
test_file_actions <- function(list_files = NULL, overrides = list()) {
  defaults <- list(
    list = list_files %||% function() hub_details(),
    create = abort_if_called("create"),
    duplicate = abort_if_called("duplicate"),
    edit = abort_if_called("edit"),
    repair = abort_if_called("repair"),
    compare = abort_if_called("compare"),
    open = abort_if_called("open"),
    delete = abort_if_called("delete")
  )
  utils::modifyList(defaults, overrides)
}

test_that("exit before any run returns an empty result list cleanly", {
  withr::local_options(list(artma.temp.last_methods = NULL))

  returned <- withVisible(suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = abort_if_called("run_methods"),
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn("Exit"),
    checkbox_fn = abort_if_called("checkbox_fn"),
    width = 100
  )))

  expect_false(returned$visible)
  expect_equal(unclass(returned$value), list(), ignore_attr = TRUE)
  expect_equal(attr(returned$value, "runs"), list())
})

test_that("a cancelled menu behaves like Exit", {
  withr::local_options(list(artma.temp.last_methods = NULL))

  results <- suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = abort_if_called("run_methods"),
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn(NA_character_),
    checkbox_fn = abort_if_called("checkbox_fn"),
    width = 100
  ))

  expect_length(results, 0L)
  expect_equal(attr(results, "runs"), list())
})

test_that("run then exit returns the results with the runs attribute", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  checkbox <- make_checkbox_fn("bma")
  run <- make_run_methods()

  results <- suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = run$fn,
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn(c("Run methods", "Exit")),
    checkbox_fn = checkbox$fn,
    width = 100
  ))

  expect_equal(results$bma, "bma-result")
  expect_equal(run$log$calls, list("bma"))

  runs <- attr(results, "runs")
  expect_length(runs, 1L)
  expect_equal(runs[[1]]$methods, "bma")
  expect_equal(runs[[1]]$seed, 42L)
  expect_true(inherits(runs[[1]]$timestamp, "POSIXct"))

  # Mirrored into the option the linear path (R/artma.R) defaults from, but
  # not fed back into this hub's own checkbox default.
  expect_equal(getOption("artma.temp.last_methods"), "bma")
})

test_that("a second Run methods pick opens the checkbox with nothing preselected", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  checkbox <- make_checkbox_fn("bma")
  run <- make_run_methods()

  suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = run$fn,
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn(c("Run methods", "Run methods", "Exit")),
    checkbox_fn = checkbox$fn,
    width = 100
  ))

  expect_equal(checkbox$counter$calls, 2L)
  expect_null(checkbox$counter$selected[[1]])
  expect_null(checkbox$counter$selected[[2]])
})

test_that("re-run reuses the last selection without reopening the picker", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  checkbox <- make_checkbox_fn(c("bma", "funnel_plot"))
  run <- make_run_methods()

  results <- suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = run$fn,
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn(c("Run methods", "Re-run last selection", "Exit")),
    checkbox_fn = checkbox$fn,
    width = 100
  ))

  expect_equal(checkbox$counter$calls, 1L)
  expect_equal(run$log$calls, list(c("bma", "funnel_plot"), c("bma", "funnel_plot")))
  expect_length(attr(results, "runs"), 2L)
})

test_that("a failing run keeps the hub alive and the results empty", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  checkbox <- make_checkbox_fn("bma")

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = hub_df(),
      options_file = SESSION_FILE,
      run_methods = function(methods) stop("boom"),
      methods_table = hub_methods_frame(),
      select_fn = make_select_fn(c("Run methods", "Exit")),
      checkbox_fn = checkbox$fn,
      width = 100
    )
  )

  expect_length(results, 0L)
  expect_equal(attr(results, "runs"), list())
  expect_true(any(grepl("The run failed", messages)))
})

test_that("an empty picker confirmation returns to the menu without running", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  checkbox <- make_checkbox_fn(character(0))

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = hub_df(),
      options_file = SESSION_FILE,
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      select_fn = make_select_fn(c("Run methods", "Exit")),
      checkbox_fn = checkbox$fn,
      width = 100
    )
  )

  expect_length(results, 0L)
  expect_true(any(grepl("No methods selected", messages)))
})

test_that("the results submenu is a friendly no-op before the first run", {
  withr::local_options(list(artma.temp.last_methods = NULL))

  messages <- testthat::capture_messages(
    run_session_hub(
      df = hub_df(),
      options_file = SESSION_FILE,
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      open_results = abort_if_called("open_results"),
      render_report = abort_if_called("render_report"),
      select_fn = make_select_fn(c("Results", "Open results folder", "Exit")),
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  expect_true(any(grepl("run methods first", messages)))
})

test_that("the results submenu dispatches to the injected handlers after a run", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  checkbox <- make_checkbox_fn("bma")
  run <- make_run_methods()
  opened <- FALSE
  reported <- NULL

  suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = run$fn,
    methods_table = hub_methods_frame(),
    open_results = function() opened <<- TRUE,
    render_report = function(results) reported <<- results,
    select_fn = make_select_fn(c(
      "Run methods",
      "Results", "Open results folder",
      "Results", "Render HTML report",
      "Exit"
    )),
    checkbox_fn = checkbox$fn,
    width = 100
  ))

  expect_true(opened)
  expect_equal(reported$bma, "bma-result")
})

test_that("preview opens on the overview and returns through Back", {
  withr::local_options(list(artma.temp.last_methods = NULL))

  messages <- testthat::capture_messages(
    run_session_hub(
      df = hub_df(),
      options_file = SESSION_FILE,
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      view_data = abort_if_called("view_data"),
      select_fn = make_select_fn(c("Preview data", "Back", "Exit")),
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  expect_true(any(grepl("3 rows, 3 columns", messages)))
  expect_true(any(grepl("2 studies", messages)))
  expect_true(any(grepl("Effect range", messages)))
  expect_true(any(grepl("SE range", messages)))
})

test_that("merge_run_results keeps the latest result and status per method", {
  accumulated <- list(bma = "old-bma", funnel_plot = "fp")
  attr(accumulated, "failed_methods") <- c(pub_bias = "boom")
  attr(accumulated, "skipped_methods") <- c(robma = "missing RoBMA")

  results <- list(bma = "new-bma", pub_bias = "pb-ok")
  attr(results, "run_info") <- list(
    methods_requested = c("bma", "pub_bias", "robma"),
    seed = 7L
  )
  attr(results, "skipped_methods") <- c(robma = "still missing")

  merged <- merge_run_results(accumulated, results)

  expect_equal(merged$bma, "new-bma")
  expect_equal(merged$funnel_plot, "fp")
  expect_equal(merged$pub_bias, "pb-ok")
  # pub_bias was re-requested and succeeded, so its old failure is dropped.
  expect_null(attr(merged, "failed_methods"))
  expect_equal(attr(merged, "skipped_methods"), c(robma = "still missing"))
  expect_equal(attr(merged, "run_info")$seed, 7L)
})

# The item values of a hub menu, in display order.
menu_values <- function(...) {
  vapply(hub_menu_items(...), function(item) item$value, character(1))
}

test_that("hub_menu_items hides Re-run until a run happened", {
  before <- menu_values(FALSE, character(0), options_file = SESSION_FILE)
  expect_false("rerun" %in% before)

  after_items <- hub_menu_items(TRUE, c("bma", "funnel_plot"), options_file = SESSION_FILE)
  after <- vapply(after_items, function(item) item$value, character(1))
  expect_true("rerun" %in% after)
  rerun <- after_items[[which(after == "rerun")]]
  expect_equal(rerun$description, "bma, funnel_plot")
})

test_that("hub_menu_items hides the options-file item without a handler", {
  with_file <- menu_values(FALSE, character(0), options_file = SESSION_FILE)
  expect_true(all(c("settings", "file", "help") %in% with_file))

  without_file <- menu_values(
    FALSE, character(0),
    can_switch = FALSE, options_file = SESSION_FILE
  )
  expect_false("file" %in% without_file)
  expect_true(all(c("settings", "help") %in% without_file))
})

test_that("an unbound session is offered only the items that need no data", {
  unbound <- menu_values(FALSE, character(0), options_file = NULL)

  expect_equal(unbound, c("file", "settings", "help", "exit"))
  # The one thing the session is missing leads the menu, so the cursor opens
  # on it.
  expect_equal(unbound[[1]], "file")

  bound <- hub_menu_items(FALSE, character(0), options_file = SESSION_FILE)
  file_item <- bound[[which(vapply(bound, function(i) i$value, character(1)) == "file")]]
  expect_true(grepl(SESSION_FILE, file_item$description, fixed = TRUE))
})

test_that("the unbound options-file item wording follows the file count", {
  # A first-timer is invited to get started by creating the file.
  none <- hub_menu_items(FALSE, character(0), options_file = NULL, n_options_files = 0L)
  expect_equal(none[[1]]$value, "file")
  expect_equal(none[[1]]$name, "Get started")
  expect_true(grepl("create your options file", none[[1]]$description, fixed = TRUE))

  # With files on disk, the same item is about choosing one.
  some <- hub_menu_items(FALSE, character(0), options_file = NULL, n_options_files = 2L)
  expect_equal(some[[1]]$value, "file")
  expect_equal(some[[1]]$name, "Choose options file")
  expect_equal(some[[1]]$description, "select one to work with, or create a new one")

  # A bound session keeps the item exactly as before, whatever the count.
  bound <- hub_menu_items(
    FALSE, character(0),
    options_file = SESSION_FILE, n_options_files = 0L
  )
  values <- vapply(bound, function(i) i$value, character(1))
  file_item <- bound[[which(values == "file")]]
  expect_equal(file_item$name, "Options file")
  expect_true(grepl(SESSION_FILE, file_item$description, fixed = TRUE))
})

test_that("an unbound session with no handler can only leave", {
  expect_equal(
    menu_values(FALSE, character(0), can_switch = FALSE, options_file = NULL),
    c("settings", "help", "exit")
  )
})

test_that("compose_menu_choices is value-keyed with plain labels and descriptions", {
  composed <- compose_menu_choices(
    hub_menu_items(FALSE, character(0), options_file = SESSION_FILE)
  )

  expect_equal(
    unname(composed$choices),
    c("run", "options", "preview", "results", "settings", "file", "help", "exit")
  )
  expect_equal(names(composed$choices)[[1]], "Run methods")
  expect_true(grepl("^pick and run", composed$descriptions[[1]]))
  # The backend renders and echoes these; they must reach it unstyled.
  rendered <- c(names(composed$choices), composed$descriptions)
  expect_false(any(grepl("\033", rendered, fixed = TRUE)))
})

test_that("the Re-run description names the options changed since the run", {
  items <- hub_menu_items(
    TRUE, "bma",
    options_changed = c("data.na_handling", "general.seed"),
    options_file = SESSION_FILE
  )
  values <- vapply(items, function(item) item$value, character(1))
  rerun <- items[[which(values == "rerun")]]
  expect_equal(rerun$description, "bma (changed: data.na_handling, general.seed)")
})

test_that("the settings and help submenus are value-keyed", {
  settings <- vapply(settings_menu_items(), function(item) item$value, character(1))
  expect_equal(settings, c("theme", "verbosity", "autonomy", "cache", "back"))

  help <- vapply(help_menu_items(), function(item) item$value, character(1))
  expect_equal(help, c(
    "methods", "options", "vignette_getting_started",
    "vignette_options_files", "website", "back"
  ))
})

test_that("settings toggles take effect for the session", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.verbose = 3,
    artma.cache.use_cache = TRUE
  ))
  themes_set <- character(0)
  autonomy_levels_set <- character(0)

  suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = abort_if_called("run_methods"),
    methods_table = hub_methods_frame(),
    set_theme = function(theme) themes_set <<- c(themes_set, theme),
    set_autonomy = function(level) autonomy_levels_set <<- c(autonomy_levels_set, level),
    select_fn = make_select_fn(c(
      "Settings", "Visualization theme", "red",
      "Settings", "Verbosity", "4 - debug",
      "Settings", "Autonomy level", "balanced",
      "Settings", "Result caching", "No",
      "Exit"
    )),
    checkbox_fn = abort_if_called("checkbox_fn"),
    width = 100
  ))

  expect_equal(themes_set, "red")
  expect_equal(autonomy_levels_set, "balanced")
  expect_equal(getOption("artma.verbose"), 4L)
  expect_false(getOption("artma.cache.use_cache"))
})

test_that("a cancelled settings submenu returns to the hub without changes", {
  withr::local_options(list(artma.temp.last_methods = NULL, artma.verbose = 3))

  suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = abort_if_called("run_methods"),
    methods_table = hub_methods_frame(),
    set_theme = abort_if_called("set_theme"),
    set_autonomy = abort_if_called("set_autonomy"),
    select_fn = make_select_fn(c("Settings", NA_character_, "Exit")),
    checkbox_fn = abort_if_called("checkbox_fn"),
    width = 100
  ))

  expect_equal(getOption("artma.verbose"), 3)
})

test_that("the help submenu prints overviews and opens the docs links", {
  withr::local_options(list(artma.temp.last_methods = NULL))
  urls <- character(0)
  options_help_calls <- 0L

  messages <- testthat::capture_messages(
    run_session_hub(
      df = hub_df(),
      options_file = SESSION_FILE,
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      show_options_help = function() options_help_calls <<- options_help_calls + 1L,
      open_url = function(url, description) urls <<- c(urls, url),
      select_fn = make_select_fn(c(
        "Help", "Methods overview",
        "Help", "Options overview",
        "Help", "Getting Started vignette",
        "Help", "Package website",
        "Exit"
      )),
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  # The methods overview prints the injected frame's rows.
  expect_true(any(grepl("Bayesian model averaging", messages)))
  expect_equal(options_help_calls, 1L)
  expect_length(urls, 2L)
  expect_true(grepl("getting-started", urls[[1]], fixed = TRUE))
  expect_false(grepl("getting-started", urls[[2]], fixed = TRUE))
})

test_that("switching the options file reloads options and re-prepares data", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = "a.yaml",
    artma.temp.dir_name = NULL,
    artma.general.name = NULL,
    artma.data.source_path = NULL,
    artma.data.columns = NULL,
    artma.methods.bma.iter = NULL,
    artma.methods.bma.burn = NULL,
    artma.methods.linear_tests.conf_level = NULL
  ))

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")
  yaml::write_yaml(
    list(
      general = list(name = list(type = "character", default = "Default Config", help = "Name")),
      data = list(
        source_path = list(type = "character", help = "Path to the data file"),
        columns = list(type = "list", default = list(), help = "The unified column store")
      ),
      methods = list(
        bma = list(
          iter = list(type = "integer", default = 100L, help = "Iterations"),
          burn = list(type = "integer", default = 10L, help = "Burn-in")
        ),
        linear_tests = list(
          conf_level = list(type = "numeric", default = 0.95, help = "Confidence level")
        )
      )
    ),
    template_path
  )
  yaml::write_yaml(
    list(general = list(name = "A"), data = list(source_path = "/data/a.csv", columns = list())),
    file.path(tmp_dir, "a.yaml")
  )
  yaml::write_yaml(
    list(
      general = list(name = "B"),
      data = list(source_path = "/data/b.csv", columns = list()),
      methods = list(bma = list(iter = 500L))
    ),
    file.path(tmp_dir, "b.yaml")
  )

  # The re-prepared frame differs from the initial one, so the header proves
  # which frame the hub holds.
  fresh_df <- data.frame(
    study_id = c("s9", "s9"),
    effect = c(1.5, 1.6),
    se = c(0.2, 0.3),
    stringsAsFactors = FALSE
  )

  seen_iters <- integer(0)
  run_methods <- function(methods) {
    seen_iters <<- c(seen_iters, getOption("artma.methods.bma.iter"))
    results <- stats::setNames(
      lapply(methods, function(m) paste0(m, "-result")),
      methods
    )
    attr(results, "run_info") <- list(
      methods_requested = methods,
      seed = 1L,
      output_files = list()
    )
    results
  }
  checkbox <- make_checkbox_fn("bma")

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = hub_df(),
      options_file = "a.yaml",
      run_methods = run_methods,
      methods_table = hub_methods_frame(),
      rebuild_data = function(methods) fresh_df,
      file_actions = test_file_actions(list_files = function() {
        artma::options_list(options_dir = tmp_dir, details = TRUE, template_path = template_path)
      }),
      bind_options = function(file_name) {
        loaded <- artma::options_load(
          options_file_name = file_name,
          options_dir = tmp_dir,
          template_path = template_path,
          should_validate = TRUE,
          should_add_temp_options = TRUE
        )
        # Base options(), matching the artma() wiring: the values must
        # survive this call for the rest of the hub session.
        options(loaded)
        invisible(TRUE)
      },
      select_fn = make_select_fn(c(
        "Options file", "Switch file", "b.yaml",
        "Run methods",
        "Exit"
      )),
      checkbox_fn = checkbox$fn,
      width = 100
    )
  )

  # The run after the switch saw the new file's options.
  expect_equal(seen_iters, 500L)
  expect_equal(results$bma, "bma-result")
  # The session now runs on the new file and the freshly prepared frame.
  expect_equal(getOption("artma.temp.file_name"), "b.yaml")
  expect_equal(getOption("artma.general.name"), "B")
  expect_true(any(grepl("Now running on", messages)))
  expect_true(any(grepl("2 rows", messages)))
})

test_that("a failed options switch keeps the session on the current file", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = "a.yaml"
  ))

  messages <- testthat::capture_messages(
    run_session_hub(
      df = hub_df(),
      options_file = "a.yaml",
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      rebuild_data = abort_if_called("rebuild_data"),
      file_actions = test_file_actions(),
      bind_options = function(file_name) stop("no such file"),
      select_fn = make_select_fn(c(
        "Options file", "Switch file", "b.yaml", "Back",
        "Preview data", "Back",
        "Exit"
      )),
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  expect_true(any(grepl("Could not load", messages)))
  expect_equal(getOption("artma.temp.file_name"), "a.yaml")
  # The original frame is still the session's data.
  expect_true(any(grepl("3 rows, 3 columns", messages)))
})

test_that("an unbound session prepares its data once a file is loaded", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = NULL
  ))
  prepared <- data.frame(
    study_id = c("s1", "s2"),
    effect = c(0.4, 0.6),
    se = c(0.1, 0.2),
    stringsAsFactors = FALSE
  )
  bound <- character(0)
  run <- make_run_methods()
  checkbox <- make_checkbox_fn("bma")

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = NULL,
      options_file = NULL,
      run_methods = run$fn,
      methods_table = hub_methods_frame(),
      rebuild_data = function(methods) prepared,
      file_actions = test_file_actions(),
      bind_options = function(file_name) bound <<- c(bound, file_name),
      # Backing out of the entry picker lands in the unbound menu, whose
      # options-file item still binds a file the long way round.
      select_fn = make_select_fn(c(
        "Back",
        "Choose options file", "Select a file", "b.yaml",
        "Run methods",
        "Exit"
      )),
      checkbox_fn = checkbox$fn,
      width = 100
    )
  )

  expect_equal(bound, "b.yaml")
  expect_equal(run$log$calls, list("bma"))
  expect_equal(results$bma, "bma-result")
  # The header knows what the session is missing, then what it holds.
  expect_true(any(grepl("no options file loaded", messages)))
  expect_true(any(grepl("2 rows, 2 studies", messages)))
})

test_that("the files-exist entry opens the picker before the first menu", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = NULL
  ))
  prepared <- data.frame(
    study_id = c("s1", "s2"),
    effect = c(0.4, 0.6),
    se = c(0.1, 0.2),
    stringsAsFactors = FALSE
  )
  bound <- character(0)
  run <- make_run_methods()
  checkbox <- make_checkbox_fn("bma")

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = NULL,
      options_file = NULL,
      run_methods = run$fn,
      methods_table = hub_methods_frame(),
      rebuild_data = function(methods) prepared,
      file_actions = test_file_actions(),
      bind_options = function(file_name) bound <<- c(bound, file_name),
      # The first selection is already the entry picker's: no menu pass
      # happens before it.
      select_fn = make_select_fn(c("b.yaml", "Run methods", "Exit")),
      checkbox_fn = checkbox$fn,
      width = 100
    )
  )

  expect_equal(bound, "b.yaml")
  expect_equal(results$bma, "bma-result")
  # The session never rendered the unbound header: it entered bound.
  expect_false(any(grepl("no options file loaded", messages)))
  expect_true(any(grepl("2 rows, 2 studies", messages)))
})

test_that("a first-timer is guided straight into creating an options file", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = NULL
  ))
  prepared <- data.frame(
    study_id = c("s1", "s2"),
    effect = c(0.4, 0.6),
    se = c(0.1, 0.2),
    stringsAsFactors = FALSE
  )
  bound <- character(0)
  run <- make_run_methods()
  checkbox <- make_checkbox_fn("bma")

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = NULL,
      options_file = NULL,
      run_methods = run$fn,
      methods_table = hub_methods_frame(),
      rebuild_data = function(methods) prepared,
      file_actions = test_file_actions(
        list_files = function() hub_details(character(0)),
        overrides = list(create = function() "fresh.yaml")
      ),
      bind_options = function(file_name) bound <<- c(bound, file_name),
      # No menu, no picker: the create flow runs, the file binds, and the
      # first selection is already the bound menu's.
      select_fn = make_select_fn(c("Run methods", "Exit")),
      checkbox_fn = checkbox$fn,
      width = 100
    )
  )

  expect_equal(bound, "fresh.yaml")
  expect_equal(results$bma, "bma-result")
  expect_true(any(grepl("No options files exist yet", messages)))
  expect_false(any(grepl("no options file loaded", messages)))
  expect_true(any(grepl("fresh.yaml", messages)))
})

test_that("a cancelled first-time create lands in the unbound menu", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = NULL
  ))
  captured <- new.env()
  captured$labels <- list()
  base_fn <- make_select_fn("Exit")
  capturing_select_fn <- function(choices, prompt, selected = NULL, descriptions = NULL) {
    captured$labels <- c(captured$labels, list(names(choices) %||% choices))
    base_fn(choices, prompt, selected)
  }

  messages <- testthat::capture_messages(
    results <- run_session_hub(
      df = NULL,
      options_file = NULL,
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      rebuild_data = abort_if_called("rebuild_data"),
      file_actions = test_file_actions(
        list_files = function() hub_details(character(0)),
        overrides = list(create = function() NULL)
      ),
      bind_options = abort_if_called("bind_options"),
      select_fn = capturing_select_fn,
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  expect_length(results, 0L)
  expect_true(any(grepl("no options file loaded", messages)))
  # The fallback menu invites the first-timer to try again.
  expect_true(any(grepl("Get started", captured$labels[[1]])))
})

test_that("a file whose data will not prepare keeps the session on it", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = NULL
  ))
  attempts <- 0L

  messages <- testthat::capture_messages(
    run_session_hub(
      df = NULL,
      options_file = NULL,
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      rebuild_data = function(methods) {
        attempts <<- attempts + 1L
        stop("the data source is unreadable")
      },
      file_actions = test_file_actions(),
      bind_options = function(file_name) invisible(TRUE),
      # The entry picker binds the file; its data preparation fails right
      # away, and again when Preview data asks for the frame.
      select_fn = make_select_fn(c(
        "b.yaml",
        "Preview data",
        "Exit"
      )),
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  # Once when the file was loaded, once when Preview data asked for the frame
  # again: a failed preparation returns to the menu instead of ending the
  # session, and the menu it returns to is the loaded file's.
  expect_equal(attempts, 2L)
  expect_equal(sum(grepl("Preparing the data failed", messages)), 2L)
  expect_true(any(grepl("data not prepared yet", messages)))
})

test_that("deleting the session's options file unbinds the session", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = "a.yaml"
  ))
  remaining <- c("a.yaml", "b.yaml")

  messages <- testthat::capture_messages(
    run_session_hub(
      df = hub_df(),
      options_file = "a.yaml",
      run_methods = abort_if_called("run_methods"),
      methods_table = hub_methods_frame(),
      rebuild_data = abort_if_called("rebuild_data"),
      file_actions = test_file_actions(
        list_files = function() hub_details(remaining),
        overrides = list(delete = function() remaining <<- "b.yaml")
      ),
      bind_options = function(file_name) invisible(TRUE),
      select_fn = make_select_fn(c("Options file", "Delete files", "Exit")),
      checkbox_fn = abort_if_called("checkbox_fn"),
      width = 100
    )
  )

  # Nothing may keep deriving paths from a file that no longer exists, and the
  # session falls back to the menu an unbound session gets.
  expect_null(getOption("artma.temp.file_name"))
  expect_true(any(grepl("no options file loaded", messages)))
})

test_that("an unbound session cannot run or preview anything", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.temp.file_name = NULL
  ))

  results <- suppressMessages(run_session_hub(
    df = NULL,
    options_file = NULL,
    run_methods = abort_if_called("run_methods"),
    rebuild_data = abort_if_called("rebuild_data"),
    methods_table = hub_methods_frame(),
    file_actions = test_file_actions(),
    bind_options = function(file_name) invisible(TRUE),
    # Back out of the entry picker first; "Run methods" and "Preview data"
    # are then not on the menu at all, so the scripted backend would fail to
    # match them.
    select_fn = make_select_fn(c("Back", "Exit")),
    checkbox_fn = abort_if_called("checkbox_fn"),
    width = 100
  ))

  expect_length(results, 0L)
})

test_that("count_studies is NA without the study column", {
  expect_equal(count_studies(hub_df()), 2L)
  expect_true(is.na(count_studies(data.frame(x = 1:3))))
})

test_that("adjustable_option_defs lists the curated knobs, then method groups", {
  curated <- c(
    "data.winsorization_level",
    "data.na_handling",
    "calc.precision_type",
    "general.seed",
    "output.number_of_decimals",
    "output.report"
  )

  expect_equal(names(adjustable_option_defs(character(0))), curated)

  with_method <- names(adjustable_option_defs("linear_tests"))
  expect_equal(with_method[seq_along(curated)], curated)
  expect_true("methods.linear_tests.bootstrap_replications" %in% with_method)
  expect_true(all(startsWith(setdiff(with_method, curated), "methods.linear_tests.")))

  # A method without template options contributes nothing.
  expect_equal(names(adjustable_option_defs("no_such_method")), curated)
})

test_that("describe_option_state shows the current value and default deviation", {
  defs <- adjustable_option_defs(character(0))

  withr::local_options(list(
    artma.data.winsorization_level = 0.05,
    artma.output.number_of_decimals = 3,
    artma.output.report = NULL
  ))

  expect_equal(
    describe_option_state(defs[["data.winsorization_level"]]),
    "current: 0.05 (default: 0.01)"
  )
  expect_equal(
    describe_option_state(defs[["output.number_of_decimals"]]),
    "current: 3 (default)"
  )
  expect_equal(
    describe_option_state(defs[["output.report"]]),
    "current: (unset) (default: false)"
  )
})

test_that("option_affects_data tags exactly the data group", {
  expect_true(option_affects_data("data.winsorization_level"))
  expect_true(option_affects_data("data.na_handling"))
  expect_false(option_affects_data("output.report"))
  expect_false(option_affects_data("calc.precision_type"))
})

test_that("a declined save keeps a data edit session-only and flags staleness", {
  withr::local_options(list(artma.data.winsorization_level = 0.01))
  saves <- list()

  outcome <- suppressMessages(run_adjust_options(
    select_fn = make_select_fn(c("data.winsorization_level", "Back")),
    edit_option = function(def) 0.05,
    save_preference = function(name, value) {
      saves[[name]] <<- value
      FALSE
    }
  ))

  expect_equal(outcome$changed, "data.winsorization_level")
  expect_true(outcome$data_changed)
  expect_equal(getOption("artma.data.winsorization_level"), 0.05)
  expect_equal(saves, list(data.winsorization_level = 0.05))
})

test_that("an accepted save still applies the edit session-wide, without staleness", {
  withr::local_options(list(artma.output.number_of_decimals = 3))

  outcome <- suppressMessages(run_adjust_options(
    select_fn = make_select_fn(c("output.number_of_decimals", "Back")),
    edit_option = function(def) 4L,
    save_preference = function(name, value) TRUE
  ))

  expect_equal(outcome$changed, "output.number_of_decimals")
  expect_false(outcome$data_changed)
  expect_equal(getOption("artma.output.number_of_decimals"), 4L)
})

test_that("an unchanged value records nothing and never asks to persist", {
  withr::local_options(list(artma.general.seed = 42))

  outcome <- suppressMessages(run_adjust_options(
    select_fn = make_select_fn(c("general.seed", "Back")),
    edit_option = function(def) 42,
    save_preference = abort_if_called("save_preference")
  ))

  expect_equal(outcome$changed, character(0))
  expect_false(outcome$data_changed)
})

test_that("browse-all walks the template tree to any option", {
  withr::local_options(list(artma.visualization.theme = "blue"))

  outcome <- suppressMessages(run_adjust_options(
    select_fn = make_select_fn(c(
      "Browse all options", "visualization", "visualization.theme", "Back"
    )),
    edit_option = function(def) "red",
    save_preference = function(name, value) FALSE
  ))

  expect_equal(outcome$changed, "visualization.theme")
  expect_false(outcome$data_changed)
  expect_equal(getOption("artma.visualization.theme"), "red")
})

test_that("a data edit re-prepares the data once, before the next run", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.data.winsorization_level = 0.01
  ))
  checkbox <- make_checkbox_fn("bma")
  run <- make_run_methods()
  rebuilds <- list()

  results <- suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = run$fn,
    rebuild_data = function(selection) {
      rebuilds <<- c(rebuilds, list(selection))
      hub_df()[1:2, ]
    },
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn(c(
      "Adjust options", "data.winsorization_level", "Back",
      "Run methods",
      "Re-run last selection",
      "Exit"
    )),
    checkbox_fn = checkbox$fn,
    edit_option = function(def) 0.05,
    save_preference = function(name, value) FALSE,
    width = 100
  ))

  # Rebuilt exactly once, lazily, with the run's selection; the re-run reuses
  # the fresh frame.
  expect_equal(rebuilds, list("bma"))

  runs <- attr(results, "runs")
  expect_length(runs, 2L)
  expect_equal(runs[[1]]$options_changed, "data.winsorization_level")
  expect_equal(runs[[2]]$options_changed, character(0))
})

test_that("a non-data edit never triggers a data rebuild", {
  withr::local_options(list(
    artma.temp.last_methods = NULL,
    artma.output.number_of_decimals = 3
  ))
  checkbox <- make_checkbox_fn("bma")
  run <- make_run_methods()

  results <- suppressMessages(run_session_hub(
    df = hub_df(),
    options_file = SESSION_FILE,
    run_methods = run$fn,
    rebuild_data = abort_if_called("rebuild_data"),
    methods_table = hub_methods_frame(),
    select_fn = make_select_fn(c(
      "Adjust options", "output.number_of_decimals", "Back",
      "Run methods",
      "Exit"
    )),
    checkbox_fn = checkbox$fn,
    edit_option = function(def) 4L,
    save_preference = function(name, value) FALSE,
    width = 100
  ))

  runs <- attr(results, "runs")
  expect_length(runs, 1L)
  expect_equal(runs[[1]]$options_changed, "output.number_of_decimals")
})