Merge pull request #190 from CHOP-CGTInformatics/patch-test-failures

Fix non-chr/numeric casting in `apply_labs_haven()`

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: REDCapTidieR
 Type: Package
 Title: Extract 'REDCap' Databases into Tidy 'Tibble's
-Version: 1.1.0
+Version: 1.1.1
 Authors@R: c(
     person("Richard", "Hanna", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0009-0005-6496-8154")),

NEWS.md

@@ -1,6 +1,14 @@
+# REDCapTidieR 1.1.1 (development version)
+
+Version 1.1.1
+==========================================================
+
+- `read_redcap(raw_or_label = "haven")` now correctly casts categorical data values to character when their type is not character or numeric.
+
+
 # REDCapTidieR 1.1.0
 
-Version 1.1.0
+Version 1.1.0 (Released 2024-03-28)
 ==========================================================
 
 - `read_redcap()` now supports instruments that follow a mixed repeating/non-repeating structure with the `allow_mixed_structure` parameter

R/utils.R

@@ -588,6 +588,7 @@ apply_labs_factor <- function(x, labels, ...) {
 apply_labs_haven <- function(x, labels, ptype, ...) {
   # set_value_labels expects labels in c(label = value) format so reverse them
   labels <- invert_vec(labels)
+  ptype <- vec_ptype(ptype)
   # Try to cast values to match data type in data, catching any parsing warnings
   cnd <- NULL
   labels_cast <- withCallingHandlers(
@@ -601,13 +602,18 @@ apply_labs_haven <- function(x, labels, ptype, ...) {
   )
   if (!is.null(attr(labels_cast, "problems"))) {
     # If there was parsing problem fall back to character
-    x <- as.character(x)
     labels_cast <- force_cast(labels, character())
   } else if (!is.null(cnd)) {
     # If there was some other warning we didn't mean to catch it, so re-raise
     cli_warn(cnd)
   }
 
+  # If labels were parsed to something other than character it was based on ptype so we can assume x is the right type
+  # If labels are character it may have been a fallback to ensure x is character
+  if (is.character(labels_cast)) {
+    x <- as.character(x)
+  }
+
   labelled::set_value_labels(x, .labels = labels_cast)
 }
 
@@ -631,20 +637,12 @@ invert_vec <- function(x) {
   out
 }
 
+# Handling only integer and double since haven explicitly doesn't support other types
 force_cast <- function(x, ptype) {
-  ptype <- vec_ptype(ptype)
-  if (is.logical(ptype)) {
-    out <- parse_logical(x)
-  } else if (is.integer(ptype)) {
+  if (is.integer(ptype)) {
     out <- parse_integer(x)
   } else if (is.numeric(ptype)) {
     out <- parse_double(x)
-  } else if (is.Date(ptype)) {
-    out <- parse_date(x)
-  } else if (is.difftime(ptype)) {
-    out <- parse_time(x)
-  } else if (is.POSIXt(ptype)) {
-    out <- parse_datetime(x)
   } else {
     out <- parse_character(x)
   }

tests/testthat/test-read_redcap.R

@@ -370,7 +370,6 @@ test_that("read_redcap errors with bad inputs", {
   # redcap uri
   expect_error(read_redcap(123, Sys.getenv("REDCAPTIDIER_CLASSIC_API")), class = "check_character")
   expect_error(read_redcap(letters[1:3], Sys.getenv("REDCAPTIDIER_CLASSIC_API")), class = "check_character")
-  expect_error(read_redcap("https://www.google.com", Sys.getenv("REDCAPTIDIER_CLASSIC_API")), class = "cannot_post")
   expect_error(
     read_redcap("https://www.google.comm", Sys.getenv("REDCAPTIDIER_CLASSIC_API")),
     class = "cannot_resolve_host"

tests/testthat/test-utils.R

@@ -493,8 +493,6 @@ test_that("apply_labs_factor works", {
   expect_equal(out, factor(letters[1:3]))
 })
 
-test_that("force_cast works", {
-  expect_s3_class(force_cast("2023-01-01", as.Date(NA)), "Date")
-  expect_s3_class(force_cast("12:00", as.difftime(0, units = "secs")), "difftime")
-  expect_s3_class(force_cast("2023-01-01 12:00", as.POSIXct(NA)), "POSIXct")
+test_that("force_cast converts non chr/numerics to chr", {
+  expect_character(force_cast("2023-01-01", as.Date(NA)))
 })