diff --git a/NAMESPACE b/NAMESPACE index eafd5ee9..a7ac18fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ importFrom(checkmate,assert) importFrom(checkmate,assert_character) importFrom(checkmate,assert_choice) importFrom(checkmate,assert_data_frame) +importFrom(checkmate,assert_integer) importFrom(checkmate,assert_string) importFrom(checkmate,check_data_frame) importFrom(checkmate,check_r6) diff --git a/R/messages.R b/R/messages.R index 6057491c..0c56784c 100644 --- a/R/messages.R +++ b/R/messages.R @@ -76,6 +76,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") diff --git a/R/type.R b/R/type.R index c04ac317..5814e569 100644 --- a/R/type.R +++ b/R/type.R @@ -89,6 +89,14 @@ xportr_type <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices) + # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") @@ -103,13 +111,14 @@ xportr_type <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call ## Pull out correct metadata metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") - if (inherits(metadata, "Metacore")) { + if (test_r6(metadata, "Metacore")) { metadata <- metadata$var_spec } @@ -155,7 +164,7 @@ xportr_type <- function(.df, type_log(meta_ordered, type_mismatch_ind, verbose) # Check if variable types match - is_correct <- sapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE) + is_correct <- vapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE, logical(1)) # Use the original variable iff metadata is missing that variable correct_type <- ifelse(is.na(meta_ordered[["type.y"]]), meta_ordered[["type.x"]], meta_ordered[["type.y"]]) diff --git a/R/xportr-package.R b/R/xportr-package.R index 4c2a22b8..983eb736 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -109,7 +109,7 @@ #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_string assert_choice assert_data_frame -#' check_r6 check_data_frame test_string test_r6 assert_character +#' check_r6 check_data_frame test_string test_r6 assert_character assert_integer #' "_PACKAGE"