recs from Nat, local checks passing

Author: dsweber2

R/archive.R

@@ -468,9 +468,10 @@ as_epi_archive <- function(
   x <- guess_column_name(x, "version", version_column_names())
   if (!test_subset(c("geo_value", "time_value", "version"), names(x))) {
     cli_abort(
-      "Either columns `geo_value`, `time_value`, and `version` must be present in `x`,
-or related columns (see the internal functions `guess_time_column_name()`,
-`guess_geo_column_name()` and/or `guess_geo_version_name()` for complete list)."
+      "Either columns `geo_value`, `time_value`, and `version`, or related columns
+      (see the internal functions `guess_time_column_name()`,
+      `guess_geo_column_name()` and/or `guess_geo_version_name()` for complete
+      list) must be present in `x`."
     )
   }
   if (anyMissing(x$version)) {

R/epi_df.R

@@ -273,8 +273,10 @@ as_epi_df.tbl_df <- function(x, geo_type, time_type, as_of,
   x <- guess_column_name(x, "geo_value", geo_column_names())
   if (!test_subset(c("geo_value", "time_value"), names(x))) {
     cli_abort(
-      "Either columns `geo_value` and `time_value` must be present in `x`, or related columns (see the internal
- functions `guess_time_column_name()` and/or `guess_geo_column_name()` for a complete list)."
+      "Either columns `geo_value` and `time_value` or related columns
+       (see the internal functions `guess_time_column_name()` and/or
+       `guess_geo_column_name()` for a complete list)
+       must be present in `x`."
     )
   }
 

R/utils.R

@@ -512,21 +512,37 @@ version_column_names <- function() {
 #' @param x the tibble to potentially rename
 #' @param substitutions a named vector. the potential substitions, with every name `time_value`
 #' @keywords internal
+#' @importFrom cli cli_inform cli_abort
+#' @importFrom dplyr rename
 guess_column_name <- function(x, column_name, substitutions) {
   if (!(column_name %in% names(x))) {
-    x <- tryCatch(x %>% rename(any_of(substitutions)),
-      error = function(cond) {
-        cli_abort("{names(x)[names(x) %in% substitutions]} are both/all valid substitutions.
-Either `rename` some yourself or drop some.")
-      }
-    )
     # if none of the names are in substitutions, and `column_name` isn't a column, we're missing a relevant column
     if (!any(names(x) %in% substitutions)) {
-      cli_abort("There is no {column_name} column or similar name. See e.g. [`time_column_name()`] for a complete list")
-    }
-    if (any(substitutions != "")) {
-      cli_inform("inferring {column_name} column.")
+      cli_abort(
+        "There is no {column_name} column or similar name.
+         See e.g. [`time_column_name()`] for a complete list",
+        class = "epiprocess__guess_column__multiple_substitution_error"
+      )
     }
+
+    tryCatch(
+      {
+        x <- x %>% rename(any_of(substitutions))
+        cli_inform(
+          "inferring {column_name} column.",
+          class = "epiprocess__guess_column_inferring_inform"
+        )
+        return(x)
+      },
+      error = function(cond) {
+        cli_abort(
+          "{intersect(names(x), substitutions)}
+           are both/all valid substitutions for {column_name}.
+           Either `rename` some yourself or drop some.",
+          class = "epiprocess__guess_column__multiple_substitution_error"
+        )
+      }
+    )
   }
   return(x)
 }

tests/testthat/test-archive.R

@@ -10,7 +10,7 @@ test_that("data.frame must contain geo_value, time_value and version columns", {
   expect_error(as_epi_archive(select(dt, -geo_value), compactify = FALSE),
     regexp = "There is no geo_value column or similar name"
   )
-  expect_error(expect_message(as_epi_archive(select(dt, -time_value), compactify = FALSE)),
+  expect_error(as_epi_archive(select(dt, -time_value), compactify = FALSE),
     regexp = "There is no time_value column or similar name"
   )
   expect_error(as_epi_archive(select(dt, -version), compactify = FALSE),
@@ -20,18 +20,24 @@ test_that("data.frame must contain geo_value, time_value and version columns", {
 
 test_that("as_epi_archive custom name mapping works correctly", {
   # custom name works correctly
-  suppressWarnings(expect_equal(
-    as_epi_archive(rename(dt, weirdName = version), version = weirdName),
-    as_epi_archive(dt)
-  ))
-  suppressWarnings(expect_equal(
-    as_epi_archive(rename(dt, weirdName = geo_value), geo_value = weirdName),
-    as_epi_archive(dt)
-  ))
-  suppressWarnings(expect_equal(
-    as_epi_archive(rename(dt, weirdName = time_value), time_value = weirdName),
-    as_epi_archive(dt)
-  ))
+  expect_equal(
+    as_epi_archive(rename(dt, weirdName = version),
+      version = weirdName, compactify = TRUE
+    ),
+    as_epi_archive(dt, compactify = TRUE)
+  )
+  expect_equal(
+    as_epi_archive(rename(dt, weirdName = geo_value),
+      geo_value = weirdName, compactify = TRUE
+    ),
+    as_epi_archive(dt, compactify = TRUE)
+  )
+  expect_equal(
+    as_epi_archive(rename(dt, weirdName = time_value),
+      time_value = weirdName, compactify = TRUE
+    ),
+    as_epi_archive(dt, compactify = TRUE)
+  )
 
   expect_error(
     as_epi_archive(

tests/testthat/test-epi_df.R

@@ -52,22 +52,33 @@ test_that("as_epi_df works for nonstandard input", {
     date = rep(seq(as.Date("2020-01-01"), by = 1, length.out = 5), times = 2),
     geo_value = rep(c("ca", "hi"), each = 5)
   )
-  expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df()))
+  expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df()),
+    class = "epiprocess__guess_column_inferring_inform"
+  )
   expect_no_error(tib_epi_df <- tib %>% as_epi_df(time_value = date, geo_value = geo_value))
-  expect_error(expect_message(
-    tib %>% rename(awefa = geo_value) %>% as_epi_df(),
-    regexp = "inferring "
-  ))
+  expect_error(
+    expect_message(
+      tib %>%
+        rename(awefa = geo_value) %>%
+        as_epi_df(),
+      class = "epiprocess__guess_column_inferring_inform"
+    ),
+    class = "epiprocess__guess_column__multiple_substitution_error"
+  )
   expect_no_error(expect_message(
     tib %>% rename(awefa = geo_value) %>% as_epi_df(geo_value = awefa),
-    regexp = "inferring"
+    class = "epiprocess__guess_column_inferring_inform"
   ))
 
   tib <- tib %>% rename(target_date = date)
-  expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df()))
+  expect_message(expect_no_error(tib_epi_df <- tib %>% as_epi_df()),
+    class = "epiprocess__guess_column_inferring_inform"
+  )
 
   tib <- tib %>% mutate(Time = 20 + target_date)
-  expect_error(tib_epi_df <- tib %>% as_epi_df())
+  expect_error(tib_epi_df <- tib %>% as_epi_df(),
+    class = "epiprocess__guess_column__multiple_substitution_error"
+  )
 })
 
 # select fixes