Add parsing tests for parse_model_batch_dir_path

hewr/NAMESPACE

@@ -1,7 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(get_all_model_batch_dirs)
-export(parse_model_batch_dir_name)
+export(parse_model_batch_dir_path)
 export(parse_model_run_dir_path)
 export(to_epiweekly_quantile_table)
 export(to_epiweekly_quantiles)

hewr/R/directory_utils.R

@@ -14,21 +14,20 @@ disease_map_lower <- list(
 #' with fits for multiple locations), returning
 #' a named list of quantities of interest.
 #'
-#' @param model_batch_dir_name Name of the model batch
-#' directory (not the full path to it, just the directory
-#' base name) to parse.
+#' @param model_batch_dir_path Path to the model batch
+#' directory to parse. Will parse only the basename.
 #' @return A list of quantities: `disease`, `report_date`,
 #' `first_training_date`, and `last_training_date`.
 #' @export
-parse_model_batch_dir_name <- function(model_batch_dir_name) {
+parse_model_batch_dir_path <- function(model_batch_dir_path) {
   pattern <- "(.+)_r_(.+)_f_(.+)_t_(.+)"
-
+  model_batch_dir_name <- fs::path_file(model_batch_dir_path)
   matches <- stringr::str_match(
     model_batch_dir_name,
     pattern
   )
 
-  if (is.na(matches[1])) {
+  if (any(is.na(matches))) {
     stop(
       "Invalid format for model batch directory name; ",
       "could not parse. Expected ",
@@ -37,12 +36,29 @@ parse_model_batch_dir_name <- function(model_batch_dir_name) {
     )
   }
 
-  return(list(
+  result <- list(
     disease = disease_map_lower[[matches[2]]],
-    report_date = lubridate::ymd(matches[3]),
-    first_training_date = lubridate::ymd(matches[4]),
-    last_training_date = lubridate::ymd(matches[5])
-  ))
+    report_date = lubridate::ymd(matches[3], quiet = TRUE),
+    first_training_date = lubridate::ymd(matches[4], quiet = TRUE),
+    last_training_date = lubridate::ymd(matches[5], quiet = TRUE)
+  )
+
+  if (any(sapply(result, is.null)) || any(sapply(result, is.na))) {
+    stop(
+      "Could not parse extracted disease and/or date ",
+      "values expected 'disease' to be one of 'covid-19' ",
+      "and 'influenza' and all dates to be valid dates in ",
+      "YYYY-MM-DD format. Got: ",
+      glue::glue(
+        "disease: {matches[[2]]}, ",
+        "report_date: {matches[[3]]}, ",
+        "first_training_date: {matches[[4]]}, ",
+        "last_training_date: {matches[[5]]}."
+      )
+    )
+  }
+
+  return(result)
 }
 
 #' Parse model run directory path.
@@ -65,7 +81,7 @@ parse_model_run_dir_path <- function(model_run_dir_path) {
 
   return(c(
     location = location,
-    parse_model_batch_dir_name(batch_dir)
+    parse_model_batch_dir_path(batch_dir)
   ))
 }
 

hewr/tests/testthat/test_directory_utils.R

@@ -1,4 +1,68 @@
-test_that("get_all_model_batch_dirs returns expected output", {
+test_that("parse_model_batch_dir_path() works as expected.", {
+  valid_pairs <- list(
+    list(
+      dirname = "covid-19_r_2024-02-03_f_2021-04-01_t_2024-01-23",
+      expected = list(
+        disease = "COVID-19",
+        report_date = lubridate::ymd("2024-02-03"),
+        first_training_date = lubridate::ymd("2021-04-1"),
+        last_training_date = lubridate::ymd("2024-01-23")
+      )
+    ),
+    list(
+      dirname = "influenza_r_2022-12-11_f_2021-02-05_t_2027-12-30",
+      expected = list(
+        disease = "Influenza",
+        report_date = lubridate::ymd("2022-12-11"),
+        first_training_date = lubridate::ymd("2021-02-5"),
+        last_training_date = lubridate::ymd("2027-12-30")
+      )
+    )
+  )
+
+  for (valid_pair in valid_pairs) {
+    ## should work with base dirnames that are valid
+    expect_equal(
+      parse_model_batch_dir_path(valid_pair$dirname),
+      valid_pair$expected
+    )
+
+    ## should work identically with a full path rather
+    ## than just base dir
+    also_valid <- fs::path("this/is/a/test", valid_pair$dirname)
+    expect_equal(
+      parse_model_batch_dir_path(also_valid),
+      valid_pair$expected
+    )
+
+    ## should error if the terminal directory is not
+    ## what is to be parsed
+    not_valid <- fs::path(valid_pair$dirname, "test")
+    expect_error(
+      {
+        parse_model_batch_dir_path(not_valid)
+      },
+      regex = "Invalid format for model batch directory name"
+    )
+  }
+
+  ## should error if entries cannot be parsed as what is expected
+  invalid_entries <- c(
+    "qcovid-19_r_2024-02-03_f_2021-04-01_t_2024-01-23",
+    "influenza_r_2022-12-33_f_2021-02-05_t_2027-12-30"
+  )
+
+  for (invalid_entry in invalid_entries) {
+    expect_error(
+      {
+        parse_model_batch_dir_path(invalid_entry)
+      },
+      regex = "Could not parse extracted disease and/or date values"
+    )
+  }
+})
+
+test_that("get_all_model_batch_dirs() returns expected output.", {
   withr::with_tempdir({
     ## create some directories
     valid_covid <- c(