feat: checkmate support in type

atorus-research · Nov 23, 2023 · c1f5d45 · c1f5d45
1 parent 168e9b3
commit c1f5d45
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 3 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -21,6 +21,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
@@ -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
@@ -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")
@@ -104,13 +112,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
   }
 
@@ -156,7 +165,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
@@ -111,7 +111,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"