Create a function download_models to download ss3 test models

NAMESPACE

@@ -91,6 +91,7 @@ export(SSunavailableSpawningOutput)
 export(TSCplot)
 export(add_legend)
 export(copy_SS_inputs)
+export(download_models)
 export(getADMBHessian)
 export(get_SIS_info)
 export(is.wholenumber)

R/download_models.R

@@ -0,0 +1,70 @@
+#' Download SS3 test models
+#'
+#' Download and unzip the models folder stored on GitHub within the
+#' nmfs-stock-synthesis/test-models repository.
+#' @param dir A file path where the downloaded `"models"` subfolder will be written to.
+#' @param branch A string specifying the desired branch of
+#' [nmfs-stock-synthesis/test-models repository](https://github.com/nmfs-stock-synthesis/test-models#test-models)
+#' that you want to download. The default is `"main"`, which is the
+#' stable/default branch.
+#' @template overwrite
+#' @return Invisibly return a logical revealing whether the files were copied
+#'  (TRUE) or not (FALSE). This function is used for its side effects of
+#'  downloading SS3 test models.
+#' @examples
+#' download_models(dir = getwd())
+#' model_name <- list.files("models") # see the model names
+#' # remove files
+#' unlink(file.path("models"), recursive = TRUE)
+#' @author Kathryn Doering
+#' @references [nmfs-stock-synthesis/test-models repository](https://github.com/nmfs-stock-synthesis/test-models#test-models)
+#' @export
+download_models <- function(dir = file.path("inst", "extdata"),
+                            branch = "main",
+                            overwrite = FALSE) {
+  # checks
+  if (!dir.exists(dir)) {
+    dir.create(dir, recursive = TRUE)
+  }
+  zip_file_path <- file.path(dir, "test-models.zip")
+  result <- tryCatch(
+    utils::download.file(
+      url = paste0(
+        "https://github.com/nmfs-stock-synthesis/test-models/archive/",
+        branch,
+        ".zip"
+        ),
+      destfile = zip_file_path
+    ),
+    error = function(e) {
+      stop(
+        "The test-models zip file could not be downloaded.",
+        " Does the branch (", branch, ") exist?",
+        call. = FALSE
+      )
+    }
+  )
+  list_files <- utils::unzip(list = TRUE, zipfile = zip_file_path)
+  save_files <- list_files[grep("/models/", list_files$Name, fixed = TRUE), ]
+  utils::unzip(
+    zipfile = zip_file_path, files = save_files[["Name"]],
+    exdir = dir
+  )
+  if (dir.exists(file.path(dir, "models")) & overwrite == FALSE) {
+    warning(
+      "The model directory ", file.path(dir, "models"), " already exists ",
+      "\nand overwrite is FALSE. So, no new files will be written."
+    )
+  }
+  dir.create(file.path(dir, "models"), showWarnings = FALSE)
+  copy_status <- file.copy(
+    from = file.path(dir, paste0("test-models-", branch), "models"),
+    to = file.path(dir), recursive = TRUE, overwrite = overwrite
+  )
+  # clean up
+  unlink(zip_file_path)
+  unlink(file.path(dir, paste0("test-models-", branch)),
+    recursive = TRUE
+  )
+  invisible(copy_status)
+}

tests/testthat/test-download_models.R

@@ -0,0 +1,53 @@
+
+# setup
+temp_dir <- tempdir()
+save_models_dir <- file.path(temp_dir, "save_mods")
+# create directories and use on exit statements to ensure cleanup at the end.
+dir.create(save_models_dir)
+on.exit(unlink(save_models_dir, recursive = TRUE), add = TRUE)
+if (!dir.exists("inst")) {
+  dir.create("inst")
+  dir.create("inst/extdata")
+  on.exit(unlink("inst", recursive = TRUE), add = TRUE)
+}
+if (!dir.exists("inst/extdata")) {
+  dir.create("inst/extdata")
+  on.exit(unlink("inst/extdata", recursive = TRUE), add = TRUE)
+}
+
+test_that("download_models with defaults work", {
+  download_models()
+  expect_true(file.exists("inst/extdata/models"))
+  expect_true(file.exists("inst/extdata/models/Simple"))
+  expect_true(file.exists("inst/extdata/models/Simple/ss.par"))
+})
+
+test_that("download_models with different dir works", {
+  download_models(dir = save_models_dir)
+  expect_true(file.exists(file.path(save_models_dir, "models")))
+  expect_true(file.exists(file.path(save_models_dir, "models", "Simple")))
+  expect_true(file.exists(file.path(save_models_dir, "models", "Simple", "ss.par")))
+})
+
+test_that("download_models() works when the dir doesn't exist", {
+  temp_dir_missing_dir <- file.path(save_models_dir, "missing_dir", "missing_subdir")
+  # create it
+  worked <- download_models(dir = temp_dir_missing_dir)
+  expect_true(worked)
+  expect_true(file.exists(file.path(temp_dir_missing_dir, "models")))
+  expect_true(file.exists(file.path(temp_dir_missing_dir, "models", "Simple")))
+  expect_true(file.exists(file.path(temp_dir_missing_dir, "models", "Simple", "ss.par")))
+})
+
+# (note that this generates 2 warnings, and I'm not sure how to suppress them!)
+test_that("download_models() fails when the branch doesn't exist", {
+  temp_dir_branch_dne <- file.path(save_models_dir, "diff_branch_dne")
+  dir.create(temp_dir_branch_dne)
+  expect_error(
+    download_models(
+      dir = temp_dir_branch_dne,
+      branch = "not_existing_branch"
+    ),
+    "not be downloaded"
+  )
+})