Merge pull request #344 from OuhscBbmc/dev

adjust for readr 2.0
OuhscBbmc · Jul 21, 2021 · aeeae25 · aeeae25
2 parents c5bce6a + af812ea
commit aeeae25
Show file tree

Hide file tree

Showing 17 changed files with 138 additions and 130 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -6,7 +6,7 @@ Description: Encapsulates functions to streamline calls from R to the REDCap
     University.  The Application Programming Interface (API) offers an avenue
     to access and modify data programmatically, improving the capacity for
     literate and reproducible programming.
-Version: 0.11.1.9004
+Version: 0.11.1.9005
 Authors@R: c(person("Will", "Beasley", role = c("aut", "cre"), email =
     "[email protected]", comment = c(ORCID = "0000-0002-5613-5006")),
     person("David", "Bard", role = "ctb"),
@@ -30,7 +30,7 @@ Imports:
     httr (>= 1.4.0),
     magrittr (>= 1.5),
     methods,
-    readr (>= 1.3.1),
+    readr (>= 2.0),
     rlang (>= 0.4),
     tibble (>= 2.0),
     tidyr (>= 1.0)

diff --git a/R/kernel-api.R b/R/kernel-api.R
@@ -33,8 +33,8 @@
 #'
 #' # Consume the results in a few different ways.
 #' kernel$result
-#' read.csv(text=kernel$raw_text, stringsAsFactors=FALSE)
-#' as.list(read.csv(text=kernel$raw_text, stringsAsFactors=FALSE))
+#' read.csv(text=kernel$raw_text)
+#' as.list(read.csv(text=kernel$raw_text))
 
 kernel_api <- function(
   redcap_uri,

diff --git a/R/project-simple.R b/R/project-simple.R
@@ -30,7 +30,11 @@ populate_project_simple <- function(batch = FALSE) {
   # utils::write.csv(returned_object_metadata$data, file="./inst/test-data/project-simple/simple-metadata.csv", row.names=FALSE)
 
   # Read in the data in R's memory from a csv file.
-  ds_to_write <- readr::read_csv(path_in_simple)
+  ds_to_write <-
+    readr::read_csv(
+      path_in_simple,
+      show_col_types = FALSE
+    )
   # ds_to_write <- utils::read.csv(file="./inst/test-data/project-simple/simple-data.csv", stringsAsFactors=FALSE)
 
   # Remove the calculated variables.

diff --git a/R/redcap-metadata-read.R b/R/redcap-metadata-read.R
@@ -114,8 +114,9 @@ redcap_metadata_read <- function(
       # Convert the raw text to a dataset.
       ds <-
         readr::read_csv(
-          kernel$raw_text,
-          col_types = col_types
+          file            = I(kernel$raw_text),
+          col_types       = col_types,
+          show_col_types  = FALSE
         ),
       # Don't print the warning in the try block.  Print it below,
       #   where it's under the control of the caller.

diff --git a/R/redcap-read-oneshot-eav.R b/R/redcap-read-oneshot-eav.R
@@ -244,7 +244,11 @@ redcap_read_oneshot_eav <- function(
   if (kernel$success) {
     try (
       {
-        ds_eav <- readr::read_csv(kernel$raw_text)
+        ds_eav <-
+          readr::read_csv(
+            file            = I(kernel$raw_text),
+            show_col_types  = FALSE
+          )
 
         ds_metadata_expanded <-
           ds_metadata %>%
@@ -312,7 +316,7 @@ redcap_read_oneshot_eav <- function(
 
         ds_2 <-
           ds %>%
-          dplyr::mutate_if(is.character, type.convert) %>%
+          dplyr::mutate_if(is.character, ~type.convert(., as.is = FALSE)) %>%
           dplyr::mutate_if(is.factor   , as.character)
       }, #Convert the raw text to a dataset.
       silent = TRUE #Don't print the warning in the try block.  Print it below, where it's under the control of the caller.

diff --git a/R/redcap-read-oneshot.R b/R/redcap-read-oneshot.R
@@ -95,9 +95,9 @@
 #'
 #' If you do not pass in this `export_data_access_groups` value, it will default
 #' to `FALSE`. The following is from the API help page for version 10.5.1:
-#' >This flag is only viable if the user whose token is being used to make the
+#' *This flag is only viable if the user whose token is being used to make the
 #' API request is *not* in a data access group. If the user is in a group,
-#' then this flag will revert to its default value.
+#' then this flag will revert to its default value*.
 #'
 #' @author Will Beasley
 #'
@@ -257,8 +257,12 @@ redcap_read_oneshot <- function(
     try(
       # Convert the raw text to a dataset.
       ds <-
-        kernel$raw_text %>%
-        readr::read_csv(col_types = col_types, guess_max = guess_max) %>%
+        readr::read_csv(
+          file            = I(kernel$raw_text),
+          col_types       = col_types,
+          guess_max       = guess_max,
+          show_col_types  = FALSE
+        ) %>%
         as.data.frame(),
 
       # Don't print the warning in the try block.  Print it below,

diff --git a/R/redcap-report.R b/R/redcap-report.R
@@ -168,8 +168,12 @@ redcap_report <- function(
     try(
       # Convert the raw text to a dataset.
       ds <-
-        kernel$raw_text %>%
-        readr::read_csv(col_types = col_types, guess_max = guess_max) %>%
+        readr::read_csv(
+          file            = I(kernel$raw_text),
+          col_types       = col_types,
+          guess_max       = guess_max,
+          show_col_types  = FALSE
+        ) %>%
         as.data.frame(),
 
       # Don't print the warning in the try block.  Print it below,

diff --git a/R/redcap-users-export.R b/R/redcap-users-export.R
@@ -95,8 +95,9 @@ redcap_users_export <- function(
     try(
       { # readr::spec_csv(kernel$raw_text)
         ds_combined <- readr::read_csv(
-          file      = kernel$raw_text,
-          col_types = col_types
+          file            = I(kernel$raw_text),
+          col_types       = col_types,
+          show_col_types  = FALSE
         )
 
         # Remove the readr's `spec` attribute about the column names & types.

diff --git a/R/redcap-variables.R b/R/redcap-variables.R
@@ -80,7 +80,11 @@ redcap_variables <- function(
   if (kernel$success) {
     try(
       {
-        ds <- readr::read_csv(file = kernel$raw_text)
+        ds <-
+          readr::read_csv(
+            file            = I(kernel$raw_text),
+            show_col_types  = FALSE
+          )
       }, #Convert the raw text to a dataset.
       silent = TRUE
       # Don't print the warning in the try block.  Print it below, where

diff --git a/R/retrieve-credential.R b/R/retrieve-credential.R
@@ -128,9 +128,10 @@ retrieve_credential_local <- function(
   )
 
   ds_credentials <- readr::read_csv(
-    file      = path_credential,
-    col_types = col_types,
-    comment   = "#"
+    file            = path_credential,
+    col_types       = col_types,
+    comment         = "#",
+    show_col_types  = FALSE
   )
 
   # Check that it's a data.frame with valid variable names

diff --git a/inst/test-data/specific-redcapr/read-batch-simple/col_types.R b/inst/test-data/specific-redcapr/read-batch-simple/col_types.R
@@ -21,31 +21,4 @@ structure(list(record_id = 1:5, name_first = c("Nutmeg", "Tumtum",
     FALSE, FALSE), race___5 = c(TRUE, TRUE, TRUE, TRUE, FALSE
     ), race___6 = c(FALSE, FALSE, FALSE, FALSE, TRUE), ethnicity = c(1, 
     1, 0, 1, 2), interpreter_needed = c(0, 0, 1, NA, 0), race_and_ethnicity_complete = c(2, 
-    0, 2, 2, 2)), class = "data.frame", row.names = c(NA, -5L
-), spec = structure(list(cols = list(record_id = structure(list(), class = c("collector_integer", 
-"collector")), name_first = structure(list(), class = c("collector_character", 
-"collector")), name_last = structure(list(), class = c("collector_character", 
-"collector")), address = structure(list(), class = c("collector_character", 
-"collector")), telephone = structure(list(), class = c("collector_character", 
-"collector")), email = structure(list(), class = c("collector_character", 
-"collector")), dob = structure(list(format = ""), class = c("collector_date", 
-"collector")), age = structure(list(), class = c("collector_double", 
-"collector")), sex = structure(list(), class = c("collector_double", 
-"collector")), demographics_complete = structure(list(), class = c("collector_double", 
-"collector")), height = structure(list(), class = c("collector_double", 
-"collector")), weight = structure(list(), class = c("collector_double", 
-"collector")), bmi = structure(list(), class = c("collector_double", 
-"collector")), comments = structure(list(), class = c("collector_character", 
-"collector")), mugshot = structure(list(), class = c("collector_character", 
-"collector")), health_complete = structure(list(), class = c("collector_double", 
-"collector")), race___1 = structure(list(), class = c("collector_logical", 
-"collector")), race___2 = structure(list(), class = c("collector_logical", 
-"collector")), race___3 = structure(list(), class = c("collector_logical", 
-"collector")), race___4 = structure(list(), class = c("collector_logical", 
-"collector")), race___5 = structure(list(), class = c("collector_logical", 
-"collector")), race___6 = structure(list(), class = c("collector_logical", 
-"collector")), ethnicity = structure(list(), class = c("collector_double", 
-"collector")), interpreter_needed = structure(list(), class = c("collector_double", 
-"collector")), race_and_ethnicity_complete = structure(list(), class = c("collector_double", 
-"collector"))), default = structure(list(), class = c("collector_guess", 
-"collector")), skip = 1L), class = "col_spec"))
+    0, 2, 2, 2)), row.names = c(NA, -5L), class = "data.frame")
diff --git a/man/kernel_api.Rd b/man/kernel_api.Rd
diff --git a/man/redcap_read_oneshot.Rd b/man/redcap_read_oneshot.Rd
diff --git a/tests/testthat/test-metadata-write.R b/tests/testthat/test-metadata-write.R
@@ -7,7 +7,12 @@ path_in <- system.file(
   "test-data/project-simple/simple-metadata.csv",
   package = "REDCapR"
 )
-dictionary_to_write <- readr::read_csv(path_in, col_types = readr::cols(.default = readr::col_character()))
+dictionary_to_write <-
+  readr::read_csv(
+    file            = path_in,
+    col_types       = readr::cols(.default = readr::col_character()),
+    show_col_types  = FALSE
+  )
 
 test_that("Metadata Write", {
   testthat::skip_on_cran()

diff --git a/tests/testthat/test-read-batch-simple.R b/tests/testthat/test-read-batch-simple.R
@@ -295,31 +295,32 @@ test_that("label", {
   expect_true(returned_object2$fields_collapsed=="", "A subset of fields was not requested.")
   expect_match(returned_object2$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
 })
-test_that("label-header", {
-  testthat::skip_on_cran()
-  path_expected <- "test-data/specific-redcapr/read-batch-simple/label-header.R"
-
-  expected_warning <- "Duplicated column names deduplicated: 'Complete\\?' => 'Complete\\?_1' \\[16\\], 'Complete\\?' => 'Complete\\?_2' \\[25\\]"
-  expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
-
-  expect_warning(
-    regexp = expected_warning,
-    expect_message(
-      regexp           = expected_outcome_message,
-      returned_object <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, raw_or_label_headers="label")
-    )
-  )
-
-  if (update_expectation) save_expected(returned_object$data, path_expected)
-  expected_data_frame <- retrieve_expected(path_expected)
-
-  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
-  expect_match(returned_object$status_codes, regexp="200", perl=TRUE)
-  expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
-  expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
-  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
-  expect_true(returned_object$success)
-})
+# This test is removed because the vroom version adds digits to make the columns unique
+# test_that("label-header", {
+#   testthat::skip_on_cran()
+#   path_expected <- "test-data/specific-redcapr/read-batch-simple/label-header.R"
+#
+#   expected_warning <- "Duplicated column names deduplicated: 'Complete\\?' => 'Complete\\?_1' \\[16\\], 'Complete\\?' => 'Complete\\?_2' \\[25\\]"
+#   expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+#
+#   expect_warning(
+#     regexp = expected_warning,
+#     expect_message(
+#       regexp           = expected_outcome_message,
+#       returned_object <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, raw_or_label_headers="label")
+#     )
+#   )
+#
+#   if (update_expectation) save_expected(returned_object$data, path_expected)
+#   expected_data_frame <- retrieve_expected(path_expected)
+#
+#   expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
+#   expect_match(returned_object$status_codes, regexp="200", perl=TRUE)
+#   expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
+#   expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
+#   expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+#   expect_true(returned_object$success)
+# })
 test_that("export_checkbox_label", {
   testthat::skip_on_cran()
   path_expected <- "test-data/specific-redcapr/read-batch-simple/export_checkbox_label.R"

diff --git a/tests/testthat/test-read-oneshot.R b/tests/testthat/test-read-oneshot.R
@@ -204,32 +204,33 @@ test_that("label", {
   expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
   expect_true(returned_object$success)
 })
-test_that("label-header", {
-  testthat::skip_on_cran()
-  path_expected <- "test-data/specific-redcapr/read-oneshot/label-header.R"
-  expected_warning <- "Duplicated column names deduplicated: 'Complete\\?' => 'Complete\\?_1' \\[\\d+\\], 'Complete\\?' => 'Complete\\?_2' \\[\\d+\\]"
-  expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
-
-  expect_warning(
-    regexp = expected_warning,
-    expect_message(
-      regexp           = expected_outcome_message,
-      returned_object <- redcap_read_oneshot(redcap_uri=credential$redcap_uri, token=credential$token, raw_or_label_headers="label")
-    )
-  )
-
-  if (update_expectation) save_expected(returned_object$data, path_expected)
-  expected_data_frame <- retrieve_expected(path_expected)
-
-  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
-  expect_equal(returned_object$status_code, expected=200L)
-  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
-  expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
-  expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
-  expect_true(returned_object$filter_logic=="", "A filter was not specified.")
-  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
-  expect_true(returned_object$success)
-})
+# This test is removed because the vroom version adds digits to make the columns unique
+# test_that("label-header", {
+#   testthat::skip_on_cran()
+#   path_expected <- "test-data/specific-redcapr/read-oneshot/label-header.R"
+#   expected_warning <- "Duplicated column names deduplicated: 'Complete\\?' => 'Complete\\?_1' \\[\\d+\\], 'Complete\\?' => 'Complete\\?_2' \\[\\d+\\]"
+#   expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+#
+#   expect_warning(
+#     regexp = expected_warning,
+#     expect_message(
+#       regexp           = expected_outcome_message,
+#       returned_object <- redcap_read_oneshot(redcap_uri=credential$redcap_uri, token=credential$token, raw_or_label_headers="label")
+#     )
+#   )
+#
+#   if (update_expectation) save_expected(returned_object$data, path_expected)
+#   expected_data_frame <- retrieve_expected(path_expected)
+#
+#   expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
+#   expect_equal(returned_object$status_code, expected=200L)
+#   expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+#   expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
+#   expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
+#   expect_true(returned_object$filter_logic=="", "A filter was not specified.")
+#   expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+#   expect_true(returned_object$success)
+# })
 test_that("export_checkbox_label", {
   testthat::skip_on_cran()
   path_expected <- "test-data/specific-redcapr/read-oneshot/export_checkbox_label.R"
@@ -348,3 +349,4 @@ test_that("bad token -Error", {
   testthat::expect_equal(returned_object$raw_text, "ERROR: You do not have permissions to use the API")
 })
 rm(credential)
+