Add missing domain logging

NEWS.md

@@ -1,5 +1,8 @@
 # xportr (development version)
 
+* Added logging to the `domain` argument in `xportr` functions to notify user if
+the domain passed doesn't exist in the metadata. (#260)
+
 * `"hms"` was added to the default value of the `xportr.numeric_types` option.
 This ensures that `{xportr}` works smoothly with variables created by
 `admiral::derive_vars_dtm_to_tm()`. (#271)

R/format.R

@@ -139,6 +139,9 @@ xportr_format <- function(.df,
   if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
+    # If 'domain' passed by user isn't found in metadata, return error
+    if (!domain %in% metadata[[domain_name]]) log_no_domain(domain, domain_name, verbose)
+
     metadata <- metadata %>%
       filter(!!sym(domain_name) == .env$domain & !is.na(!!sym(format_name)))
   } else {

R/label.R

@@ -96,6 +96,9 @@ xportr_label <- function(.df,
   if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
+    # If 'domain' passed by user isn't found in metadata, return error
+    if (!domain %in% metadata[[domain_name]]) log_no_domain(domain, domain_name, verbose)
+
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == .env$domain)
   } else {

R/length.R

@@ -105,6 +105,9 @@ xportr_length <- function(.df,
   if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
+    # If 'domain' passed by user isn't found in metadata, return error
+    if (!domain %in% metadata[[domain_name]]) log_no_domain(domain, domain_name, verbose)
+
     metadata <- metadata %>%
       filter(!!sym(domain_name) == .env$domain)
   } else {

R/messages.R

@@ -242,3 +242,21 @@ max_length_msg <- function(max_length, verbose) {
     )
   }
 }
+
+#' Utility for Missing Domain
+#'
+#' @param domain Domain passed by user
+#' @param domain_name Name of the domain column in metadata
+#' @param verbose Provides additional messaging for user
+#'
+#' @return Output to Console
+#' @noRd
+log_no_domain <- function(domain, domain_name, verbose) {
+  cli_h2("Domain not found in metadata.")
+  xportr_logger(
+    glue(
+      "Domain '{domain}' not found in metadata '{domain_name}' column."
+    ),
+    type = verbose
+  )
+}

R/order.R

@@ -99,6 +99,9 @@ xportr_order <- function(.df,
   if (inherits(metadata, "Metacore")) metadata <- metadata$ds_vars
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
+    # If 'domain' passed by user isn't found in metadata, return error
+    if (!domain %in% metadata[[domain_name]]) log_no_domain(domain, domain_name, verbose)
+
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == .env$domain & !is.na(!!sym(order_name)))
   } else {

R/type.R

@@ -113,6 +113,9 @@ xportr_type <- function(.df,
   if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
+    # If 'domain' passed by user isn't found in metadata, return error
+    if (!domain %in% metadata[[domain_name]]) log_no_domain(domain, domain_name, verbose)
+
     metadata <- metadata %>%
       filter(!!sym(domain_name) == .env$domain)
   }

tests/testthat/test-messages.R

@@ -76,3 +76,14 @@ test_that("messages Test 4: Renamed variables messages are shown", {
     expect_message("Var . : '.*' was renamed to '.*'") %>%
     expect_message("Duplicate renamed term\\(s\\) were created")
 })
+
+# no_domain_log ----
+## Test 5: no_domain_log: No domain messages are shown ----
+test_that("messages Test 5: No domain messages are shown", {
+  # Remove empty lines in cli theme
+  local_cli_theme()
+
+  log_no_domain("adsl", "domains", "message") %>%
+    expect_message("Domain not found in metadata.") %>%
+    expect_message("Domain 'adsl' not found in metadata 'domains' column.")
+})

tests/testthat/test-type.R

@@ -231,11 +231,11 @@ test_that("type Test 7: xportr_type: date variables are not converted to numeric
   adsl_original$RFICDTM <- as.POSIXct(adsl_original$RFICDTM)
 
   expect_message(
-    adsl_xpt2 <- adsl_original %>% xportr_type(metadata, domain = "adsl_original"),
+    adsl_xpt2 <- adsl_original %>% xportr_type(metadata, domain = "adsl"),
     NA
   )
 
-  attr(adsl_original, "_xportr.df_arg_") <- "adsl_original"
+  attr(adsl_original, "_xportr.df_arg_") <- "adsl"
 
   expect_equal(adsl_original, adsl_xpt2)
 })