Merge pull request #280 from atorus-research/issue-260

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)
+
 * Updated order messaging to clarify some messaging when all data in dataset is
 found in the specification. (#269)
 

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,32 @@ 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.")
+
+  adsl <- data.frame(
+    USUBJID = c(1001, 1002, 1003),
+    BRTHDT = c(1, 1, 2)
+  )
+
+  metadata <- data.frame(
+    dataset = c("adsl", "adsl"),
+    variable = c("USUBJID", "BRTHDT"),
+    order = c(1, 2)
+  )
+
+  xportr_order(adsl, metadata, "wrong_adsl", verbose = "message") %>%
+    expect_message("Domain not found in metadata.") %>%
+    expect_message("Domain 'wrong_adsl' not found in metadata 'dataset' column.") %>%
+    expect_message("2 variables not in spec and moved to end") %>%
+    expect_message("Variable moved to end in `.df`: `USUBJID` and `BRTHDT`") %>%
+    expect_message("All variables in dataset are ordered")
+})

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)
 })