Closes #151 - Metadata includes verbose option

NEWS.md

@@ -2,6 +2,10 @@
 
 ## New Features and Bug Fixes
 
+* `xportr_metadata()` can set `verbose` for a whole pipeline
+
+## Documentation
+
 * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`.
 * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179)
 

R/label.R

@@ -59,7 +59,7 @@
 xportr_label <- function(.df,
                          metadata = NULL,
                          domain = NULL,
-                         verbose = getOption("xportr.label_verbose", "none"),
+                         verbose = NULL,
                          metacore = deprecated()) {
   if (!missing(metacore)) {
     lifecycle::deprecate_warn(
@@ -101,6 +101,12 @@ xportr_label <- function(.df,
   # Check any variables missed in metadata but present in input data ---
   miss_vars <- setdiff(names(.df), metadata[[variable_name]])
 
+  # Verbose should use an explicit verbose option first, then the value set in
+  # metadata, and finally fall back to the option value
+  verbose <- verbose %||%
+    attr(.df, "_xportr.df_verbose_") %||%
+    getOption("xportr.label_verbose", "none")
+
   label_log(miss_vars, verbose)
 
   label <- metadata[[variable_label]]

R/length.R

@@ -66,7 +66,7 @@
 xportr_length <- function(.df,
                           metadata = NULL,
                           domain = NULL,
-                          verbose = getOption("xportr.length_verbose", "none"),
+                          verbose = NULL,
                           metacore = deprecated()) {
   if (!missing(metacore)) {
     lifecycle::deprecate_warn(
@@ -108,6 +108,12 @@ xportr_length <- function(.df,
   # Check any variables missed in metadata but present in input data ---
   miss_vars <- setdiff(names(.df), metadata[[variable_name]])
 
+  # Verbose should use an explicit verbose option first, then the value set in
+  # metadata, and finally fall back to the option value
+  verbose <- verbose %||%
+    attr(.df, "_xportr.df_verbose_") %||%
+    getOption("xportr.length_verbose", "none")
+
   length_log(miss_vars, verbose)
 
   length <- metadata[[variable_length]]

R/metadata.R

@@ -37,7 +37,10 @@
 #'     xportr_type() %>%
 #'     xportr_order()
 #' }
-xportr_metadata <- function(.df, metadata, domain = NULL) {
+xportr_metadata <- function(.df,
+                            metadata,
+                            domain = NULL,
+                            verbose = NULL) {
   ## Common section to detect domain from argument or pipes
 
   df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
@@ -46,5 +49,8 @@ xportr_metadata <- function(.df, metadata, domain = NULL) {
 
   ## End of common section
 
-  structure(.df, `_xportr.df_metadata_` = metadata)
+  structure(.df,
+    `_xportr.df_metadata_` = metadata,
+    `_xportr.df_verbose_` = verbose
+  )
 }

R/order.R

@@ -62,7 +62,7 @@
 xportr_order <- function(.df,
                          metadata = NULL,
                          domain = NULL,
-                         verbose = getOption("xportr.order_verbose", "none"),
+                         verbose = NULL,
                          metacore = deprecated()) {
   if (!missing(metacore)) {
     lifecycle::deprecate_warn(
@@ -122,6 +122,12 @@ xportr_order <- function(.df,
   # Used in warning message for how many vars have been moved
   reorder_vars <- names(df_re_ord)[names(df_re_ord) != names(.df)]
 
+  # Verbose should use an explicit verbose option first, then the value set in
+  # metadata, and finally fall back to the option value
+  verbose <- verbose %||%
+    attr(.df, "_xportr.df_verbose_") %||%
+    getOption("xportr.order_verbose", "none")
+
   # Function is located in messages.R
   var_ord_msg(reorder_vars, names(drop_vars), verbose)
 

R/type.R

@@ -79,7 +79,7 @@
 xportr_type <- function(.df,
                         metadata = NULL,
                         domain = NULL,
-                        verbose = getOption("xportr.type_verbose", "none"),
+                        verbose = NULL,
                         metacore = deprecated()) {
   if (!missing(metacore)) {
     lifecycle::deprecate_warn(
@@ -148,6 +148,12 @@ xportr_type <- function(.df,
       type.y = if_else(type.y %in% numericTypes, "_numeric", type.y)
     )
 
+  # Verbose should use an explicit verbose option first, then the value set in
+  # metadata, and finally fall back to the option value
+  verbose <- verbose %||%
+    attr(.df, "_xportr.df_verbose_") %||%
+    getOption("xportr.type_verbose", "none")
+
   # It is possible that a variable exists in the table that isn't in the metadata
   # it will be silently ignored here. This may happen depending on what a user
   # passes and the options they choose. The check_core function is the place

README.Rmd

@@ -144,7 +144,7 @@ The `xportr_metadata()` function can reduce duplication by setting the variable
 
 ```{r, message=FALSE, eval=FALSE}
 adsl %>%
-  xportr_metadata(var_spec, "ADSL") %>%
+  xportr_metadata(var_spec, "ADSL", verbose = "warn") %>%
   xportr_type() %>%
   xportr_length() %>%
   xportr_label() %>%

tests/testthat/test-length.R

@@ -128,6 +128,13 @@ test_that("xportr_length: Impute character lengths based on class", {
     expect_message("Variable lengths missing from metadata") %>%
     expect_message("lengths resolved") %>%
     expect_attr_width(c(7, 199, 200, 200, 8))
+
+  adsl %>%
+    xportr_metadata(metadata, verbose = "none") %>%
+    xportr_length() %>%
+    expect_message("Variable lengths missing from metadata") %>%
+    expect_message("lengths resolved") %>%
+    expect_attr_width(c(7, 199, 200, 200, 8))
 })
 
 test_that("xportr_length: Throws message when variables not present in metadata", {
@@ -144,6 +151,12 @@ test_that("xportr_length: Throws message when variables not present in metadata"
     expect_message("Variable lengths missing from metadata") %>%
     expect_message("lengths resolved") %>%
     expect_message(regexp = "Problem with `y`")
+
+  xportr_metadata(adsl, metadata, verbose = "message") %>%
+    xportr_length() %>%
+    expect_message("Variable lengths missing from metadata") %>%
+    expect_message("lengths resolved") %>%
+    expect_message(regexp = "Problem with `y`")
 })
 
 test_that("xportr_length: Metacore instance can be used", {

tests/testthat/test-order.R

@@ -136,6 +136,19 @@ test_that("xportr_order: Variable ordering messaging is correct", {
     expect_message("2 variables not in spec and moved to end") %>%
     expect_message("Variable moved to end in `.df`: `a` and `z`") %>%
     expect_message("All variables in dataset are ordered")
+
+  # Metadata versions
+  xportr_metadata(df, df_meta, verbose = "message") %>%
+    xportr_order() %>%
+    expect_message("All variables in specification file are in dataset") %>%
+    expect_condition("4 reordered in dataset") %>%
+    expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`")
+
+  xportr_metadata(df2, df_meta, verbose = "message") %>%
+    xportr_order() %>%
+    expect_message("2 variables not in spec and moved to end") %>%
+    expect_message("Variable moved to end in `.df`: `a` and `z`") %>%
+    expect_message("All variables in dataset are ordered")
 })
 
 test_that("xportr_order: Metadata order columns are coersed to numeric", {

tests/testthat/test-type.R

@@ -66,6 +66,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes
   (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn"))) %>%
     expect_warning()
 
+  # Metadata version of the last statement
+  df %>%
+    xportr_metadata(meta_example, verbose = "warn") %>%
+    xportr_type() %>%
+    expect_warning()
+
   expect_equal(purrr::map_chr(df3, class), c(
     Subj = "numeric", Different = "character",
     Val = "numeric", Param = "character"
@@ -77,6 +83,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes
       expect_message("Variable type\\(s\\) in dataframe don't match metadata")
   )
 
+  # Metadata version
+  df %>%
+    xportr_metadata(meta_example, verbose = "message") %>%
+    xportr_type() %>%
+    expect_message("Variable type\\(s\\) in dataframe don't match metadata")
+
   expect_equal(purrr::map_chr(df4, class), c(
     Subj = "numeric", Different = "character",
     Val = "numeric", Param = "character"
@@ -100,12 +112,12 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", {
   ))
 
   suppressMessages(
-    xportr_metadata(df, meta_example) %>% xportr_type(verbose = "stop")
+    xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type()
   ) %>%
     expect_error()
 
   suppressMessages(
-    df3 <- xportr_metadata(df, meta_example) %>% xportr_type(verbose = "warn")
+    df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type()
   ) %>%
     expect_warning()
 
@@ -116,8 +128,8 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", {
 
   suppressMessages({
     (
-      df4 <- xportr_metadata(df, meta_example) %>%
-        xportr_type(verbose = "message")
+      df4 <- xportr_metadata(df, meta_example, verbose = "message") %>%
+        xportr_type()
     ) %>%
       expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`")
   })