From 0bb0ef8756432aa9321c4327b0a2f1568e297969 Mon Sep 17 00:00:00 2001
From: EeethB <ethanbrockmann@gmail.com>
Date: Tue, 5 Dec 2023 21:55:13 +0000
Subject: [PATCH] Add `verbose` option to metadata

---
 R/label.R                    |  8 +++++++-
 R/length.R                   |  8 +++++++-
 R/order.R                    |  8 +++++++-
 man/xportr_metadata.Rd       |  6 +++++-
 man/xportr_type.Rd           |  2 +-
 tests/testthat/test-length.R | 13 +++++++++++++
 tests/testthat/test-order.R  | 13 +++++++++++++
 tests/testthat/test-type.R   | 20 ++++++++++++++++----
 8 files changed, 69 insertions(+), 9 deletions(-)

diff --git a/R/label.R b/R/label.R
index e412e9fc..3409c091 100644
--- a/R/label.R
+++ b/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]]
diff --git a/R/length.R b/R/length.R
index 17627268..e1fddefa 100644
--- a/R/length.R
+++ b/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]]
diff --git a/R/order.R b/R/order.R
index 0f7e1b30..1b5b7ce8 100644
--- a/R/order.R
+++ b/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)
 
diff --git a/man/xportr_metadata.Rd b/man/xportr_metadata.Rd
index 592c6f45..c8e7fc8b 100644
--- a/man/xportr_metadata.Rd
+++ b/man/xportr_metadata.Rd
@@ -4,7 +4,7 @@
 \alias{xportr_metadata}
 \title{Set variable specifications and domain}
 \usage{
-xportr_metadata(.df, metadata, domain = NULL)
+xportr_metadata(.df, metadata, domain = NULL, verbose = NULL)
 }
 \arguments{
 \item{.df}{A data frame of CDISC standard.}
@@ -15,6 +15,10 @@ xportr_metadata(.df, metadata, domain = NULL)
 \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset
 the metadata object. If none is passed, then name of the dataset passed as
 .df will be used.}
+
+\item{verbose}{The action this function takes when an action is taken on the
+dataset or function validation finds an issue. See 'Messaging' section for
+details. Options are 'stop', 'warn', 'message', and 'none'}
 }
 \value{
 \code{.df} dataset with metadata and domain attributes set
diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd
index abfa41d8..dd605ddc 100644
--- a/man/xportr_type.Rd
+++ b/man/xportr_type.Rd
@@ -8,7 +8,7 @@ xportr_type(
   .df,
   metadata = NULL,
   domain = NULL,
-  verbose = getOption("xportr.type_verbose", "none"),
+  verbose = NULL,
   metacore = deprecated()
 )
 }
diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R
index e749684d..d77ecd50 100644
--- a/tests/testthat/test-length.R
+++ b/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", {
diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R
index 801108c4..5f666cce 100644
--- a/tests/testthat/test-order.R
+++ b/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", {
diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R
index d5841a63..fa2ad2b6 100644
--- a/tests/testthat/test-type.R
+++ b/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`")
   })