tests/testthat/test-event-read.R

In REDCapR: Interaction Between R and REDCap

library(testthat)

retrieve_expected_events <- function(path) {
  full_path   <- system.file(path, package = "REDCapR")
  if (!file.exists(full_path))
    stop("The expected file `", full_path, "` was not found.")  # nocov

  col_types <- readr::cols(
    event_name         = readr::col_character(),
    arm_num            = readr::col_integer(),
    unique_event_name  = readr::col_character(),
    custom_event_label = readr::col_character(),
    event_id           = readr::col_integer()
  )

  full_path %>%
    readr::read_csv(col_types = col_types)
}

empty_data_frame <-
  tibble::tibble(
    event_name         = character(0),
    arm_num            = integer(0),
    unique_event_name  = character(0),
    custom_event_label = character(0),
    event_id           = integer(0)
  )

test_that("Longitudinal Single Arm", {
  testthat::skip_on_cran()
  credential  <- retrieve_credential_testing(2629L)

  path_expected <- "test-data/longitudinal-single-arm/event.csv"
  expected_data_frame <- retrieve_expected_events(path_expected)

  expected_outcome_message <- "The list of events was retrieved from the REDCap project in \\d+(\\.\\d+\\W|\\W)seconds\\."
  returned_object <-
    redcap_event_read(
      redcap_uri        = credential$redcap_uri,
      token             = credential$token,
      verbose           = FALSE
    )

  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object2$data$bmi<-NULL; returned_object2$data$age<-NULL;dput(returned_object2$data)
  expect_equal(returned_object$status_code, expected=200L)
  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object2$raw_text)
  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
  expect_true(returned_object$success)
})

test_that("Longitudinal Two Arms", {
  testthat::skip_on_cran()
  credential  <- retrieve_credential_testing(212L)

  path_expected <- "test-data/project-longitudinal/event.csv"
  expected_data_frame <- retrieve_expected_events(path_expected)

  expected_outcome_message <- "The list of events was retrieved from the REDCap project in \\d+(\\.\\d+\\W|\\W)seconds\\."
  returned_object <-
    redcap_event_read(
      redcap_uri        = credential$redcap_uri,
      token             = credential$token,
      verbose           = FALSE
    )

  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object2$data$bmi<-NULL; returned_object2$data$age<-NULL;dput(returned_object2$data)
  expect_equal(returned_object$status_code, expected=200L)
  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object2$raw_text)
  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
  expect_true(returned_object$success)
})

test_that("Classic", {
  testthat::skip_on_cran()
  credential  <- retrieve_credential_testing(153L)

  expected_outcome_message <- "A 'classic' REDCap project has no events.  Retrieved in \\d+(\\.\\d+\\W|\\W)seconds\\."
  expect_message({
    returned_object <-
      redcap_event_read(
        redcap_uri        = credential$redcap_uri,
        token             = credential$token,
        verbose           = TRUE
      )
  })

  expect_equal(returned_object$data, expected=empty_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object2$data$bmi<-NULL; returned_object2$data$age<-NULL;dput(returned_object2$data)
  expect_equal(returned_object$status_code, expected=400L)
  expect_equal(returned_object$raw_text, expected="ERROR: You cannot export events for classic projects", ignore_attr = TRUE) # dput(returned_object2$raw_text)
  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
  expect_false(returned_object$success)
})

test_that("delete-multiple-arm", {
  testthat::skip_on_cran()
  credential  <- retrieve_credential_testing(2627L)

  path_expected <- "test-data/delete-multiple-arm/event.csv"
  expected_data_frame <- retrieve_expected_events(path_expected)

  expected_outcome_message <- "The list of events was retrieved from the REDCap project in \\d+(\\.\\d+\\W|\\W)seconds\\."
  returned_object <-
    redcap_event_read(
      redcap_uri        = credential$redcap_uri,
      token             = credential$token,
      verbose           = FALSE
    )

  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object2$data$bmi<-NULL; returned_object2$data$age<-NULL;dput(returned_object2$data)
  expect_equal(returned_object$status_code, expected=200L)
  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object2$raw_text)
  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
  expect_true(returned_object$success)
})

test_that("delete-single-arm", {
  testthat::skip_on_cran()
  credential  <- retrieve_credential_testing(2626L)

  expected_outcome_message <- "A 'classic' REDCap project has no events.  Retrieved in \\d+(\\.\\d+\\W|\\W)seconds\\."
  expect_message({
    returned_object <-
      redcap_event_read(
        redcap_uri        = credential$redcap_uri,
        token             = credential$token,
        verbose           = TRUE
      )
  })

  expect_equal(returned_object$data, expected=empty_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object2$data$bmi<-NULL; returned_object2$data$age<-NULL;dput(returned_object2$data)
  expect_equal(returned_object$status_code, expected=400L)
  expect_equal(returned_object$raw_text, expected="ERROR: You cannot export events for classic projects", ignore_attr = TRUE) # dput(returned_object2$raw_text)
  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
  expect_false(returned_object$success)
})

test_that("Bad Token", {
  testthat::skip_on_cran()
  credential  <- retrieve_credential_testing(2629L)
  bad_token   <- "1234567890ABCDEF1234567890ABCDEF"

  expected_error_message <- "The REDCapR event export failed\\. The http status code was 403. The error message was: 'ERROR: You do not have permissions to use the API'"
  expect_error(
    redcap_event_read(
      redcap_uri        = credential$redcap_uri,
      token             = bad_token,
      verbose           = FALSE
    ),
    regexp = expected_error_message
  )
})

rm(retrieve_expected_events, empty_data_frame)