tests/testthat/test-options.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(testthat[test_that, expect_equal, expect_true, expect_false, expect_null, expect_setequal, expect_length, expect_no_error, expect_error, expect_identical])

test_that("options lifecycle helpers operate on user files", {
  box::use(artma[options_create, options_copy, options_delete, options_fix, options_list, options_load, options_remove, options_validate])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    general = list(
      name = list(
        type = "character",
        default = "Default Config",
        help = "Friendly name for the configuration"
      )
    ),
    data = list(
      threshold = list(
        type = "integer",
        default = 10L,
        help = "Numeric threshold"
      ),
      enabled = list(
        type = "logical",
        default = TRUE,
        help = "Whether the feature is enabled"
      )
    )
  )

  yaml::write_yaml(template, template_path)

  valid_options <- list(
    general = list(name = "Primary"),
    data = list(
      threshold = 4L,
      enabled = FALSE
    )
  )
  invalid_options <- valid_options
  invalid_options$data$threshold <- "four"

  yaml::write_yaml(valid_options, file.path(tmp_dir, "valid.yaml"))
  yaml::write_yaml(invalid_options, file.path(tmp_dir, "invalid.yaml"))

  no_errors <- options_validate(
    options_file_name = "valid.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    failure_action = "return_errors_quiet"
  )
  expect_length(no_errors, 0)

  with_errors <- options_validate(
    options_file_name = "invalid.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    failure_action = "return_errors_quiet"
  )
  expect_equal(with_errors[[1]]$type, "type_mismatch")

  options_copy(
    options_file_name_from = "valid.yaml",
    options_file_name_to = "copied.yaml",
    options_dir = tmp_dir,
    should_overwrite = TRUE
  )
  expect_true(file.exists(file.path(tmp_dir, "copied.yaml")))

  expect_setequal(
    options_list(options_dir = tmp_dir),
    c("copied.yaml", "invalid.yaml", "valid.yaml")
  )

  verbose_names <- options_list(
    options_dir = tmp_dir,
    should_return_verbose_names = TRUE
  )
  expect_true("Primary" %in% verbose_names)

  loaded <- options_load(
    options_file_name = "valid.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    should_validate = TRUE,
    should_add_temp_options = TRUE,
    should_return = TRUE
  )
  expect_equal(loaded$`artma.general.name`, "Primary")
  expect_equal(loaded$`artma.temp.file_name`, "valid.yaml")

  # The runtime path applies loaded options via withr, with automatic restoration
  withr::with_options(loaded, {
    expect_equal(getOption("artma.general.name"), "Primary")
    expect_equal(getOption("artma.temp.file_name"), "valid.yaml")
  })
  expect_null(getOption("artma.general.name"))

  options_create(
    options_file_name = "new.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    user_input = list(
      "general.name" = "Secondary",
      "data.threshold" = 8L
    ),
    should_validate = TRUE,
    should_overwrite = TRUE
  )
  created <- yaml::read_yaml(file.path(tmp_dir, "new.yaml"))
  expect_equal(created$general$name, "Secondary")
  expect_equal(created$data$threshold, 8L)
  expect_true(created$data$enabled)

  options_fix(
    options_file_name = "invalid.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    force_default_overwrites = TRUE
  )
  fixed <- yaml::read_yaml(file.path(tmp_dir, "invalid.yaml"))
  expect_equal(fixed$data$threshold, 10L)

  options_delete(
    options_file_name = "copied.yaml",
    options_dir = tmp_dir,
    skip_confirmation = TRUE
  )
  expect_false(file.exists(file.path(tmp_dir, "copied.yaml")))

  expect_identical(options_remove, options_delete)
  options_remove(
    options_file_name = "new.yaml",
    options_dir = tmp_dir,
    skip_confirmation = TRUE
  )
  expect_false(file.exists(file.path(tmp_dir, "new.yaml")))
})

test_that("options_load accepts a file name without the .yaml suffix", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    general = list(
      name = list(
        type = "character",
        default = "Default Config",
        help = "Friendly name for the configuration"
      )
    )
  )
  yaml::write_yaml(template, template_path)
  yaml::write_yaml(list(general = list(name = "Primary")), file.path(tmp_dir, "dummy_run.yaml"))

  loaded <- options_load(
    options_file_name = "dummy_run",
    options_dir = tmp_dir,
    template_path = template_path,
    should_validate = TRUE,
    should_add_temp_options = TRUE,
    should_return = TRUE
  )
  expect_equal(loaded$`artma.general.name`, "Primary")
  expect_equal(loaded$`artma.temp.file_name`, "dummy_run.yaml")
})

test_that("options_load backfills missing and invalid values with template defaults", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    methods = list(
      enabled = list(
        type = "logical",
        default = TRUE,
        help = "Enable the method"
      )
    ),
    calc = list(
      precision_type = list(
        type = "character",
        default = "1/SE",
        help = "Precision metric"
      ),
      se_zero_handling = list(
        type = "character",
        default = "stop",
        help = "How to handle zero standard errors"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  stale_options <- list(
    methods = list(
      enabled = "yes"
    ),
    calc = list(
      precision_type = 42L
    )
  )
  yaml::write_yaml(stale_options, file.path(tmp_dir, "stale.yaml"))

  loaded <- NULL
  expect_no_error({
    loaded <- options_load(
      options_file_name = "stale.yaml",
      options_dir = tmp_dir,
      template_path = template_path,
      should_validate = TRUE,
      should_return = TRUE
    )
  })

  expect_equal(loaded$`artma.methods.enabled`, TRUE)
  expect_equal(loaded$`artma.calc.precision_type`, "1/SE")
  expect_equal(loaded$`artma.calc.se_zero_handling`, "stop")
})

test_that("options_load warns when it substitutes an invalid value", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    calc = list(
      precision_type = list(
        type = "character",
        default = "1/SE",
        help = "Precision metric"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  # An integer where the template wants a character: invalid, backfilled.
  yaml::write_yaml(
    list(calc = list(precision_type = 42L)),
    file.path(tmp_dir, "stale.yaml")
  )

  withr::local_options(list("artma.verbose" = 3))

  msgs <- testthat::capture_messages(
    options_load(
      options_file_name = "stale.yaml",
      options_dir = tmp_dir,
      template_path = template_path,
      should_validate = TRUE,
      should_return = TRUE
    )
  )

  expect_true(any(grepl("calc.precision_type", msgs, fixed = TRUE)))
})

test_that("options_load never writes to the options file", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      threshold = list(type = "integer", default = 10L, help = "Threshold"),
      enabled = list(type = "logical", default = TRUE, help = "Enabled")
    )
  )
  yaml::write_yaml(template, template_path)

  opts_path <- file.path(tmp_dir, "stale.yaml")
  # Deliberately stale: missing 'enabled' and a wrong-typed 'threshold'.
  yaml::write_yaml(
    list(data = list(threshold = "not-an-int")),
    opts_path
  )

  before_content <- readLines(opts_path)
  before_mtime <- file.mtime(opts_path)

  options_load(
    options_file_name = "stale.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    should_validate = TRUE,
    should_return = TRUE
  )

  expect_identical(readLines(opts_path), before_content)
  expect_equal(file.mtime(opts_path), before_mtime)
})

test_that("options_load aborts when a required option without a default is missing", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      source_path = list(type = "character", help = "Required source path")
    )
  )
  yaml::write_yaml(template, template_path)
  yaml::write_yaml(
    list(data = list(unrelated = "value")),
    file.path(tmp_dir, "opts.yaml")
  )

  expect_error(
    options_load(
      options_file_name = "opts.yaml",
      options_dir = tmp_dir,
      template_path = template_path,
      should_validate = TRUE,
      should_return = TRUE
    ),
    "source_path"
  )
})

test_that("options_load parses the template only once per load", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      threshold = list(type = "integer", default = 10L, help = "Threshold")
    )
  )
  yaml::write_yaml(template, template_path)
  yaml::write_yaml(
    list(data = list(threshold = 3L)),
    file.path(tmp_dir, "opts.yaml")
  )

  real_read_yaml <- yaml::read_yaml
  n_template_reads <- 0L
  testthat::local_mocked_bindings(
    read_yaml = function(file, ...) {
      if (identical(file, template_path)) {
        n_template_reads <<- n_template_reads + 1L
      }
      real_read_yaml(file, ...)
    },
    .package = "yaml"
  )

  options_load(
    options_file_name = "opts.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    should_validate = TRUE,
    should_return = TRUE
  )

  expect_equal(n_template_reads, 1L)
})

test_that("options_load backfills defaults when loading without prefix", {
  box::use(artma[options_load])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      na_handling = list(
        type = "character",
        default = "stop",
        help = "Missing value handling"
      ),
      winsorization_level = list(
        type = "numeric",
        default = 0,
        help = "Winsorization quantile"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  stale_options <- list(
    data = list(
      na_handling = FALSE
    )
  )
  yaml::write_yaml(stale_options, file.path(tmp_dir, "stale-no-prefix.yaml"))

  loaded <- options_load(
    options_file_name = "stale-no-prefix.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    load_with_prefix = FALSE,
    should_validate = TRUE,
    should_return = TRUE
  )

  expect_equal(loaded$data.na_handling, "stop")
  expect_equal(loaded$data.winsorization_level, 0)
})

test_that("options_create honors nested user_input on the create-new path", {
  box::use(artma[options_create])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      source_path = list(
        type = "character",
        help = "Path to the data source"
      ),
      na_handling = list(
        type = "character",
        default = "stop",
        help = "How to handle missing values"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  withr::local_options(list("artma.verbose" = 1))

  # Nested and flat dotted user_input must produce identical files; the
  # create-new branch previously dropped nested values silently (issue #321).
  options_create(
    options_file_name = "nested.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    user_input = list(data = list(source_path = "some.csv")),
    should_validate = TRUE
  )
  options_create(
    options_file_name = "flat.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    user_input = list("data.source_path" = "some.csv"),
    should_validate = TRUE
  )

  nested <- yaml::read_yaml(file.path(tmp_dir, "nested.yaml"))
  flat <- yaml::read_yaml(file.path(tmp_dir, "flat.yaml"))

  expect_equal(nested$data$source_path, "some.csv")
  expect_equal(nested$data$na_handling, "stop")
  expect_identical(nested, flat)
})

test_that("options_create generates mock data for the 'mock' source path shortcut", {
  box::use(artma[options_create])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      source_path = list(
        type = "character",
        prompt = "file",
        help = "Path to the data source"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  withr::local_options(list("artma.verbose" = 1))

  options_create(
    options_file_name = "mock.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    user_input = list("data.source_path" = "mock"),
    should_validate = TRUE
  )

  created <- yaml::read_yaml(file.path(tmp_dir, "mock.yaml"))

  expect_false(identical(created$data$source_path, "mock"))
  expect_true(file.exists(created$data$source_path))
  expect_true(endsWith(created$data$source_path, ".csv"))
  df <- utils::read.csv(created$data$source_path)
  expect_true(all(c("study_id", "effect", "se") %in% colnames(df)))
})

test_that("a missing required option aborts naming the option, without a cli meta-error", {
  box::use(artma[options_create])

  testthat::skip_if(interactive())

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      source_path = list(
        type = "character",
        help = "Path to the data source"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  withr::local_options(list("artma.verbose" = 1))

  err <- expect_error(
    options_create(
      options_file_name = "missing.yaml",
      options_dir = tmp_dir,
      template_path = template_path,
      user_input = list(),
      should_validate = TRUE
    ),
    "Required option"
  )
  # The intended abort must name the option instead of failing to evaluate
  # its cli glue expression (issue #321, bug 6).
  expect_true(grepl("data.source_path", conditionMessage(err), fixed = TRUE))
  expect_false(grepl("Could not evaluate", conditionMessage(err), fixed = TRUE))
})

test_that("options_modify merges a nested user_input into a list-type option without dropping siblings", {
  box::use(artma[options_modify])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      source_path = list(
        type = "character",
        default = "",
        help = "Path to the data source"
      ),
      na_handling = list(
        type = "character",
        default = "stop",
        help = "How to handle missing values"
      ),
      columns = list(
        type = "list",
        default = NA,
        allow_na = TRUE,
        help = "Per-column configuration"
      )
    ),
    methods = list(
      p_hacking_tests = list(
        caliper_tail = list(
          type = "character",
          default = "two_sided",
          help = "Which tail to test"
        ),
        caliper_cluster = list(
          type = "logical",
          default = TRUE,
          help = "Whether to cluster"
        )
      )
    )
  )
  yaml::write_yaml(template, template_path)

  original <- list(
    data = list(
      source_path = "old.csv",
      na_handling = "stop",
      columns = list(
        a = list(source_name = "A"),
        b = list(source_name = "B"),
        c = list(source_name = "C")
      )
    ),
    methods = list(
      p_hacking_tests = list(
        caliper_tail = "two_sided",
        caliper_cluster = TRUE
      )
    )
  )
  yaml::write_yaml(original, file.path(tmp_dir, "user.yaml"))

  options_modify(
    options_file_name = "user.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    user_input = list(
      data = list(
        source_path = "new.csv",
        columns = list(a = list(source_name = "A2"))
      )
    ),
    should_validate = TRUE
  )

  modified <- yaml::read_yaml(file.path(tmp_dir, "user.yaml"))

  # The requested edits landed...
  expect_equal(modified$data$source_path, "new.csv")
  expect_equal(modified$data$columns$a$source_name, "A2")

  # ...without dropping sibling data.* keys, other data.columns entries, or an
  # unrelated top-level section.
  expect_equal(modified$data$na_handling, "stop")
  expect_equal(modified$data$columns$b$source_name, "B")
  expect_equal(modified$data$columns$c$source_name, "C")
  expect_equal(modified$methods$p_hacking_tests$caliper_tail, "two_sided")
  expect_true(modified$methods$p_hacking_tests$caliper_cluster)
})

test_that("options_modify leaves the file untouched when the modified options fail validation", {
  box::use(artma[options_modify])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      threshold = list(
        type = "integer",
        default = 10L,
        help = "Numeric threshold"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  original <- list(data = list(threshold = 4L))
  options_path <- file.path(tmp_dir, "user.yaml")
  yaml::write_yaml(original, options_path)
  original_contents <- readLines(options_path)

  expect_error(
    options_modify(
      options_file_name = "user.yaml",
      options_dir = tmp_dir,
      template_path = template_path,
      user_input = list("data.threshold" = "not-a-number"),
      should_validate = TRUE
    )
  )

  expect_identical(readLines(options_path), original_contents)
})

test_that("options_list includes files with the .yml suffix", {
  box::use(artma[options_list])

  tmp_dir <- withr::local_tempdir()

  yaml::write_yaml(
    list(general = list(name = "Short Suffix")),
    file.path(tmp_dir, "short.yml")
  )
  yaml::write_yaml(
    list(general = list(name = "Long Suffix")),
    file.path(tmp_dir, "long.yaml")
  )

  expect_setequal(
    options_list(options_dir = tmp_dir),
    c("long.yaml", "short.yml")
  )
})

test_that("options files are stamped with the package version on write", {
  box::use(artma[options_create])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    data = list(
      threshold = list(
        type = "integer",
        default = 10L,
        help = "Numeric threshold"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  options_create(
    options_file_name = "stamped.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    user_input = list(),
    should_validate = TRUE,
    should_overwrite = TRUE
  )

  written <- yaml::read_yaml(file.path(tmp_dir, "stamped.yaml"))
  expect_equal(
    written$general$artma_version,
    as.character(utils::packageVersion("artma"))
  )
})

test_that("autonomy level from an options file is honored via the withr runtime path", {
  box::use(artma[options_load])
  box::use(artma / libs / core / autonomy[get_autonomy_level])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  template <- list(
    autonomy = list(
      level = list(
        type = "integer",
        default = 4L,
        help = "Autonomy level"
      )
    )
  )
  yaml::write_yaml(template, template_path)
  yaml::write_yaml(
    list(autonomy = list(level = 2L)),
    file.path(tmp_dir, "auto.yaml")
  )

  runtime_options <- options_load(
    options_file_name = "auto.yaml",
    options_dir = tmp_dir,
    template_path = template_path,
    should_validate = TRUE,
    should_return = TRUE
  )

  # Mirrors runtime_setup() in R/aaa.R, which applies loaded options via withr
  withr::with_options(runtime_options, {
    expect_equal(get_autonomy_level(), 2L)
  })
})

test_that("a legacy numeric autonomy.level in an options file migrates cleanly on load", {
  box::use(artma[options_load])
  box::use(artma / libs / core / autonomy[get_autonomy_level])

  tmp_dir <- withr::local_tempdir()
  template_path <- file.path(tmp_dir, "template.yaml")

  # Mirrors the post-collapse autonomy.level template node (a 3-value enum).
  template <- list(
    autonomy = list(
      level = list(
        type = "enum: 'ask_more'|'balanced'|'autonomous'",
        default = "autonomous",
        help = "Autonomy level"
      )
    )
  )
  yaml::write_yaml(template, template_path)

  # Simulate an options file written before the collapse, storing the old numeric level.
  yaml::write_yaml(
    list(autonomy = list(level = 4L)),
    file.path(tmp_dir, "legacy-autonomy.yaml")
  )

  loaded <- NULL
  expect_no_error({
    loaded <- options_load(
      options_file_name = "legacy-autonomy.yaml",
      options_dir = tmp_dir,
      template_path = template_path,
      should_validate = TRUE,
      should_return = TRUE
    )
  })

  # The stale numeric value fails enum validation and is backfilled with the new default.
  expect_equal(loaded$`artma.autonomy.level`, "autonomous")

  withr::with_options(loaded, {
    expect_equal(get_autonomy_level(), "autonomous")
  })
})