tests/testthat/test-artifact-registry.R

In writeAlizer: Generate Predicted Writing Quality Scores

# tests/testthat/test-artifact-registry.R
# Consolidated coverage for R/artifact_registry.R

.quiet_eval <- function(expr) {
  withCallingHandlers(
    suppressWarnings(suppressMessages(force(expr))),
    message = function(m) invokeRestart("muffleMessage"),
    warning = function(w) invokeRestart("muffleWarning")
  )
}

testthat::test_that(".wa_parts_for returns expected shapes and validates inputs", {
  parts_for <- getFromNamespace(".wa_parts_for", "writeAlizer")

  # invalid kind vector -> classed input error
  testthat::expect_error(
    parts_for(kind = c("rds", "rda"), model = "x"),
    class = "writeAlizer_input_error"
  )

  # unknown kind should still return a data.frame (empty)
  testthat::expect_s3_class(parts_for(kind = "zip", model = "x"), "data.frame")

  # missing model rows -> empty df
  df <- parts_for("rds", "no_such_model")
  testthat::expect_true(is.data.frame(df))
  testthat::expect_equal(nrow(df), 0L)
})

testthat::test_that(".wa_parts_for errors if registry lacks required columns", {
  parts_for <- getFromNamespace(".wa_parts_for", "writeAlizer")
  bad_reg <- data.frame(kind = "rda", model = "x", part = "a", file = "x.rda",
                        stringsAsFactors = FALSE)
  testthat::local_mocked_bindings(.package = "writeAlizer", .wa_registry = function() bad_reg)
  testthat::expect_error(
    parts_for("rda", "x"),
    class = "writeAlizer_registry_malformed"
  )
})

testthat::test_that(".wa_registry missing CSV is classed", {
  wa_registry <- getFromNamespace(".wa_registry", "writeAlizer")

  withr::local_options(writeAlizer.registry_csv = tempfile())  # force missing
  testthat::local_mocked_bindings(
    .package = "base",
    system.file = function(...) ""  # belt-and-suspenders
  )

  testthat::expect_error(
    wa_registry(),
    class = "writeAlizer_registry_missing"
  )
})

testthat::test_that(".wa_ensure_file: cache hit + checksum; input guard; file:// download; checksum mismatch", {
  ensure_file  <- getFromNamespace(".wa_ensure_file",  "writeAlizer")
  cached_path  <- getFromNamespace(".wa_cached_path",  "writeAlizer")

  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())
  withr::local_options(download.file.method = "libcurl")

  # A) Early return with good checksum
  rel_ok  <- file.path("models", "demo", "ok.rda")
  dest_ok <- cached_path(rel_ok)
  dir.create(dirname(dest_ok), recursive = TRUE, showWarnings = FALSE)
  save(list = character(), file = dest_ok)
  good_sha <- digest::digest(dest_ok, algo = "sha256", file = TRUE)
  out_ok <- .quiet_eval(ensure_file(rel_ok, url = "file:///not/used", sha256 = good_sha))
  testthat::expect_identical(normalizePath(out_ok), normalizePath(dest_ok))

  # B) Not cached, empty URL -> classed input error
  rel_need  <- file.path("models", "demo", "need_url.rda")
  testthat::expect_error(
    ensure_file(rel_need, url = ""),
    class = "writeAlizer_input_error"
  )

  # C) file:// download works
  src <- withr::local_tempfile(fileext = ".rda"); save(list = character(), file = src)
  url <- paste0("file:///", normalizePath(src, winslash = "/"))
  rel_dl  <- file.path("models", "demo", "fetch_once.rda")
  dest_dl <- cached_path(rel_dl)
  dir.create(dirname(dest_dl), recursive = TRUE, showWarnings = FALSE)
  out <- .quiet_eval(ensure_file(rel_dl, url = url))
  testthat::expect_true(file.exists(out))

  # D) checksum mismatch throws an error (assert by message, not class)
  wrong_sha <- paste(rep("0", 64), collapse = "")
  rel_bad  <- file.path("models", "demo", "badsha.rda")
  dest_bad <- cached_path(rel_bad)
  dir.create(dirname(dest_bad), recursive = TRUE, showWarnings = FALSE)

  testthat::expect_error(
    suppressWarnings(.quiet_eval(ensure_file(rel_bad, url = url, sha256 = wrong_sha))),
    regexp = "Downloaded checksum mismatch"
  )
})

testthat::test_that(".wa_ensure_file respects writeAlizer.mock_dir precedence (loader unique behavior)", {
  ensure_file <- getFromNamespace(".wa_ensure_file", "writeAlizer")
  cached_path <- getFromNamespace(".wa_cached_path", "writeAlizer")

  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())
  withr::local_options(download.file.method = "libcurl")

  # Arrange a mock_dir with the artifact relative path and ensure it's used
  mock_dir <- withr::local_tempdir()
  rel      <- file.path("models", "demo", "from_mock.rda")
  mock_fp  <- file.path(mock_dir, rel)
  dir.create(dirname(mock_fp), recursive = TRUE, showWarnings = FALSE)
  x <- 123L; save(x, file = mock_fp)

  withr::local_options(writeAlizer.mock_dir = mock_dir)

  # Give a bogus URL to prove mock_dir is preferred
  out <- .quiet_eval(ensure_file(rel, url = "file:///does/not/exist.rda"))
  testthat::expect_true(file.exists(out))

  # Compare file bytes (use file=TRUE, not positional arg)
  testthat::expect_identical(
    digest::digest(out,     algo = "sha256", file = TRUE),
    digest::digest(mock_fp, algo = "sha256", file = TRUE)
  )
})

testthat::test_that(".wa_load_model_rdas loads into provided environment; last wins", {
  load_model_rdas <- getFromNamespace(".wa_load_model_rdas", "writeAlizer")
  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())

  f1 <- withr::local_tempfile(fileext = ".rda"); fit <- 1L; save(fit, file = f1)
  f2 <- withr::local_tempfile(fileext = ".rda"); fit <- 2L; save(fit, file = f2)

  reg <- data.frame(
    kind = c("rda","rda"), model = "my_rda", part = c("a","b"),
    file = c("mya.rda","myb.rda"),
    url  = c(paste0("file:///", normalizePath(f1, winslash = "/")),
             paste0("file:///", normalizePath(f2, winslash = "/"))),
    stringsAsFactors = FALSE
  )
  testthat::local_mocked_bindings(.package = "writeAlizer", .wa_registry = function() reg)

  env <- new.env(parent = emptyenv())
  .quiet_eval(invisible(load_model_rdas("my_rda", envir = env)))
  testthat::expect_true(exists("fit", envir = env))
  testthat::expect_identical(get("fit", envir = env), 2L)
})

testthat::test_that(".wa_load_model_rdas: missing example mock is classed", {
  load_model_rdas <- getFromNamespace(".wa_load_model_rdas", "writeAlizer")

  tmp <- withr::local_tempdir()
  withr::local_options(writeAlizer.mock_dir = tmp)
  testthat::expect_error(
    load_model_rdas("example"),
    class = "writeAlizer_mock_missing"
  )
})

testthat::test_that(".wa_load_fits_list returns named list; canonicalizes; unknown model errors (classed)", {
  load_fits_list <- getFromNamespace(".wa_load_fits_list", "writeAlizer")
  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())

  a <- withr::local_tempfile(fileext = ".rda"); fit <- 11; save(fit, file = a)
  b <- withr::local_tempfile(fileext = ".rda"); fit <- 22; save(fit, file = b)

  reg <- data.frame(
    kind=c("rda","rda"), model=c("fmod","fmod"), part=c("a","b"),
    file=c("rb_mod1a.rda","rb_mod1b.rda"),
    url=c(paste0("file:///", normalizePath(a, winslash = "/")),
          paste0("file:///", normalizePath(b, winslash = "/"))),
    stringsAsFactors = FALSE
  )

  testthat::local_mocked_bindings(
    .package = "writeAlizer",
    .wa_registry = function() reg,
    .wa_require_pkgs_for_fits = function(fits) TRUE
  )

  fits <- .quiet_eval(load_fits_list("fmod"))
  testthat::expect_true(is.list(fits))
  testthat::expect_setequal(names(fits), c("rb_mod1a", "rb_mod1b"))
  testthat::expect_identical(fits$rb_mod1a, 11)
  testthat::expect_identical(fits$rb_mod1b, 22)

  testthat::expect_error(
    load_fits_list("no_such_model"),
    class = "writeAlizer_parts_missing"
  )
})

testthat::test_that(".wa_load_fits_list maps legacy -> v2 names", {
  load_fits_list <- getFromNamespace(".wa_load_fits_list", "writeAlizer")
  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())

  a <- withr::local_tempfile(fileext = ".rda"); fit <- 1L; save(fit, file = a)
  b <- withr::local_tempfile(fileext = ".rda"); fit <- 2L; save(fit, file = b)

  reg_map <- data.frame(
    kind  = c("rda","rda"),
    model = c("rb_mod3narr_v2","rb_mod3narr_v2"),
    part  = c("a","b"),
    file  = c("rb_mod3narr_v2_a.rda","rb_mod3narr_v2_b.rda"),
    url   = c(paste0("file:///", normalizePath(a, winslash = "/")),
              paste0("file:///", normalizePath(b, winslash = "/"))),
    stringsAsFactors = FALSE
  )
  testthat::local_mocked_bindings(
    .package = "writeAlizer",
    .wa_registry = function() reg_map,
    .wa_require_pkgs_for_fits = function(fits) TRUE
  )

  fits <- .quiet_eval(load_fits_list("rb_mod3narr"))
  testthat::expect_true(is.list(fits))
  testthat::expect_setequal(names(fits), c("rb_mod3narr_v2_a", "rb_mod3narr_v2_b"))
})

testthat::test_that(".wa_registry has expected core columns and sha present", {
  wa_registry <- getFromNamespace(".wa_registry", "writeAlizer")
  out <- wa_registry()

  testthat::expect_s3_class(out, "data.frame")
  testthat::expect_true(all(c("kind","model","part","file","url") %in% names(out)))
  testthat::expect_true("sha" %in% names(out))
  testthat::expect_true(any(!is.na(out$sha)))
})

testthat::test_that(".wa_local_path returns a single path string", {
  wa_local_path <- getFromNamespace(".wa_local_path", "writeAlizer")
  p <- wa_local_path("somefile.ext")
  testthat::expect_true(is.character(p) && length(p) == 1L)
})

testthat::test_that(".wa_require_pkgs_for_fits collects needed pkgs and errors when missing (classed)", {
  req_pkgs <- getFromNamespace(".wa_require_pkgs_for_fits", "writeAlizer")

  # A) Collection across classes
  fits <- list(
    structure(list(), class = "randomForest"),
    structure(list(), class = "gbm"),
    structure(list(), class = "glmnet"),
    structure(list(), class = "earth"),
    structure(list(), class = "Cubist"),
    structure(list(), class = "ksvm"),
    structure(list(), class = "mvr"),
    structure(list(), class = "caretEnsemble"),
    structure(list(modelInfo = list(library = c("pkgA","pkgB"))), class = "train")
  )
  called <- character(0)
  testthat::local_mocked_bindings(
    .package = "base",
    requireNamespace = function(pkg, quietly = TRUE) { called <<- unique(c(called, pkg)); TRUE }
  )
  testthat::expect_silent(req_pkgs(fits))
  testthat::expect_true(all(c("randomForest","gbm","glmnet","earth","Cubist","kernlab","pls",
                              "caretEnsemble","pkgA","pkgB") %in% called))

  # B) Missing package path (classed)
  fits2 <- list(
    structure(list(), class = "randomForest"),
    structure(list(modelInfo = list(library = c("pkg_missing"))), class = "train")
  )
  testthat::local_mocked_bindings(
    .package = "base",
    requireNamespace = function(pkg, quietly = TRUE) { !identical(pkg, "pkg_missing") }
  )
  testthat::expect_error(req_pkgs(fits2), class = "writeAlizer_dependency_missing")
})