return empty tibble if zero records

close #452

NEWS.md

@@ -48,6 +48,8 @@ These changes could possibly break existing code --but it's very unlikely.  We f
 
 This will help extract forms from longitudinal & repeating projects.
 
+* `redcap_read()` and `redcap_read_oneshot()` now return an empty dataset if no records are retrieved (such as no records meet the filter criteria).  Currently a 0x0 tibble is returned, but that may change in the future.  Until now an error was deliberately thrown.  (#452)
+
 ### New Features
 
 * New `redcap_metadata_coltypes()` function.  Inspects the fields types and validation text of each field to generate a suggested `readr::col_types` object that reflects the project's current data dictionary.  The object then can be passed to the `col_types` parameter of `redcap_read()` or `redcap_read_oneshot()`.  (Suggested and discussed with @pbchase, @nutterb, @skadauke, & others, #405 & #294)

R/kernel-api.R

@@ -101,8 +101,8 @@ kernel_api <- function(
 
   # Overwrite the success flag if the raw_text is bad.
   if (
-    any(grepl(regex_cannot_connect, raw_text)) ||
-    any(grepl(regex_empty         , raw_text))
+    any(grepl(regex_cannot_connect, raw_text)) #||
+    # any(grepl(regex_empty         , raw_text))
   ) {
     success     <- FALSE  # nocov
   }

R/redcap-read.R

@@ -292,26 +292,45 @@ redcap_read <- function(
     handle_httr                = handle_httr
   )
 
-  # Stop and return to the caller if the initial query failed. --------------
-  if (!initial_call$success) {
+  # Stop and return to the caller if the initial query failed or is empty. --------------
+  if (!initial_call$success) { # Call failed
     # nocov start
     outcome_messages  <- paste0("The initial call failed with the code: ", initial_call$status_code, ".")
-    elapsed_seconds   <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
-    return(list(
-      data                  = tibble::tibble(),
-      records_collapsed     = "failed in initial batch call",
-      fields_collapsed      = "failed in initial batch call",
-      forms_collapsed       = "failed in initial batch call",
-      events_collapsed      = "failed in initial batch call",
-      filter_logic          = "failed in initial batch call",
-      datetime_range_begin  = "failed in initial batch call",
-      datetime_range_end    = "failed in initial batch call",
-      elapsed_seconds       = elapsed_seconds,
-      status_code           = initial_call$status_code,
-      outcome_messages      = outcome_messages,
-      success               = initial_call$success
+    elapsed_seconds   <- as.numeric(difftime(Sys.time(), start_time, units = "secs"))
+
+    return(ship_records(
+      .data                  = tibble::tibble(),
+      .records_collapsed     = "failed in initial batch call",
+      .fields_collapsed      = "failed in initial batch call",
+      .forms_collapsed       = "failed in initial batch call",
+      .events_collapsed      = "failed in initial batch call",
+      .filter_logic          = "failed in initial batch call",
+      .datetime_range_begin  = "failed in initial batch call",
+      .datetime_range_end    = "failed in initial batch call",
+      .elapsed_seconds       = elapsed_seconds,
+      .status_code           = initial_call$status_code,
+      .outcome_messages      = outcome_messages,
+      .success               = initial_call$success
     ))
     # nocov end
+  } else if (0L == nrow(initial_call$data)) { # zero rows
+    outcome_messages  <- "The initial call completed, but zero rows match the criteria."
+    elapsed_seconds   <- as.numeric(difftime(Sys.time(), start_time, units = "secs"))
+
+    return(ship_records(
+      .data                    = tibble::tibble(), # 0x0 tibble
+      .success                 = initial_call$success,
+      .status_codes            = as.character(initial_call$status_code),
+      .outcome_messages        = outcome_messages,
+      .records_collapsed       = collapse_vector(records),
+      .fields_collapsed        = "No records were returned so the fields weren't determined.",
+      .forms_collapsed         = "No records were returned so the forms weren't determined.",
+      .events_collapsed        = "No records were returned so the events weren't determined.",
+      .filter_logic            = filter_logic,
+      .datetime_range_begin    = datetime_range_begin,
+      .datetime_range_end      = datetime_range_end,
+      .elapsed_seconds         = elapsed_seconds
+    ))
   }
 
   # Continue as intended if the initial query succeeded. --------------------
@@ -453,21 +472,49 @@ redcap_read <- function(
   status_code_combined     <- paste(lst_status_code    , collapse="; ")
   outcome_message_combined <- paste(lst_outcome_message, collapse="; ")
 
+  ship_records(
+    .data                    = ds_stacked,
+    .success                 = success_combined,
+    .status_codes            = status_code_combined,
+    .outcome_messages        = outcome_message_combined,
+    .records_collapsed       = collapse_vector(records),
+    .fields_collapsed        = read_result$fields_collapsed,     # From the last call
+    .forms_collapsed         = read_result$forms_collapsed,      # From the last call
+    .events_collapsed        = read_result$events_collapsed,     # From the last call
+    .filter_logic            = filter_logic,
+    .datetime_range_begin    = datetime_range_begin,
+    .datetime_range_end      = datetime_range_end,
+    .elapsed_seconds         = elapsed_seconds
+  )
+}
+
+ship_records <- function (
+  .data,
+  .success,
+  .status_codes,
+  .outcome_messages,
+  .records_collapsed,
+  .fields_collapsed,
+  .forms_collapsed,
+  .events_collapsed,
+  .filter_logic,
+  .datetime_range_begin,
+  .datetime_range_end,
+  .elapsed_seconds
+) {
   list(
-    data                = ds_stacked,
-    success             = success_combined,
-    status_codes        = status_code_combined,
-    outcome_messages    = outcome_message_combined,
-    # data_types          = data_types,
-    records_collapsed   = collapse_vector(records),
-    fields_collapsed    = read_result$fields_collapsed,     # From the last call
-    forms_collapsed     = read_result$forms_collapsed,      # From the last call
-    events_collapsed    = read_result$events_collapsed,     # From the last call
-    filter_logic        = filter_logic,
-    datetime_range_begin= datetime_range_begin,
-    datetime_range_end  = datetime_range_end,
-
-    elapsed_seconds     = elapsed_seconds
+    data                    = .data,
+    success                 = .success,
+    status_codes            = .status_codes,
+    outcome_messages        = .outcome_messages,
+    records_collapsed       = .records_collapsed,
+    fields_collapsed        = .fields_collapsed,
+    forms_collapsed         = .forms_collapsed,
+    events_collapsed        = .events_collapsed,
+    filter_logic            = .filter_logic,
+    datetime_range_begin    = .datetime_range_begin,
+    datetime_range_end      = .datetime_range_end,
+    elapsed_seconds         = .elapsed_seconds
   )
 }
 

tests/testthat/test-read-batch-simple.R

@@ -727,6 +727,29 @@ test_that("date-range", {
   expect_true(returned_object$success)
   expect_s3_class(returned_object$data, "tbl")
 })
+test_that("empty-dataset", {
+  testthat::skip_on_cran()
+  expected_outcome_message <- "The initial call completed, but zero rows match the criteria\\."
+
+  returned_object <-
+    redcap_read(
+      redcap_uri            = credential$redcap_uri,
+      token                 = credential$token,
+      datetime_range_begin  = Sys.time(),
+      verbose               = FALSE
+    )
+
+  expect_equal(returned_object$data, expected=tibble::tibble(), label="The returned tibble should be empty", ignore_attr = TRUE) # dput(returned_object$data)
+  expect_equal(returned_object$status_code, expected="200")
+  expect_true(returned_object$records_collapsed == "", "A subset of records was not requested.")
+  expect_equal(returned_object$fields_collapsed  , "No records were returned so the fields weren't determined.")
+  expect_equal(returned_object$forms_collapsed   , "No records were returned so the forms weren't determined.")
+  expect_equal(returned_object$events_collapsed  , "No records were returned so the events weren't determined.")
+  expect_equal(returned_object$filter_logic, "")
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+  expect_s3_class(returned_object$data, "tbl")
+})
 test_that("error-bad-token", {
   testthat::skip_on_cran()
 

tests/testthat/test-read-oneshot.R

@@ -610,6 +610,29 @@ test_that("date-range", {
 
   expect_s3_class(returned_object$data, "tbl")
 })
+test_that("empty-dataset", {
+  testthat::skip_on_cran()
+  expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+
+  returned_object <-
+    redcap_read_oneshot(
+      redcap_uri            = credential$redcap_uri,
+      token                 = credential$token,
+      datetime_range_begin  = Sys.time(),
+      verbose               = FALSE
+    )
+
+  expect_equal(returned_object$data, expected=tibble::tibble(), label="The returned tibble should be empty", 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_equal(returned_object$filter_logic, "")
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+
+  expect_s3_class(returned_object$data, "tbl")
+})
 test_that("guess_max-Inf", {
   testthat::skip_on_cran()
   expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."