Merge branch 'main' into 136-unused-xpt-validate-attributes

.github/pull_request_template.md

@@ -23,7 +23,7 @@ _(descriptions of changes)_
 - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately
 - [ ] Run `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new/updated functions occur on the "Reference" page.
 - [ ] Update NEWS.md if the changes pertain to a user-facing function (i.e. it has an @export tag) or documentation aimed at users (rather than developers)
-- [ ] Make sure that the pacakge version in the NEWS.md and DESCRIPTION file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI.
+- [ ] Make sure that the package version in the NEWS.md and DESCRIPTION file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI.
 - [ ] Address any updates needed for vignettes and/or templates
 - [ ] Link the issue Development Panel so that it closes after successful merging.
 - [ ] Fix merge conflicts

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: xportr
 Title: Utilities to Output CDISC SDTM/ADaM XPT Files
-Version: 0.3.1.9008
+Version: 0.3.1.9012
 Authors@R: c(
     person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-2127-9456")),

NAMESPACE

@@ -18,6 +18,19 @@ export(xportr_write)
 export(xpt_validate)
 import(haven)
 import(rlang)
+importFrom(checkmate,assert)
+importFrom(checkmate,assert_character)
+importFrom(checkmate,assert_choice)
+importFrom(checkmate,assert_data_frame)
+importFrom(checkmate,assert_integer)
+importFrom(checkmate,assert_logical)
+importFrom(checkmate,assert_string)
+importFrom(checkmate,check_data_frame)
+importFrom(checkmate,check_r6)
+importFrom(checkmate,makeAssertion)
+importFrom(checkmate,test_data_frame)
+importFrom(checkmate,test_string)
+importFrom(checkmate,vname)
 importFrom(cli,cli_alert_danger)
 importFrom(cli,cli_alert_info)
 importFrom(cli,cli_alert_success)
@@ -49,13 +62,13 @@ importFrom(janitor,make_clean_names)
 importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%>%")
 importFrom(magrittr,extract2)
+importFrom(purrr,iwalk)
 importFrom(purrr,map)
 importFrom(purrr,map2_chr)
 importFrom(purrr,map_chr)
 importFrom(purrr,map_dbl)
 importFrom(purrr,pluck)
 importFrom(purrr,walk)
-importFrom(purrr,walk2)
 importFrom(readr,parse_number)
 importFrom(stringr,str_detect)
 importFrom(stringr,str_extract)

NEWS.md

@@ -2,18 +2,24 @@
 
 ## New Features and Bug Fixes
 
+* `xportr_metadata()` can set `verbose` for a whole pipeline, i.e. setting `verbose` in `xportr_metadata()` will populate to all `xportr` functions.  (#151)
+
+* All `xportr` functions now have `verbose = NULL` as the default (#151)
+
+## 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)
 * Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189).
 * File name check is moved to strict_checks condition to allow underscores in the file name. Underscores are allowed in xpt but not per FDA requirements. (#126)
 * It is now possible to get and set the xportr options using the helper function `xportr_options()` (#130)
+* Adds argument assertions to public functions using `{checkmate}` (#175)
 
 ## 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`.
 

R/data.R

@@ -95,7 +95,7 @@
 #'   \item{Purpose}{<chr> Purpose of the dataset}
 #'   \item{Key, Variables}{<chr> Join Key variables in the dataset}
 #'   \item{Repeating}{<chr> Indicates if the dataset is repeating}
-#'   \item{Reference Data}{<lgl> Regerence Data}
+#'   \item{Reference Data}{<lgl> Reference Data}
 #'   \item{Comment}{<chr> Additional comment}
 #' }
 "dataset_spec"

R/df_label.R

@@ -50,34 +50,32 @@ xportr_df_label <- function(.df,
       with = "xportr_df_label(metadata = )"
     )
   }
-  domain_name <- getOption("xportr.df_domain_name")
-  label_name <- getOption("xportr.df_label")
 
-  ## Common section to detect domain from argument or attribute
+  ## Common section to detect default arguments
 
-  domain <- get_domain(.df, domain)
+  domain <- domain %||% attr(.df, "_xportr.df_arg_")
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
+  metadata <- metadata %||% attr(.df, "_xportr.df_metadata_")
+
   ## End of common section
 
-  ## Pull out correct metadata
-  metadata <- metadata %||%
-    attr(.df, "_xportr.df_metadata_") %||%
-    rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
+  assert_data_frame(.df)
+  assert_string(domain, null.ok = TRUE)
+  assert_metadata(metadata)
 
-  if (inherits(metadata, "Metacore")) {
-    metadata <- metadata$ds_spec
-  }
+  domain_name <- getOption("xportr.df_domain_name")
+  label_name <- getOption("xportr.df_label")
+
+  if (inherits(metadata, "Metacore")) metadata <- metadata$ds_spec
 
   label <- metadata %>%
     filter(!!sym(domain_name) == domain) %>%
     select(!!sym(label_name)) %>%
     # If a dataframe is used this will also be a dataframe, change to character.
     as.character()
 
-  label_len <- nchar(label)
-
-  if (label_len > 40) {
+  if (!test_string(label, max.chars = 40)) {
     abort("Length of dataset label must be 40 characters or less.")
   }
 

R/format.R

@@ -2,7 +2,7 @@
 #'
 #' Assigns a SAS format from a variable level metadata to a given data frame. If
 #' no format is found for a given variable, it is set as an empty character
-#' vector. This is stored in the format.sas attribute.
+#' vector. This is stored in the '`format.sas`' attribute.
 #'
 #' @inheritParams xportr_length
 #'
@@ -19,7 +19,7 @@
 #'   function.
 #'
 #'   2) Format Name - passed as the 'xportr.format_name' option.
-#'   Default: "format". Character values to update the 'format.sas' attribute of
+#'   Default: "format". Character values to update the '`format.sas`' attribute of
 #'   the column. This is passed to `haven::write` to note the format.
 #'
 #'   3) Variable Name - passed as the 'xportr.variable_name' option. Default:
@@ -52,24 +52,25 @@ xportr_format <- function(.df,
       with = "xportr_format(metadata = )"
     )
   }
-  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 attribute
+  ## Common section to detect default arguments
 
-  domain <- get_domain(.df, domain)
+  domain <- domain %||% attr(.df, "_xportr.df_arg_")
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
+  metadata <- metadata %||% attr(.df, "_xportr.df_metadata_")
+
   ## End of common section
 
-  metadata <- metadata %||%
-    attr(.df, "_xportr.df_metadata_") %||%
-    rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
+  assert_data_frame(.df)
+  assert_string(domain, null.ok = TRUE)
+  assert_metadata(metadata)
 
-  if (inherits(metadata, "Metacore")) {
-    metadata <- metadata$var_spec
-  }
+  domain_name <- getOption("xportr.domain_name")
+  format_name <- getOption("xportr.format_name")
+  variable_name <- getOption("xportr.variable_name")
+
+  if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%

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_stop(
@@ -68,24 +68,32 @@ xportr_label <- function(.df,
       with = "xportr_label(metadata = )"
     )
   }
-  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 attribute
+  ## Common section to detect default arguments
 
-  domain <- get_domain(.df, domain)
+  domain <- domain %||% attr(.df, "_xportr.df_arg_")
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
+  metadata <- metadata %||% attr(.df, "_xportr.df_metadata_")
+
+  # 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")
+
   ## End of common section
 
-  metadata <- metadata %||%
-    attr(.df, "_xportr.df_metadata_") %||%
-    rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
+  assert_data_frame(.df)
+  assert_string(domain, null.ok = TRUE)
+  assert_metadata(metadata)
+  assert_choice(verbose, choices = .internal_verbose_choices)
 
-  if (inherits(metadata, "Metacore")) {
-    metadata <- metadata$var_spec
-  }
+  domain_name <- getOption("xportr.domain_name")
+  variable_name <- getOption("xportr.variable_name")
+  variable_label <- getOption("xportr.label")
+
+  if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
@@ -117,10 +125,10 @@ xportr_label <- function(.df,
   }
 
   for (i in names(.df)) {
-    if (i %in% miss_vars) {
-      attr(.df[[i]], "label") <- ""
+    attr(.df[[i]], "label") <- if (i %in% miss_vars) {
+      ""
     } else {
-      attr(.df[[i]], "label") <- label[[i]]
+      label[[i]]
     }
   }
 

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_stop(
@@ -75,24 +75,32 @@ xportr_length <- function(.df,
       with = "xportr_length(metadata = )"
     )
   }
-  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 attribute
+  ## Common section to detect default arguments
 
-  domain <- get_domain(.df, domain)
+  domain <- domain %||% attr(.df, "_xportr.df_arg_")
   if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain
 
+  metadata <- metadata %||% attr(.df, "_xportr.df_metadata_")
+
+  # 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")
+
   ## End of common section
 
-  metadata <- metadata %||%
-    attr(.df, "_xportr.df_metadata_") %||%
-    rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
+  assert_data_frame(.df)
+  assert_string(domain, null.ok = TRUE)
+  assert_metadata(metadata)
+  assert_choice(verbose, choices = .internal_verbose_choices)
 
-  if (inherits(metadata, "Metacore")) {
-    metadata <- metadata$var_spec
-  }
+  domain_name <- getOption("xportr.domain_name")
+  variable_length <- getOption("xportr.length")
+  variable_name <- getOption("xportr.variable_name")
+
+  if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec
 
   if (domain_name %in% names(metadata) && !is.null(domain)) {
     metadata <- metadata %>%
@@ -102,7 +110,6 @@ xportr_length <- function(.df,
     check_multiple_var_specs(metadata, variable_name)
   }
 
-
   # Check any variables missed in metadata but present in input data ---
   miss_vars <- setdiff(names(.df), metadata[[variable_name]])
 

R/messages.R

@@ -10,6 +10,9 @@
 #' @return Output to Console
 #' @export
 xportr_logger <- function(message, type = "none", ...) {
+  assert_character(message)
+  assert_choice(type, choices = .internal_verbose_choices)
+
   log_fun <- switch(type,
     stop = abort,
     warn = warn,
@@ -28,6 +31,9 @@ xportr_logger <- function(message, type = "none", ...) {
 #' @return Output to Console
 #' @export
 var_names_log <- function(tidy_names_df, verbose) {
+  assert_data_frame(tidy_names_df)
+  assert_choice(verbose, choices = .internal_verbose_choices)
+
   only_renames <- tidy_names_df %>%
     filter(original_varname != renamed_var) %>%
     mutate(
@@ -76,6 +82,10 @@ var_names_log <- function(tidy_names_df, verbose) {
 #' @return Output to Console
 #' @export
 type_log <- function(meta_ordered, type_mismatch_ind, verbose) {
+  assert_data_frame(meta_ordered)
+  assert_integer(type_mismatch_ind)
+  assert_choice(verbose, choices = .internal_verbose_choices)
+
   if (length(type_mismatch_ind) > 0) {
     cli_h2("Variable type mismatches found.")
     cli_alert_success("{ length(type_mismatch_ind) } variables coerced")
@@ -97,6 +107,9 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) {
 #' @return Output to Console
 #' @export
 length_log <- function(miss_vars, verbose) {
+  assert_character(miss_vars)
+  assert_choice(verbose, choices = .internal_verbose_choices)
+
   if (length(miss_vars) > 0) {
     cli_h2("Variable lengths missing from metadata.")
     cli_alert_success("{ length(miss_vars) } lengths resolved")
@@ -119,6 +132,9 @@ length_log <- function(miss_vars, verbose) {
 #' @return Output to Console
 #' @export
 label_log <- function(miss_vars, verbose) {
+  assert_character(miss_vars)
+  assert_choice(verbose, choices = .internal_verbose_choices)
+
   if (length(miss_vars) > 0) {
     cli_h2("Variable labels missing from metadata.")
     cli_alert_success("{ length(miss_vars) } labels skipped")
@@ -141,6 +157,10 @@ label_log <- function(miss_vars, verbose) {
 #' @return Output to Console
 #' @export
 var_ord_msg <- function(reordered_vars, moved_vars, verbose) {
+  assert_character(reordered_vars)
+  assert_character(moved_vars)
+  assert_choice(verbose, choices = .internal_verbose_choices)
+
   if (length(moved_vars) > 0) {
     cli_h2("{ length(moved_vars) } variables not in spec and moved to end")
     message <- glue(