Extend xportr_write to accept metadata and deprecate label

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: xportr
 Title: Utilities to Output CDISC SDTM/ADaM XPT Files
-Version: 0.3.1
+Version: 0.3.1.9001
 Authors@R: 
     c(
     person(given = "Eli",

NEWS.md

@@ -1,3 +1,11 @@
+# xportr 0.3.1.9001
+
+## New Features and Bug Fixes
+* `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()`.
+
+## Deprecation and Breaking Changes
+* The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument.
+
 # xportr 0.3.0
 
 ## New Features and Bug Fixes

R/df_label.R

@@ -83,6 +83,10 @@ xportr_df_label <- function(.df,
     abort("Length of dataset label must be 40 characters or less.")
   }
 
+  if (stringr::str_detect(label, "[^[:ascii:]]")) {
+    abort("`label` cannot contain any non-ASCII, symbol or special characters.")
+  }
+
   attr(.df, "label") <- label
 
   .df

R/write.R

@@ -7,10 +7,12 @@
 #' @param .df A data frame to write.
 #' @param path Path where transport file will be written. File name sans will be
 #'   used as `xpt` name.
-#' @param label Dataset label. It must be <=40 characters.
+#' @param label `r lifecycle::badge("deprecated")` Previously used to to set the Dataset label.
+#' Use the `metadata` argument to set the dataset label.
 #' @param strict_checks If TRUE, xpt validation will report errors and not write
 #'   out the dataset. If FALSE, xpt validation will report warnings and continue
 #'   with writing out the dataset. Defaults to FALSE
+#' @inheritParams xportr_length
 #'
 #' @details
 #'   * Variable and dataset labels are stored in the "label" attribute.
@@ -32,17 +34,43 @@
 #'   Param = c("param1", "param2", "param3")
 #' )
 #'
+#' var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset")
 #' xportr_write(adsl,
 #'   path = paste0(tempdir(), "/adsl.xpt"),
-#'   label = "Subject-Level Analysis",
+#'   metadata = var_spec,
 #'   strict_checks = FALSE
 #' )
 #'
-xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) {
+xportr_write <- function(.df,
+                         path,
+                         metadata = NULL,
+                         domain = NULL,
+                         strict_checks = FALSE,
+                         label = deprecated()) {
   path <- normalizePath(path, mustWork = FALSE)
 
   name <- tools::file_path_sans_ext(basename(path))
 
+  ## Common section to detect domain from argument or pipes
+
+  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
+  domain <- get_domain(.df, df_arg, domain)
+  if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
+
+  ## End of common section
+
+  if (!missing(label)) {
+    lifecycle::deprecate_warn(
+      when = "0.3.2",
+      what = "xportr_write(label = )",
+      with = "xportr_write(metadata = )"
+    )
+    metadata <- data.frame(dataset = domain, label = label)
+  }
+  if (!is.null(metadata)) {
+    .df <- xportr_df_label(.df, metadata = metadata, domain = domain)
+  }
+
   if (nchar(name) > 8) {
     abort("`.df` file name must be 8 characters or less.")
   }
@@ -51,18 +79,6 @@ xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) {
     abort("`.df` cannot contain any non-ASCII, symbol or underscore characters.")
   }
 
-  if (!is.null(label)) {
-    if (nchar(label) > 40) {
-      abort("`label` must be 40 characters or less.")
-    }
-
-    if (stringr::str_detect(label, "[^[:ascii:]]")) {
-      abort("`label` cannot contain any non-ASCII, symbol or special characters.")
-    }
-
-    attr(.df, "label") <- label
-  }
-
   checks <- xpt_validate(.df)
 
   if (length(checks) > 0) {

README.Rmd

@@ -132,7 +132,7 @@ adsl %>%
   xportr_label(var_spec, "ADSL", verbose = "warn") %>%
   xportr_order(var_spec, "ADSL", verbose = "warn") %>%
   xportr_format(var_spec, "ADSL") %>%
-  xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset")
+  xportr_write("adsl.xpt")
 ```
 
 The `xportr_metadata()` function can reduce duplication by setting the variable specification and domain explicitly at the top of a pipeline. If you would like to use the `verbose` argument, you will need to set in each function call.
@@ -145,7 +145,7 @@ adsl %>%
   xportr_label() %>%
   xportr_order() %>%
   xportr_format() %>%
-  xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset")
+  xportr_write("adsl.xpt")
 ```
 
 That's it!  We now have a xpt file created in R with all appropriate types, lengths, labels, ordering and formats.  Please check out the [Get Started](https://atorus-research.github.io/xportr/articles/xportr.html) for more information and detailed walk through of each `xportr_` function.

README.md

@@ -140,7 +140,7 @@ adsl %>%
   xportr_label(var_spec, "ADSL", verbose = "warn") %>%
   xportr_order(var_spec, "ADSL", verbose = "warn") %>%
   xportr_format(var_spec, "ADSL") %>%
-  xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset")
+  xportr_write("adsl.xpt")
 ```
 
 The `xportr_metadata()` function can reduce duplication by setting the
@@ -156,7 +156,7 @@ adsl %>%
   xportr_label() %>%
   xportr_order() %>%
   xportr_format() %>%
-  xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset")
+  xportr_write("adsl.xpt")
 ```
 
 That’s it! We now have a xpt file created in R with all appropriate

tests/testthat/test-write.R

@@ -10,13 +10,48 @@ test_that("xportr_write: exported data can be saved to a file", {
   expect_equal(read_xpt(tmp), data_to_save)
 })
 
-test_that("xportr_write: exported data can be saved to a file with a label", {
+test_that("xportr_write: exported data can still be saved to a file with a label", {
   tmpdir <- tempdir()
   tmp <- file.path(tmpdir, "xyz.xpt")
 
   on.exit(unlink(tmpdir))
 
-  xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet")
+  suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet"))
+  expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet")
+})
+
+test_that("xportr_write: exported data can be saved to a file with a metadata", {
+  tmpdir <- tempdir()
+  tmp <- file.path(tmpdir, "xyz.xpt")
+
+  on.exit(unlink(tmpdir))
+
+  xportr_write(
+    data_to_save,
+    path = tmp,
+    metadata = data.frame(
+      dataset = "data_to_save",
+      label = "Lorem ipsum dolor sit amet"
+    )
+  )
+  expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet")
+})
+
+test_that("xportr_write: exported data can be saved to a file with a existing metadata", {
+  tmpdir <- tempdir()
+  tmp <- file.path(tmpdir, "xyz.xpt")
+
+  on.exit(unlink(tmpdir))
+
+  df <- xportr_df_label(
+    data_to_save,
+    data.frame(
+      dataset = "data_to_save",
+      label = "Lorem ipsum dolor sit amet"
+    )
+  )
+
+  xportr_write(df, path = tmp)
   expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet")
 })
 
@@ -26,7 +61,16 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in
 
   on.exit(unlink(tmpdir))
 
-  expect_error(xportr_write(data_to_save, tmp, label = "Lorizzle ipsizzle dolizzl\xe7 pizzle"))
+  expect_error(
+    xportr_write(
+      data_to_save,
+      tmp,
+      metadata = data.frame(
+        dataset = "data_to_save",
+        label = "Lorizzle ipsizzle dolizzl\xe7 pizzle"
+      )
+    )
+  )
 })
 
 test_that("xportr_write: expect error when file name is over 8 characters long", {
@@ -35,7 +79,7 @@ test_that("xportr_write: expect error when file name is over 8 characters long",
 
   on.exit(unlink(tmpdir))
 
-  expect_error(xportr_write(data_to_save, tmp, label = "asdf"))
+  expect_error(xportr_write(data_to_save, tmp))
 })
 
 test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", {
@@ -44,7 +88,7 @@ test_that("xportr_write: expect error when file name contains non-ASCII symbols
 
   on.exit(unlink(tmpdir))
 
-  expect_error(xportr_write(data_to_save, tmp, label = "asdf"))
+  expect_error(xportr_write(data_to_save, tmp))
 })
 
 test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", {
@@ -53,7 +97,22 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s
 
   on.exit(unlink(tmpdir))
 
-  expect_error(xportr_write(data_to_save, tmp, label = "çtestç"))
+  expect_error(
+    xportr_write(
+      data_to_save,
+      tmp,
+      expect_error(
+        xportr_write(
+          data_to_save,
+          tmp,
+          metadata = data.frame(
+            dataset = "data_to_save",
+            label = "çtestç"
+          )
+        )
+      )
+    )
+  )
 })
 
 test_that("xportr_write: expect error when label is over 40 characters", {
@@ -62,7 +121,16 @@ test_that("xportr_write: expect error when label is over 40 characters", {
 
   on.exit(unlink(tmpdir))
 
-  expect_error(xportr_write(data_to_save, tmp, label = paste(rep("a", 41), collapse = "")))
+  expect_error(
+    xportr_write(
+      data_to_save,
+      tmp,
+      metadata = data.frame(
+        dataset = "data_to_save",
+        label = paste(rep("a", 41), collapse = "")
+      )
+    )
+  )
 })
 
 test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", {
@@ -72,7 +140,16 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c
 
   on.exit(unlink(tmpdir))
 
-  expect_error(xportr_write(data_to_save, tmp, label = "label", strict_checks = TRUE))
+  expect_error(
+    xportr_write(
+      data_to_save, tmp,
+      metadata = data.frame(
+        dataset = "data_to_save",
+        label = "label"
+      ),
+      strict_checks = TRUE
+    )
+  )
 })
 
 test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", {
@@ -82,18 +159,18 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict
 
   on.exit(unlink(tmpdir))
 
-  expect_warning(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE))
+  expect_warning(
+    xportr_write(
+      data_to_save, tmp,
+      metadata = data.frame(
+        dataset = "data_to_save",
+        label = "label"
+      ),
+      strict_checks = FALSE
+    )
+  )
 })
 
-test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", {
-  tmpdir <- tempdir()
-  tmp <- file.path(tmpdir, "xyz.xpt")
-  attr(data_to_save$X, "format.sas") <- "foo"
-
-  on.exit(unlink(tmpdir))
-
-  expect_warning(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE))
-})
 
 test_that("xportr_write: Capture errors by haven and report them as such", {
   tmpdir <- tempdir()
@@ -102,8 +179,18 @@ test_that("xportr_write: Capture errors by haven and report them as such", {
 
   on.exit(unlink(tmpdir))
 
+
   expect_error(
-    suppressWarnings(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE)),
+    suppressWarnings(
+      xportr_write(
+        data_to_save, tmp,
+        metadata = data.frame(
+          dataset = "data_to_save",
+          label = "label"
+        ),
+        strict_checks = FALSE
+      )
+    ),
     "Error reported by haven"
   )
 })