Merge branch 'main' into 126_filename_checks

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: xportr
 Title: Utilities to Output CDISC SDTM/ADaM XPT Files
-Version: 0.3.1.9004
+Version: 0.3.1.9006
 Authors@R: c(
     person("Eli", "Miller", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-2127-9456")),

NEWS.md

@@ -10,7 +10,12 @@
 
 ## Deprecation and Breaking Changes
 
+* The `domain` argument for xportr functions will no longer be dynamically 
+determined by the name of the data frame passed as the .df argument. This was
+done to make the use of xportr functions more explicit. (#182)
+
 * The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. (#179)
+* The `metacore` argument, which was renamed to `metadata` in the following six xportr functions: (`xportr_df_label()`, `xportr_format()`, `xportr_label()`, `xportr_length()`, `xportr_order()`, and `xportr_type()`) in version `0.3.0` with a soft deprecation warning, has now been hard deprecated. Please update your code to use the new `metadata` argument in place of `metacore`.
 
 ## Documentation
 

R/df_label.R

@@ -38,26 +38,24 @@
 #'   label = c("Subject-Level Analysis", "Adverse Events Analysis")
 #' )
 #'
-#' adsl <- xportr_df_label(adsl, metadata)
+#' adsl <- xportr_df_label(adsl, metadata, domain = "adsl")
 xportr_df_label <- function(.df,
                             metadata = NULL,
                             domain = NULL,
                             metacore = deprecated()) {
   if (!missing(metacore)) {
-    lifecycle::deprecate_warn(
-      when = "0.3.0",
+    lifecycle::deprecate_stop(
+      when = "0.3.1.9005",
       what = "xportr_df_label(metacore = )",
       with = "xportr_df_label(metadata = )"
     )
-    metadata <- metacore
   }
   domain_name <- getOption("xportr.df_domain_name")
   label_name <- getOption("xportr.df_label")
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section

R/format.R

@@ -40,27 +40,25 @@
 #'   format = c(NA, "DATE9.")
 #' )
 #'
-#' adsl <- xportr_format(adsl, metadata)
+#' adsl <- xportr_format(adsl, metadata, domain = "adsl")
 xportr_format <- function(.df,
                           metadata = NULL,
                           domain = NULL,
                           metacore = deprecated()) {
   if (!missing(metacore)) {
-    lifecycle::deprecate_warn(
-      when = "0.3.0",
+    lifecycle::deprecate_stop(
+      when = "0.3.1.9005",
       what = "xportr_format(metacore = )",
       with = "xportr_format(metadata = )"
     )
-    metadata <- metacore
   }
   domain_name <- getOption("xportr.domain_name")
   format_name <- getOption("xportr.format_name")
   variable_name <- getOption("xportr.variable_name")
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section
@@ -73,7 +71,7 @@ xportr_format <- function(.df,
     metadata <- metadata$var_spec
   }
 
-  if (domain_name %in% names(metadata)) {
+  if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(format_name)))
   } else {

R/label.R

@@ -55,28 +55,26 @@
 #'   label = c("Unique Subject Identifier", "Study Site Identifier", "Age", "Sex")
 #' )
 #'
-#' adsl <- xportr_label(adsl, metadata)
+#' adsl <- xportr_label(adsl, metadata, domain = "adsl")
 xportr_label <- function(.df,
                          metadata = NULL,
                          domain = NULL,
                          verbose = getOption("xportr.label_verbose", "none"),
                          metacore = deprecated()) {
   if (!missing(metacore)) {
-    lifecycle::deprecate_warn(
-      when = "0.3.0",
+    lifecycle::deprecate_stop(
+      when = "0.3.1.9005",
       what = "xportr_label(metacore = )",
       with = "xportr_label(metadata = )"
     )
-    metadata <- metacore
   }
   domain_name <- getOption("xportr.domain_name")
   variable_name <- getOption("xportr.variable_name")
   variable_label <- getOption("xportr.label")
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section
@@ -89,7 +87,7 @@ xportr_label <- function(.df,
     metadata <- metadata$var_spec
   }
 
-  if (domain_name %in% names(metadata)) {
+  if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == domain)
   } else {

R/length.R

@@ -9,8 +9,8 @@
 #' @param metadata A data frame containing variable level metadata. See
 #'   'Metadata' section for details.
 #' @param 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.
+#'   the metadata object. If none is passed, then  [xportr_metadata()] must be
+#'   called before hand to set the domain as an attribute of `.df`.
 #' @param 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'
@@ -62,28 +62,26 @@
 #'   length = c(10, 8)
 #' )
 #'
-#' adsl <- xportr_length(adsl, metadata)
+#' adsl <- xportr_length(adsl, metadata, domain = "adsl")
 xportr_length <- function(.df,
                           metadata = NULL,
                           domain = NULL,
                           verbose = getOption("xportr.length_verbose", "none"),
                           metacore = deprecated()) {
   if (!missing(metacore)) {
-    lifecycle::deprecate_warn(
-      when = "0.3.0",
+    lifecycle::deprecate_stop(
+      when = "0.3.1.9005",
       what = "xportr_length(metacore = )",
       with = "xportr_length(metadata = )"
     )
-    metadata <- metacore
   }
   domain_name <- getOption("xportr.domain_name")
   variable_length <- getOption("xportr.length")
   variable_name <- getOption("xportr.variable_name")
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section
@@ -96,7 +94,7 @@ xportr_length <- function(.df,
     metadata <- metadata$var_spec
   }
 
-  if (domain_name %in% names(metadata)) {
+  if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
       filter(!!sym(domain_name) == domain)
   } else {

R/metadata.R

@@ -1,15 +1,18 @@
 #' Set variable specifications and domain
 #'
-#' Sets metadata for a dataset in a way that can be accessed by other xportr
-#' functions. If used at the start of an xportr pipeline, it removes the need to
-#' set metadata and domain at each step individually. For details on the format
-#' of the metadata, see the 'Metadata' section for each function in question.
+#' Sets metadata and/or domain for a dataset in a way that can be accessed by
+#' other xportr functions. If used at the start of an xportr pipeline, it
+#' removes the need to set metadata and domain at each step individually. For
+#' details on the format of the metadata, see the 'Metadata' section for each
+#' function in question.
 #'
 #' @inheritParams xportr_length
 #'
 #' @return `.df` dataset with metadata and domain attributes set
 #' @export
 #'
+#' @rdname metadata
+#'
 #' @examples
 #'
 #' metadata <- data.frame(
@@ -37,11 +40,13 @@
 #'     xportr_type() %>%
 #'     xportr_order()
 #' }
-xportr_metadata <- function(.df, metadata, domain = NULL) {
-  ## Common section to detect domain from argument or pipes
+xportr_metadata <- function(.df, metadata = NULL, domain = NULL) {
+  if (is.null(metadata) && is.null(domain)) {
+    stop("Must provide either metadata or domain argument")
+  }
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section

R/order.R

@@ -58,28 +58,26 @@
 #'   order = 1:4
 #' )
 #'
-#' adsl <- xportr_order(adsl, metadata)
+#' adsl <- xportr_order(adsl, metadata, domain = "adsl")
 xportr_order <- function(.df,
                          metadata = NULL,
                          domain = NULL,
                          verbose = getOption("xportr.order_verbose", "none"),
                          metacore = deprecated()) {
   if (!missing(metacore)) {
-    lifecycle::deprecate_warn(
-      when = "0.3.0",
+    lifecycle::deprecate_stop(
+      when = "0.3.1.9005",
       what = "xportr_order(metacore = )",
       with = "xportr_order(metadata = )"
     )
-    metadata <- metacore
   }
   domain_name <- getOption("xportr.domain_name")
   order_name <- getOption("xportr.order_name")
   variable_name <- getOption("xportr.variable_name")
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section
@@ -92,7 +90,7 @@ xportr_order <- function(.df,
     metadata <- metadata$ds_vars
   }
 
-  if (domain_name %in% names(metadata)) {
+  if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(order_name)))
   } else {

R/support-test.R

@@ -180,6 +180,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) {
   local_cli_theme()
 
   adsl %>%
+    xportr_metadata(domain = "adsl") %>%
     FUN(metadata) %>%
     testthat::expect_no_message(message = "There are multiple specs for the same variable name")
 }

R/type.R

@@ -82,12 +82,11 @@ xportr_type <- function(.df,
                         verbose = getOption("xportr.type_verbose", "none"),
                         metacore = deprecated()) {
   if (!missing(metacore)) {
-    lifecycle::deprecate_warn(
-      when = "0.3.0",
+    lifecycle::deprecate_stop(
+      when = "0.3.1.9005",
       what = "xportr_type(metacore = )",
       with = "xportr_type(metadata = )"
     )
-    metadata <- metacore
   }
   # Name of the columns for working with metadata
   domain_name <- getOption("xportr.domain_name")
@@ -97,10 +96,9 @@ xportr_type <- function(.df,
   numericTypes <- c(getOption("xportr.numeric_types"), "_numeric")
   format_name <- getOption("xportr.format_name")
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section
@@ -114,7 +112,7 @@ xportr_type <- function(.df,
     metadata <- metadata$var_spec
   }
 
-  if (domain_name %in% names(metadata)) {
+  if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
       filter(!!sym(domain_name) == domain)
   }

R/utils-xportr.R

@@ -317,21 +317,18 @@ xpt_validate <- function(data) {
   return(err_cnd)
 }
 
-#' Get the domain from argument or from magrittr's pipe (`%>%`)
+#' Get the domain from argument or from the existing domain attr
 #'
 #' @return A string representing the domain
 #' @noRd
-get_domain <- function(.df, df_arg, domain) {
+get_domain <- function(.df, domain) {
   if (!is.null(domain) && !is.character(domain)) {
     abort(c("`domain` must be a vector with type <character>.",
       x = glue("Instead, it has type <{typeof(domain)}>.")
     ))
   }
 
-  if (identical(df_arg, ".")) {
-    df_arg <- get_pipe_call()
-  }
-  result <- domain %||% attr(.df, "_xportr.df_arg_") %||% df_arg
+  result <- domain %||% attr(.df, "_xportr.df_arg_")
   result
 }
 

R/write.R

@@ -37,6 +37,7 @@
 #' var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset")
 #' xportr_write(adsl,
 #'   path = paste0(tempdir(), "/adsl.xpt"),
+#'   domain = "adsl",
 #'   metadata = var_spec,
 #'   strict_checks = FALSE
 #' )
@@ -51,10 +52,9 @@ xportr_write <- function(.df,
 
   name <- tools::file_path_sans_ext(basename(path))
 
-  ## Common section to detect domain from argument or pipes
+  ## Common section to detect domain from argument or attribute
 
-  df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL)
-  domain <- get_domain(.df, df_arg, domain)
+  domain <- get_domain(.df, domain)
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
   ## End of common section

README.Rmd

@@ -131,11 +131,12 @@ Each `xportr_` function has been written in a way to take in a part of the speci
 
 ```{r, warning = FALSE, message=FALSE, eval=TRUE}
 adsl %>%
-  xportr_type(var_spec, "ADSL", verbose = "warn") %>%
-  xportr_length(var_spec, "ADSL", verbose = "warn") %>%
-  xportr_label(var_spec, "ADSL", verbose = "warn") %>%
-  xportr_order(var_spec, "ADSL", verbose = "warn") %>%
-  xportr_format(var_spec, "ADSL") %>%
+  xportr_metadata(var_spec, "ADSL") %>%
+  xportr_type(verbose = "warn") %>%
+  xportr_length(verbose = "warn") %>%
+  xportr_label(verbose = "warn") %>%
+  xportr_order(verbose = "warn") %>%
+  xportr_format() %>%
   xportr_df_label(dataset_spec, "ADSL") %>%
   xportr_write("adsl.xpt")
 ```