Closes #122 Closes #120

NEWS.md

@@ -1,4 +1,5 @@
-# metacore 0.3.0
+# Metacore 0.3.0
+- Added extended function of `quiet` argument in `spec_to_metacore()`, `define_to_metacore()`, and `select_dataset` functions to suppress optional messages, notes and warnings [#122](https://github.com/atorus-research/metacore/issues/122)
 - `keep` variable in `ds_vars` table has been changed to `mandatory` to better reflect the CDISC standard terminology. 
 
 # Metacore 0.2.1

R/metacore.R

@@ -332,56 +332,75 @@ MetaCore <- R6::R6Class("Metacore",
 #'
 #' @export
 #'
-metacore <- function(ds_spec = tibble(dataset = character(), structure = character(), label = character()),
-                     ds_vars = tibble(dataset = character(), variable = character(), mandatory = logical(),
-                                      key_seq = integer(), order = integer(), core = character(),
-                                      supp_flag = logical()),
-                     var_spec = tibble(variable = character(), label = character(), length = integer(),
-                                       type = character(), common = character(), format = character()),
-                     value_spec = tibble(dataset = character(),
-                                         variable = character(),
-                                         where  = character(),
-                                         type = character(),
-                                         sig_dig = integer(),
-                                         code_id = character(),
-                                         origin = character(),
-                                         derivation_id = integer()),
-                     derivations = tibble(derivation_id = integer(), derivation = character()),
-                     codelist = tibble(code_id = character(), name = character(), type = character(), codes = list()),
-                     supp = tibble(dataset = character(), variable = character(), idvar = character(), qeval = character()),
-                     quiet = FALSE) {
-   # Check if there are any empty datasets that need adding
-   is_empty_df <- as.list(environment()) %>%
-      keep(is.null)
-   if(length(is_empty_df) > 0) {
-      # Adding empty datasets
-      to_replace <- all_message() %>%
-         #get the type each variable needs to be
-         mutate(convert =
-                   map(.data$test, function(x){
-                      if(identical(x, .Primitive("is.numeric"))){
-                         numeric()
-                      } else if(identical(x, .Primitive("is.logical"))){
-                         logical()
-                      } else {
-                         character()
-                      }
-                   })) %>%
-         filter(dataset %in% names(is_empty_df)) %>%
-         group_by(dataset) %>%
-         group_split()
-      replaced <- to_replace %>%
-         map(function(df){
-            names(df$convert) <- df$var
-            df$convert %>%
-               as_tibble()
-         })
-      names(replaced) <- to_replace %>% map_chr(~unique(.$dataset))
-      list2env(replaced, environment())
-   }
-   MetaCore$new(ds_spec, ds_vars, var_spec, value_spec, derivations, codelist, supp, quiet)
-}
+metacore <- function(
+      ds_spec = tibble(dataset = character(), structure = character(), label = character()),
+      ds_vars = tibble(dataset = character(), variable = character(), mandatory = logical(),
+                       key_seq = integer(), order = integer(), core = character(),
+                       supp_flag = logical()),
+      var_spec = tibble(variable = character(), label = character(), length = integer(),
+                        type = character(), common = character(), format = character()),
+      value_spec = tibble(dataset = character(),
+                          variable = character(),
+                          where  = character(),
+                          type = character(),
+                          sig_dig = integer(),
+                          code_id = character(),
+                          origin = character(),
+                          derivation_id = integer()),
+      derivations = tibble(derivation_id = integer(), derivation = character()),
+      codelist = tibble(code_id = character(), name = character(), type = character(), codes = list()),
+      supp = tibble(dataset = character(), variable = character(), idvar = character(), qeval = character()),
+      quiet = FALSE
+) {
+
+   test <- quiet_if_true({
+
+      is_empty_df <- as.list(environment()) %>%
+         keep(is.null)
+
+      if (length(is_empty_df) > 0) {
+         to_replace <- all_message() %>%
+            mutate(
+               convert = map(.data$test, function(x) {
+                  if (identical(x, .Primitive("is.numeric"))) {
+                     numeric()
+                  } else if (identical(x, .Primitive("is.logical"))) {
+                     logical()
+                  } else {
+                     character()
+                  }
+               })
+            ) %>%
+            filter(.data$dataset %in% names(is_empty_df)) %>%
+            group_by(.data$dataset) %>%
+            group_split()
+
+         replaced <- to_replace %>%
+            map(function(df) {
+               names(df$convert) <- df$var
+               df$convert %>%
+                  as_tibble()
+            })
+
+         names(replaced) <- to_replace %>% map_chr(~ unique(.x$dataset))
+         list2env(replaced, environment())
+      }
+
+      MetaCore$new(
+         ds_spec  = ds_spec,
+         ds_vars  = ds_vars,
+         var_spec = var_spec,
+         value_spec = value_spec,
+         derivations = derivations,
+         codelist = codelist,
+         supp = supp,
+         quiet = quiet
+      )
+
+   }, quiet = quiet)
 
+   if (quiet) invisible(test) else test
+}
 
 
 #' Select metacore object to single dataset
@@ -394,14 +413,14 @@ metacore <- function(ds_spec = tibble(dataset = character(), structure = charact
 #'
 #' @return a filtered subset of the metacore object
 #' @export
-#'
 select_dataset <- function(.data, dataset, simplify = FALSE, quiet = FALSE) {
 
    cl <- .data$clone()
    cl$metacore_filter(dataset)
 
    if (simplify) {
-      test <-  suppressMessages(
+
+      test <- quiet_if_true({
          list(
             cl$ds_vars,
             cl$var_spec,
@@ -411,13 +430,19 @@ select_dataset <- function(.data, dataset, simplify = FALSE, quiet = FALSE) {
             cl$supp
          ) %>%
             reduce(left_join)
-      )
+      }, quiet = quiet)
+
    } else {
-      if (!quiet) DatasetMeta$new(metacore = cl)
-      else suppressWarnings(DatasetMeta$new(metacore = cl, quiet = quiet))
+
+      test <- quiet_if_true(
+         DatasetMeta$new(metacore = cl, quiet = quiet),
+         quiet = quiet
+      )
+
    }
-}
 
+   if (quiet) invisible(test) else test
+}
 
 
 #' Get Control Term

R/spec_builder.R

@@ -6,34 +6,52 @@
 #' be used as building blocks for bespoke specification documents.
 #'
 #' @param path string of file location
-#' @param quiet Option to quietly load in, this will suppress warnings, but not
-#'   errors
+#' @param quiet Option to quietly load in; when `TRUE`, messages, warnings,
+#'   and other non-error console output are suppressed, but errors are still
+#'   raised.
 #' @param where_sep_sheet Option to tell if the where is in a separate sheet,
 #'   like in older p21 specs or in a single sheet like newer p21 specs
 #'
 #' @return given a spec document it returns a metacore object
 #' @export
 spec_to_metacore <- function(path, quiet = FALSE, where_sep_sheet = TRUE){
-   doc <- read_all_sheets(path)
 
-   if(spec_type(path) == "by_type"){
-      ds_spec <- spec_type_to_ds_spec(doc)
-      ds_vars <- spec_type_to_ds_vars(doc)
-      var_spec <- spec_type_to_var_spec(doc)
-      value_spec <- spec_type_to_value_spec(doc, where_sep_sheet = where_sep_sheet)
-      derivations <- spec_type_to_derivations(doc)
-      code_list <- spec_type_to_codelist(doc)
-
-      out <- metacore(ds_spec, ds_vars, var_spec, value_spec, derivations, codelist = code_list, quiet = quiet)
+   doc <- quiet_if_true(read_all_sheets(path), quiet = quiet)
+
+   if (quiet_if_true(spec_type(path), quiet = quiet) == "by_type") {
+
+      ds_spec     <- quiet_if_true(spec_type_to_ds_spec(doc), quiet = quiet)
+      ds_vars     <- quiet_if_true(spec_type_to_ds_vars(doc), quiet = quiet)
+      var_spec    <- quiet_if_true(spec_type_to_var_spec(doc), quiet = quiet)
+      value_spec  <- quiet_if_true(
+         spec_type_to_value_spec(doc, where_sep_sheet = where_sep_sheet),
+         quiet = quiet
+      )
+      derivations <- quiet_if_true(spec_type_to_derivations(doc), quiet = quiet)
+      code_list   <- quiet_if_true(spec_type_to_codelist(doc), quiet = quiet)
+
+      test <- quiet_if_true(
+         metacore(
+            ds_spec,
+            ds_vars,
+            var_spec,
+            value_spec,
+            derivations,
+            codelist = code_list,
+            quiet = quiet
+         ),
+         quiet = quiet
+      )
 
    } else {
-      cli_abort("This specification format is not currently supported. You will need to write your own reader",
-                call. = FALSE)
+      cli_abort(
+         "This specification format is not currently supported. You will need to write your own reader",
+         call. = FALSE
+      )
    }
-   out
-}
-
 
+   if (quiet) invisible(test) else test
+}
 
 
 #' Check the type of spec document

R/utils.R

@@ -120,3 +120,17 @@ metacore_example <- function(file = NULL) {
       system.file("extdata", file, package = "metacore", mustWork = TRUE)
    }
 }
+
+#' Conditionally suppress messages and warnings
+#' @keywords internal
+quiet_if_true <- function(expr, quiet = FALSE) {
+   if (isTRUE(quiet)) {
+      suppressWarnings(
+         suppressMessages(
+            force(expr)
+         )
+      )
+   } else {
+      force(expr)
+   }
+}

R/xml_builders.R

@@ -1,36 +1,46 @@
 #' Define XML to DataDef Object
 #'
-#' Given a path, this function converts the define xml to a DataDef Object
+#' Given a path, this function converts the define xml to a DataDef/Metacore object.
 #'
 #' @param path location of the define xml as a string
-#' @param quiet Option to quietly load in, this will suppress warnings, but not errors
+#' @param quiet Option to quietly load in; when `TRUE`, messages and warnings
+#'   are suppressed, but errors are still raised.
 #'
-#' @return DataDef Object
+#' @return Metacore/DataDef object
 #' @export
-#'
 define_to_metacore <- function(path, quiet = FALSE){
 
-   xml <- read_xml(path)
-   xml_ns_strip(xml)
-
-   define_version <- xml_find_all(xml, "//MetaDataVersion") %>%
-      xml_attr("DefineVersion") %>%
-      as.numeric_version()
-
-
-   ds_spec <- xml_to_ds_spec(xml)
-   ds_vars <- xml_to_ds_vars(xml)
-   var_spec <- xml_to_var_spec(xml)
-   value_spec <- xml_to_value_spec(xml)
-   code_list <- xml_to_codelist(xml)
-   derivations <- xml_to_derivations(xml)
+   test <- quiet_if_true({
+
+      xml <- read_xml(path)
+      xml_ns_strip(xml)
+
+      define_version <- xml_find_all(xml, "//MetaDataVersion") %>%
+         xml_attr("DefineVersion") %>%
+         as.numeric_version()
+
+      ds_spec     <- xml_to_ds_spec(xml)
+      ds_vars     <- xml_to_ds_vars(xml)
+      var_spec    <- xml_to_var_spec(xml)
+      value_spec  <- xml_to_value_spec(xml)
+      code_list   <- xml_to_codelist(xml)
+      derivations <- xml_to_derivations(xml)
+
+      metacore(
+         ds_spec,
+         ds_vars,
+         var_spec,
+         value_spec,
+         derivations,
+         codelist = code_list,
+         quiet = quiet
+      )
 
-   out <- metacore(ds_spec, ds_vars, var_spec, value_spec, derivations, codelist = code_list, quiet = quiet)
+   }, quiet = quiet)
 
-   out
+   if (quiet) invisible(test) else test
 }
 
-
 #' XML to Data Set Spec
 #'
 #' Creates a dataset specification, which has the domain name and label for each dataset