diff --git a/NAMESPACE b/NAMESPACE
index 5585d7c0..1d6baf3e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -20,13 +20,19 @@ importFrom(REDCapR,redcap_event_instruments)
importFrom(REDCapR,redcap_instruments)
importFrom(REDCapR,redcap_metadata_read)
importFrom(REDCapR,redcap_read_oneshot)
+importFrom(REDCapR,sanitize_token)
importFrom(checkmate,assert_character)
importFrom(checkmate,assert_data_frame)
+importFrom(checkmate,check_character)
+importFrom(checkmate,check_choice)
+importFrom(checkmate,check_environment)
+importFrom(checkmate,check_logical)
importFrom(checkmate,expect_character)
importFrom(checkmate,expect_double)
importFrom(checkmate,expect_factor)
importFrom(checkmate,expect_logical)
importFrom(cli,cli_abort)
+importFrom(cli,cli_vec)
importFrom(cli,cli_warn)
importFrom(dplyr,"%>%")
importFrom(dplyr,across)
@@ -50,17 +56,22 @@ importFrom(purrr,compose)
importFrom(purrr,map)
importFrom(purrr,map2)
importFrom(purrr,map_int)
+importFrom(purrr,map_lgl)
importFrom(purrr,pluck)
importFrom(rlang,"!!!")
importFrom(rlang,.data)
importFrom(rlang,as_closure)
+importFrom(rlang,as_label)
+importFrom(rlang,caller_arg)
importFrom(rlang,caller_env)
importFrom(rlang,check_installed)
importFrom(rlang,current_env)
importFrom(rlang,enquo)
importFrom(rlang,env_poke)
importFrom(rlang,global_env)
+importFrom(rlang,is_atomic)
importFrom(rlang,is_bare_formula)
+importFrom(rlang,is_bare_list)
importFrom(rlang,new_environment)
importFrom(stringi,stri_split_fixed)
importFrom(stringr,str_detect)
diff --git a/R/bind_tibbles.R b/R/bind_tibbles.R
index ff43f233..52c082cb 100644
--- a/R/bind_tibbles.R
+++ b/R/bind_tibbles.R
@@ -22,27 +22,27 @@
#' @importFrom purrr map2 pluck
#'
#' @examples
+#' \dontrun{
#' # Create an empty environment
#' my_env <- new.env()
#'
#' ls(my_env)
#'
-#' # Mock up a supertibble
-#' supertbl <- tibble::tribble(
-#' ~redcap_form_name, ~redcap_data, ~structure,
-#' "super_hero_powers", list(), "repeating",
-#' "heroes_information", list(), "nonrepeating"
-#' )
+#' superheroes_supertbl
#'
-#' bind_tibbles(supertbl, my_env)
+#' bind_tibbles(superheroes_supertbl, my_env)
#'
#' ls(my_env)
-#'
+#'}
#' @export
bind_tibbles <- function(supertbl,
environment = global_env(),
tbls = NULL) {
+ check_arg_is_supertbl(supertbl, req_cols = "redcap_data")
+ check_arg_is_env(environment)
+ check_arg_is_character(tbls, null.ok = TRUE, any.missing = FALSE, min.len = 1)
+
# Name variables
my_supertbl <- supertbl
diff --git a/R/checks.R b/R/checks.R
index d183fb88..6d9ba571 100644
--- a/R/checks.R
+++ b/R/checks.R
@@ -9,7 +9,7 @@
#' @return
#' A helpful error message alerting the user to check their API privileges.
#'
-#' @importFrom rlang .data
+#' @importFrom rlang .data caller_env
#' @importFrom dplyr filter select group_by summarise
#' @importFrom tidyr pivot_wider
#' @importFrom cli cli_warn
@@ -17,11 +17,13 @@
#' @param db_data The REDCap database output generated by
#' \code{REDCapR::redcap_read_oneshot()$data}
#' @param db_metadata The REDCap metadata output generated by \code{REDCapR::redcap_metadata_read()$data}
+#' @param call the calling environment to use in the warning message
#'
#' @keywords internal
check_user_rights <- function(db_data,
- db_metadata) {
+ db_metadata,
+ call = caller_env()) {
missing_db_metadata <- db_metadata %>% # nolint: object_usage_linter
filter(!.data$field_name_updated %in% names(db_data)) %>%
select("field_name_updated", "form_name") %>%
@@ -35,7 +37,8 @@ check_user_rights <- function(db_data,
exporting certain instruments via the API. The following variable{?s}
are affected: {unlist(missing_db_metadata$fields)}"
),
- class = c("redcap_user_rights", "REDCapTidieR_cond")
+ class = c("redcap_user_rights", "REDCapTidieR_cond"),
+ call = call
)
}
@@ -53,16 +56,18 @@ check_user_rights <- function(db_data,
#'
#' @param db_data The REDCap database output generated by
#' \code{REDCapR::redcap_read_oneshot()$data}
+#' @param call the calling environment to use in the error message
#'
#' @importFrom dplyr %>% select mutate case_when
#' @importFrom purrr map2
#' @importFrom tidyselect any_of
#' @importFrom cli cli_abort
+#' @importFrom rlang caller_env
#'
#' @keywords internal
-check_repeat_and_nonrepeat <- function(db_data) {
+check_repeat_and_nonrepeat <- function(db_data, call = caller_env()) {
# This check function looks for potential repeat/nonrepeat behavior using the
# steps below:
# 1) Define standard columns that don't need checking and remove those from
@@ -104,7 +109,8 @@ check_repeat_and_nonrepeat <- function(db_data) {
"nonrepeating" %in% check_data) {
cli_abort(c("x" = "Instrument detected that has both repeating and
nonrepeating instances defined in the project: {rep}"),
- class = c("repeat_nonrepeat_instrument", "REDCapTidieR_cond")
+ class = c("repeat_nonrepeat_instrument", "REDCapTidieR_cond"),
+ call = call
)
}
}
@@ -129,18 +135,21 @@ check_repeat_and_nonrepeat <- function(db_data) {
#'
#' @param db_data The REDCap database output generated by
#' \code{REDCapR::redcap_read_oneshot()$data}
+#' @param call the calling environment to use in the error message
#'
#' @importFrom cli cli_abort
+#' @importFrom rlang caller_env
#'
#' @keywords internal
-check_redcap_populated <- function(db_data) {
+check_redcap_populated <- function(db_data, call = caller_env()) {
if (ncol(db_data) == 0) {
cli_abort(
"The REDCap API did not return any data. This can happen when there are no
data entered or when the access isn't configured to allow data export
through the API.",
- class = c("redcap_unpopulated", "REDCapTidieR_cond")
+ class = c("redcap_unpopulated", "REDCapTidieR_cond"),
+ call = call
)
}
}
@@ -157,56 +166,24 @@ check_redcap_populated <- function(db_data) {
#' An error message listing the requested instruments that don't exist
#'
#' @importFrom cli cli_abort
+#' @importFrom rlang caller_env
#'
#' @param db_metadata The metadata file read by
#' \code{REDCapR::redcap_metadata_read()}
#' @param forms The character vector of instrument names passed to
#' \code{read_redcap()}
+#' @param call the calling environment to use in the error message
#'
#' @keywords internal
-check_forms_exist <- function(db_metadata, forms) {
+check_forms_exist <- function(db_metadata, forms, call = caller_env()) {
missing_forms <- setdiff(forms, unique(db_metadata$form_name))
if (length(missing_forms) > 0) {
cli_abort(
c("x" = "Instrument{?s} {missing_forms} {?does/do} not exist in REDCap
project"),
- class = c("form_does_not_exist", "REDCapTidieR_cond")
- )
- }
-}
-
-#' @title
-#' Check that a supertibble contains \code{redcap_data} and
-#' \code{redcap_metadata} fields
-#'
-#' @description
-#' Provide an error message when a tibble is missing \code{redcap_data} or
-#' \code{redcap_metadata}
-#'
-#' @importFrom cli cli_abort
-#'
-#' @param supertbl a supertibble
-#'
-#' @return
-#' An error message indicating that the required columns are missing
-#'
-#' @keywords internal
-check_req_labelled_fields <- function(supertbl) {
- # Check for presence of req fields
- req_fields <- c("redcap_data", "redcap_metadata")
- missing_fields <- setdiff(req_fields, colnames(supertbl))
-
- # If any are missing give an error message
- if (length(missing_fields) > 0) {
- cli_abort(
- c(
- "!" = "{.arg supertbl} must contain {.code {req_fields}}",
- "x" = "You are missing {.code {missing_fields}}"
- ),
- class = c("missing_req_labelled_fields", "REDCapTidieR_cond"),
- # pass along the fields that were missing as metadata
- missing_fields = missing_fields
+ class = c("form_does_not_exist", "REDCapTidieR_cond"),
+ call = call
)
}
}
@@ -218,14 +195,16 @@ check_req_labelled_fields <- function(supertbl) {
#' @importFrom purrr map map_int
#' @importFrom dplyr %>% filter
#' @importFrom cli cli_abort
+#' @importFrom rlang caller_arg
#'
#' @param supertbl a supertibble containing a \code{redcap_metadata} column
+#' @param call the calling environment to use in the error message
#'
#' @return
#' an error message alerting that instrument metadata is incomplete
#'
#' @keywords internal
-check_req_labelled_metadata_fields <- function(supertbl) {
+check_req_labelled_metadata_fields <- function(supertbl, call = caller_env()) {
req_fields <- c("field_name", "field_label") # nolint: object_usage_linter
# map over each metadata tibble and return list element with missing fields
@@ -268,7 +247,167 @@ check_req_labelled_metadata_fields <- function(supertbl) {
cli_abort(
msg,
- class = c("missing_req_labelled_metadata_fields", "REDCapTidieR_cond")
+ class = c("missing_req_labelled_metadata_fields", "REDCapTidieR_cond"),
+ call = call
+ )
+ }
+}
+
+
+#' @title
+#' Check an argument with checkmate
+#'
+#' @importFrom cli cli_abort
+#' @importFrom rlang caller_arg
+#'
+#' @param x An object to check
+#' @param arg The name of the argument to include in an error message. Captured
+#' by `rlang::caller_arg()` by default
+#' @param call the calling environment to use in the error message
+#' @param req_cols required fields for `check_arg_is_supertbl()`
+#' @param ... additional arguments passed on to checkmate
+#'
+#' @return
+#' `TRUE` if `x` passes the checkmate check. An error otherwise with the name of
+#' the checkmate function as a `class`
+#'
+#' @name checkmate
+#' @keywords internal
+NULL
+
+# Function factory to wrap checkmate functions
+#' @importFrom rlang caller_arg caller_env
+#' @importFrom cli cli_abort
+#' @noRd
+wrap_checkmate <- function(f) {
+ error_class <- caller_arg(f)
+
+ function(x, ..., arg = caller_arg(x), call = caller_env()) {
+ out <- f(x, ...)
+
+ if (isTRUE(out)) {
+ return(TRUE)
+ }
+
+ cli_abort(
+ message = c(
+ "x" = "You've supplied {.code {format_error_val(x)}} for {.arg {arg}} which is not a valid value",
+ "!" = "{out}"
+ ),
+ class = c(error_class, "REDCapTidieR_cond"),
+ call = call
+ )
+ }
+}
+
+#' @rdname checkmate
+#' @importFrom cli cli_abort
+#' @importFrom rlang caller_env caller_arg is_bare_list
+#' @importFrom purrr map_lgl
+check_arg_is_supertbl <- function(x,
+ req_cols = c("redcap_data", "redcap_metadata"),
+ arg = caller_arg(x),
+ call = caller_env()) {
+
+ # shared data for all messages
+ msg_x <- "You've supplied {.code {format_error_val(x)}} for {.arg {arg}} which is not a valid value"
+ msg_info <- "{.arg {arg}} must be a {.pkg REDCapTidieR} supertibble, generated using {.code read_redcap()}"
+ msg_class <- c("check_supertbl", "REDCapTidieR_cond")
+
+ if (!inherits(x, "redcap_supertbl")) {
+ cli_abort(
+ message = c(
+ "x" = msg_x,
+ "!" = "Must be of class {.cls redcap_supertbl}",
+ "i" = msg_info
+ ),
+ class = msg_class,
+ call = call
+ )
+ }
+
+ missing_cols <- setdiff(req_cols, colnames(x))
+
+ # If any are missing give an error message
+ if (length(missing_cols) > 0) {
+ cli_abort(
+ message = c(
+ "x" = msg_x,
+ "!" = "Must contain {.code {paste0(arg, '$', missing_cols)}}",
+ "i" = msg_info
+ ),
+ class = c("missing_req_cols", msg_class),
+ call = call,
+ missing_cols = missing_cols
+ )
+ }
+
+ non_list_cols <- map_lgl(x[req_cols], ~!is_bare_list(.))
+ non_list_cols <- req_cols[non_list_cols]
+
+ if (length(non_list_cols) > 0) {
+ cli_abort(
+ message = c(
+ "x" = msg_x,
+ "!" = "{.code {paste0(arg, '$', non_list_cols)}} must be of type 'list'",
+ "i" = msg_info
+ ),
+ class = c("missing_req_list_cols", msg_class),
+ call = call,
+ non_list_cols = non_list_cols
)
}
+
+ return(TRUE)
+}
+
+#' @rdname checkmate
+#' @importFrom checkmate check_environment
+check_arg_is_env <- wrap_checkmate(check_environment)
+
+#' @rdname checkmate
+#' @importFrom checkmate check_character
+check_arg_is_character <- wrap_checkmate(check_character)
+
+#' @rdname checkmate
+#' @importFrom checkmate check_logical
+check_arg_is_logical <- wrap_checkmate(check_logical)
+
+#' @rdname checkmate
+#' @importFrom checkmate check_choice
+check_arg_choices <- wrap_checkmate(check_choice)
+
+#' @rdname checkmate
+#' @importFrom REDCapR sanitize_token
+check_arg_is_valid_token <- function(x,
+ arg = caller_arg(x),
+ call = caller_env()) {
+ check_arg_is_character(x, len = 1, any.missing = FALSE,
+ arg = arg, call = call)
+
+ sanitize_token(x)
+
+ return(TRUE)
+}
+
+#' @title
+#' Format value for error message
+#'
+#' @param x value to format
+#'
+#' @return
+#' If x is atomic, x with cli formatting to truncate to 5 values. Otherwise,
+#' a string summarizing x produced by as_label
+#'
+#' @importFrom rlang as_label is_atomic
+#' @importFrom cli cli_vec
+#'
+#' @keywords internal
+format_error_val <- function(x) {
+ if (is_atomic(x)) {
+ out <- cli_vec(x, style = list("vec-trunc" = 5, "vec-last" = ", "))
+ } else {
+ out <- as_label(x)
+ }
+ out
}
diff --git a/R/data.R b/R/data.R
new file mode 100644
index 00000000..9fca615d
--- /dev/null
+++ b/R/data.R
@@ -0,0 +1,32 @@
+#' Superheroes Data
+#'
+#' A dataset of superheroes in a REDCapTidieR `supertbl` object
+#'
+#' @format
+#' ## `heroes_information`
+#' A `tibble` with 734 rows and 12 columns:
+#' \describe{
+#' \item{record_id}{REDCap record ID}
+#' \item{name}{Hero name}
+#' \item{gender}{Gender}
+#' \item{eye_color}{Eye color}
+#' \item{race}{Race}
+#' \item{hair_color}{Hair color}
+#' \item{height}{Height}
+#' \item{weight}{Weight}
+#' \item{publisher}{Publisher}
+#' \item{skin_color}{Skin color}
+#' \item{alignment}{Alignment}
+#' \item{form_status_complete}{REDCap instrument completed?}
+#' }
+#'
+#' ## `super_hero_powers`
+#' A `tibble` with 5,966 rows and 4 columns:
+#' \describe{
+#' \item{record_id}{REDCap record ID}
+#' \item{redcap_repeat_instance}{REDCap repeat instance}
+#' \item{power}{Super power}
+#' \item{form_status_complete}{REDCap instrument completed?}
+#' }
+#' @source
+"superheroes_supertbl"
diff --git a/R/extract_tibble.R b/R/extract_tibble.R
index 50ad5700..c3f634f0 100644
--- a/R/extract_tibble.R
+++ b/R/extract_tibble.R
@@ -15,29 +15,20 @@
#' @param tbl The `redcap_form_name` of the data tibble to extract. Required.
#'
#' @importFrom checkmate assert_character
-#' @importFrom cli cli_abort
#' @importFrom tidyselect all_of
#'
#' @examples
-#' # Mock up a supertibble
-#' sample_data <- tibble::tribble(
-#' ~redcap_form_name, ~redcap_data, ~structure,
-#' "super_hero_powers", list(), "repeating",
-#' "heroes_information", list(), "nonrepeating"
-#' )
+#' superheroes_supertbl
#'
-#' extract_tibble(sample_data, "heroes_information")
+#' extract_tibble(superheroes_supertbl, "heroes_information")
#'
#' @export
extract_tibble <- function(supertbl,
tbl) {
- # Check tbl is valid ----
- assert_character(tbl)
-
- if (length(tbl) > 1) {
- cli_abort("Only one table may be supplied.")
- }
+ # Check args ----
+ check_arg_is_supertbl(supertbl, req_cols = "redcap_data")
+ check_arg_is_character(tbl, len = 1, any.missing = FALSE)
# Extract specified table ----
out <- extract_tibbles(supertbl, tbls = all_of(tbl))[[1]]
@@ -71,23 +62,20 @@ extract_tibble <- function(supertbl,
#' @importFrom purrr map pluck
#'
#' @examples
-#' # Mock up a supertibble
-#' sample_data <- tibble::tribble(
-#' ~redcap_form_name, ~redcap_data, ~structure,
-#' "super_hero_powers", list(), "repeating",
-#' "heroes_information", list(), "nonrepeating"
-#' )
+#' superheroes_supertbl
#'
#' # Extract all data tibbles
-#' extract_tibbles(sample_data)
+#' extract_tibbles(superheroes_supertbl)
#'
#' # Only extract data tibbles starting with "heroes"
-#' extract_tibbles(sample_data, starts_with("heroes"))
+#' extract_tibbles(superheroes_supertbl, starts_with("heroes"))
#'
#' @export
extract_tibbles <- function(supertbl,
tbls = everything()) {
+ check_arg_is_supertbl(supertbl, req_cols = "redcap_data")
+
# Extract specified table ----
# Pass tbls as an expression for enquosure
tbls <- enquo(tbls)
diff --git a/R/labelled.R b/R/labelled.R
index 38efaf7c..6ea80807 100644
--- a/R/labelled.R
+++ b/R/labelled.R
@@ -31,15 +31,11 @@
#' A labelled supertibble.
#'
#' @examples
-#' supertbl <- tibble::tribble(
-#' ~redcap_data, ~redcap_metadata,
-#' tibble::tibble(x = letters[1:3]), tibble::tibble(field_name = "x", field_label = "X Label"),
-#' tibble::tibble(y = letters[1:3]), tibble::tibble(field_name = "y", field_label = "Y Label")
-#' )
+#' superheroes_supertbl
#'
-#' make_labelled(supertbl)
+#' make_labelled(superheroes_supertbl)
#'
-#' make_labelled(supertbl, format_labels = tolower)
+#' make_labelled(superheroes_supertbl, format_labels = tolower)
#'
#' \dontrun{
#' redcap_uri <- Sys.getenv("REDCAP_URI")
@@ -54,8 +50,7 @@ make_labelled <- function(supertbl, format_labels = NULL) {
formatter <- resolve_formatter(format_labels) # nolint: object_usage_linter
- assert_data_frame(supertbl)
- check_req_labelled_fields(supertbl)
+ check_arg_is_supertbl(supertbl)
check_req_labelled_metadata_fields(supertbl)
# Derive labels ----
@@ -196,12 +191,9 @@ make_labelled <- function(supertbl, format_labels = NULL) {
#'
#' fmt_strip_field_embedding("Label{another_field}")
#'
-#' supertbl <- tibble::tribble(
-#' ~redcap_data, ~redcap_metadata,
-#' tibble::tibble(x = letters[1:3]), tibble::tibble(field_name = "x", field_label = "X Label:")
-#' )
+#' superheroes_supertbl
#'
-#' make_labelled(supertbl, format_labels = fmt_strip_trailing_colon)
+#' make_labelled(superheroes_supertbl, format_labels = fmt_strip_trailing_colon)
#'
#' @name format-helpers
NULL
@@ -251,6 +243,7 @@ fmt_strip_field_embedding <- function(x) {
#' \code{format_labels} contains character elements. The default,
#' \code{caller_env(n = 2)}, uses the environment from which the user called
#' \code{make_labelled()}
+#' @param call the calling environment to use in the error message
#'
#' @importFrom purrr map compose
#' @importFrom rlang !!! as_closure caller_env is_bare_formula
@@ -260,7 +253,7 @@ fmt_strip_field_embedding <- function(x) {
#'
#' @keywords internal
#'
-resolve_formatter <- function(format_labels, env = caller_env(n = 2)) {
+resolve_formatter <- function(format_labels, env = caller_env(n = 2), call = caller_env()) {
if (is.null(format_labels)) {
# If NULL pass labels through unchanged
return(identity)
@@ -289,6 +282,7 @@ resolve_formatter <- function(format_labels, env = caller_env(n = 2)) {
"!" = "{.arg format_labels} must be of class {.cls {supported_classes}}",
"x" = "{.arg format_labels} is {.cls {class(format_labels)}}"
),
- class = c("unresolved_formatter", "REDCapTidieR_cond")
+ class = c("unresolved_formatter", "REDCapTidieR_cond"),
+ call = call
)
}
diff --git a/R/read_redcap.R b/R/read_redcap.R
index 67fc015e..900ec2f4 100644
--- a/R/read_redcap.R
+++ b/R/read_redcap.R
@@ -72,6 +72,14 @@ read_redcap <- function(redcap_uri,
forms = NULL,
export_survey_fields = TRUE,
suppress_redcapr_messages = TRUE) {
+
+ check_arg_is_character(redcap_uri, len = 1, any.missing = FALSE)
+ check_arg_is_valid_token(token)
+ check_arg_choices(raw_or_label, choices = c("label", "raw"))
+ check_arg_is_character(forms, min.len = 1, null.ok = TRUE, any.missing = FALSE)
+ check_arg_is_logical(export_survey_fields, len = 1, any.missing = FALSE)
+ check_arg_is_logical(suppress_redcapr_messages, len = 1, any.missing = FALSE)
+
# Load REDCap Metadata ----
db_metadata <- redcap_metadata_read(
redcap_uri = redcap_uri,
@@ -228,7 +236,7 @@ read_redcap <- function(redcap_uri,
out <- add_event_mapping(out, linked_arms)
}
- out %>%
+ out <- out %>%
dplyr::slice(
order(
factor(
@@ -237,6 +245,8 @@ read_redcap <- function(redcap_uri,
)
)
)
+
+ as_supertbl(out)
}
#' @title
@@ -441,3 +451,18 @@ calc_metadata_stats <- function(data) {
data_na_pct = percent(na_pct, digits = 2, format = "fg")
)
}
+
+#' @title
+#' Add supertbl S3 class
+#'
+#' @param x an object to class
+#'
+#' @return
+#' The object with `redcaptidier_supertbl` S3 class
+#'
+#' @keywords internal
+#'
+as_supertbl <- function(x) {
+ class(x) <- c("redcap_supertbl", class(x))
+ x
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 6b6d7a96..65c8f292 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -42,3 +42,6 @@ reference:
contents:
- make_labelled
- format-helpers
+- title: "Data"
+ contents:
+ - superheroes_supertbl
diff --git a/data-raw/superheroes_supertbl.R b/data-raw/superheroes_supertbl.R
new file mode 100644
index 00000000..5645cd79
--- /dev/null
+++ b/data-raw/superheroes_supertbl.R
@@ -0,0 +1,6 @@
+redcap_uri <- Sys.getenv("REDCAP_URI")
+token <- Sys.getenv("SUPERHEROES_REDCAP_API")
+
+superheroes_supertbl <- read_redcap(redcap_uri, token)
+
+usethis::use_data(superheroes_supertbl, overwrite = TRUE)
diff --git a/data/superheroes_supertbl.rda b/data/superheroes_supertbl.rda
new file mode 100644
index 00000000..14b619b6
Binary files /dev/null and b/data/superheroes_supertbl.rda differ
diff --git a/inst/testdata/redcaptidier_longitudinal_db.RDS b/inst/testdata/redcaptidier_longitudinal_db.RDS
index 07e7d0b9..53f4def9 100644
Binary files a/inst/testdata/redcaptidier_longitudinal_db.RDS and b/inst/testdata/redcaptidier_longitudinal_db.RDS differ
diff --git a/man/as_supertbl.Rd b/man/as_supertbl.Rd
new file mode 100644
index 00000000..bd317197
--- /dev/null
+++ b/man/as_supertbl.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read_redcap.R
+\name{as_supertbl}
+\alias{as_supertbl}
+\title{Add supertbl S3 class}
+\usage{
+as_supertbl(x)
+}
+\arguments{
+\item{x}{an object to class}
+}
+\value{
+The object with \code{redcaptidier_supertbl} S3 class
+}
+\description{
+Add supertbl S3 class
+}
+\keyword{internal}
diff --git a/man/bind_tibbles.Rd b/man/bind_tibbles.Rd
index b9ebeef3..c8f8dacc 100644
--- a/man/bind_tibbles.Rd
+++ b/man/bind_tibbles.Rd
@@ -26,20 +26,16 @@ and bind its data tibbles (i.e. the tibbles in the \code{redcap_data} column) to
an environment. The default is the global environment.
}
\examples{
+\dontrun{
# Create an empty environment
my_env <- new.env()
ls(my_env)
-# Mock up a supertibble
-supertbl <- tibble::tribble(
- ~redcap_form_name, ~redcap_data, ~structure,
- "super_hero_powers", list(), "repeating",
- "heroes_information", list(), "nonrepeating"
-)
+superheroes_supertbl
-bind_tibbles(supertbl, my_env)
+bind_tibbles(superheroes_supertbl, my_env)
ls(my_env)
-
+}
}
diff --git a/man/check_forms_exist.Rd b/man/check_forms_exist.Rd
index 02d329ee..b49cddb4 100644
--- a/man/check_forms_exist.Rd
+++ b/man/check_forms_exist.Rd
@@ -4,7 +4,7 @@
\alias{check_forms_exist}
\title{Check that all requested instruments are in REDCap project metadata}
\usage{
-check_forms_exist(db_metadata, forms)
+check_forms_exist(db_metadata, forms, call = caller_env())
}
\arguments{
\item{db_metadata}{The metadata file read by
@@ -12,6 +12,8 @@ check_forms_exist(db_metadata, forms)
\item{forms}{The character vector of instrument names passed to
\code{read_redcap()}}
+
+\item{call}{the calling environment to use in the error message}
}
\value{
An error message listing the requested instruments that don't exist
diff --git a/man/check_redcap_populated.Rd b/man/check_redcap_populated.Rd
index 16c65e04..17993009 100644
--- a/man/check_redcap_populated.Rd
+++ b/man/check_redcap_populated.Rd
@@ -4,11 +4,13 @@
\alias{check_redcap_populated}
\title{Check that a supplied REDCap database is populated}
\usage{
-check_redcap_populated(db_data)
+check_redcap_populated(db_data, call = caller_env())
}
\arguments{
\item{db_data}{The REDCap database output generated by
\code{REDCapR::redcap_read_oneshot()$data}}
+
+\item{call}{the calling environment to use in the error message}
}
\value{
A helpful error message alerting the user to check their API privileges.
diff --git a/man/check_repeat_and_nonrepeat.Rd b/man/check_repeat_and_nonrepeat.Rd
index e16ca84e..053fe608 100644
--- a/man/check_repeat_and_nonrepeat.Rd
+++ b/man/check_repeat_and_nonrepeat.Rd
@@ -4,11 +4,13 @@
\alias{check_repeat_and_nonrepeat}
\title{Check for instruments that have both repeating and non-repeating structure}
\usage{
-check_repeat_and_nonrepeat(db_data)
+check_repeat_and_nonrepeat(db_data, call = caller_env())
}
\arguments{
\item{db_data}{The REDCap database output generated by
\code{REDCapR::redcap_read_oneshot()$data}}
+
+\item{call}{the calling environment to use in the error message}
}
\value{
A helpful error message alerting the user to existence of an instrument
diff --git a/man/check_req_labelled_fields.Rd b/man/check_req_labelled_fields.Rd
deleted file mode 100644
index 1872fc40..00000000
--- a/man/check_req_labelled_fields.Rd
+++ /dev/null
@@ -1,20 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/checks.R
-\name{check_req_labelled_fields}
-\alias{check_req_labelled_fields}
-\title{Check that a supertibble contains \code{redcap_data} and
-\code{redcap_metadata} fields}
-\usage{
-check_req_labelled_fields(supertbl)
-}
-\arguments{
-\item{supertbl}{a supertibble}
-}
-\value{
-An error message indicating that the required columns are missing
-}
-\description{
-Provide an error message when a tibble is missing \code{redcap_data} or
-\code{redcap_metadata}
-}
-\keyword{internal}
diff --git a/man/check_req_labelled_metadata_fields.Rd b/man/check_req_labelled_metadata_fields.Rd
index 2f3f74fd..40475635 100644
--- a/man/check_req_labelled_metadata_fields.Rd
+++ b/man/check_req_labelled_metadata_fields.Rd
@@ -5,10 +5,12 @@
\title{Check that all metadata tibbles within a supertibble contain
\code{field_name} and \code{field_label} columns}
\usage{
-check_req_labelled_metadata_fields(supertbl)
+check_req_labelled_metadata_fields(supertbl, call = caller_env())
}
\arguments{
\item{supertbl}{a supertibble containing a \code{redcap_metadata} column}
+
+\item{call}{the calling environment to use in the error message}
}
\value{
an error message alerting that instrument metadata is incomplete
diff --git a/man/check_user_rights.Rd b/man/check_user_rights.Rd
index 85e56c86..6dfcccd9 100644
--- a/man/check_user_rights.Rd
+++ b/man/check_user_rights.Rd
@@ -4,13 +4,15 @@
\alias{check_user_rights}
\title{Check for possible API user privilege issues}
\usage{
-check_user_rights(db_data, db_metadata)
+check_user_rights(db_data, db_metadata, call = caller_env())
}
\arguments{
\item{db_data}{The REDCap database output generated by
\code{REDCapR::redcap_read_oneshot()$data}}
\item{db_metadata}{The REDCap metadata output generated by \code{REDCapR::redcap_metadata_read()$data}}
+
+\item{call}{the calling environment to use in the warning message}
}
\value{
A helpful error message alerting the user to check their API privileges.
diff --git a/man/checkmate.Rd b/man/checkmate.Rd
new file mode 100644
index 00000000..7c17a3c6
--- /dev/null
+++ b/man/checkmate.Rd
@@ -0,0 +1,49 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/checks.R
+\name{checkmate}
+\alias{checkmate}
+\alias{check_arg_is_supertbl}
+\alias{check_arg_is_env}
+\alias{check_arg_is_character}
+\alias{check_arg_is_logical}
+\alias{check_arg_choices}
+\alias{check_arg_is_valid_token}
+\title{Check an argument with checkmate}
+\usage{
+check_arg_is_supertbl(
+ x,
+ req_cols = c("redcap_data", "redcap_metadata"),
+ arg = caller_arg(x),
+ call = caller_env()
+)
+
+check_arg_is_env(x, ..., arg = caller_arg(x), call = caller_env())
+
+check_arg_is_character(x, ..., arg = caller_arg(x), call = caller_env())
+
+check_arg_is_logical(x, ..., arg = caller_arg(x), call = caller_env())
+
+check_arg_choices(x, ..., arg = caller_arg(x), call = caller_env())
+
+check_arg_is_valid_token(x, arg = caller_arg(x), call = caller_env())
+}
+\arguments{
+\item{x}{An object to check}
+
+\item{req_cols}{required fields for \code{check_arg_is_supertbl()}}
+
+\item{arg}{The name of the argument to include in an error message. Captured
+by \code{rlang::caller_arg()} by default}
+
+\item{call}{the calling environment to use in the error message}
+
+\item{...}{additional arguments passed on to checkmate}
+}
+\value{
+\code{TRUE} if \code{x} passes the checkmate check. An error otherwise with the name of
+the checkmate function as a \code{class}
+}
+\description{
+Check an argument with checkmate
+}
+\keyword{internal}
diff --git a/man/extract_tibble.Rd b/man/extract_tibble.Rd
index 2f569bec..c2cf6b83 100644
--- a/man/extract_tibble.Rd
+++ b/man/extract_tibble.Rd
@@ -23,13 +23,8 @@ This function makes it easy to extract a single instrument's data from a
REDCapTidieR supertibble.
}
\examples{
-# Mock up a supertibble
-sample_data <- tibble::tribble(
- ~redcap_form_name, ~redcap_data, ~structure,
- "super_hero_powers", list(), "repeating",
- "heroes_information", list(), "nonrepeating"
-)
+superheroes_supertbl
-extract_tibble(sample_data, "heroes_information")
+extract_tibble(superheroes_supertbl, "heroes_information")
}
diff --git a/man/extract_tibbles.Rd b/man/extract_tibbles.Rd
index 51ad9a48..99ac8a01 100644
--- a/man/extract_tibbles.Rd
+++ b/man/extract_tibbles.Rd
@@ -26,17 +26,12 @@ tidyselect helper functions such as \code{dplyr::starts_with()}
or \code{dplyr::ends_with()} is supported.
}
\examples{
-# Mock up a supertibble
-sample_data <- tibble::tribble(
- ~redcap_form_name, ~redcap_data, ~structure,
- "super_hero_powers", list(), "repeating",
- "heroes_information", list(), "nonrepeating"
-)
+superheroes_supertbl
# Extract all data tibbles
-extract_tibbles(sample_data)
+extract_tibbles(superheroes_supertbl)
# Only extract data tibbles starting with "heroes"
-extract_tibbles(sample_data, starts_with("heroes"))
+extract_tibbles(superheroes_supertbl, starts_with("heroes"))
}
diff --git a/man/format-helpers.Rd b/man/format-helpers.Rd
index 835f27a5..0fdcb265 100644
--- a/man/format-helpers.Rd
+++ b/man/format-helpers.Rd
@@ -55,11 +55,8 @@ fmt_strip_html("Bold Label")
fmt_strip_field_embedding("Label{another_field}")
-supertbl <- tibble::tribble(
- ~redcap_data, ~redcap_metadata,
- tibble::tibble(x = letters[1:3]), tibble::tibble(field_name = "x", field_label = "X Label:")
-)
+superheroes_supertbl
-make_labelled(supertbl, format_labels = fmt_strip_trailing_colon)
+make_labelled(superheroes_supertbl, format_labels = fmt_strip_trailing_colon)
}
diff --git a/man/format_error_val.Rd b/man/format_error_val.Rd
new file mode 100644
index 00000000..8748755c
--- /dev/null
+++ b/man/format_error_val.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/checks.R
+\name{format_error_val}
+\alias{format_error_val}
+\title{Format value for error message}
+\usage{
+format_error_val(x)
+}
+\arguments{
+\item{x}{value to format}
+}
+\value{
+If x is atomic, x with cli formatting to truncate to 5 values. Otherwise,
+a string summarizing x produced by as_label
+}
+\description{
+Format value for error message
+}
+\keyword{internal}
diff --git a/man/make_labelled.Rd b/man/make_labelled.Rd
index e1f5c6fc..9f69ad87 100644
--- a/man/make_labelled.Rd
+++ b/man/make_labelled.Rd
@@ -35,15 +35,11 @@ The variable labels for the data tibbles are derived from the \code{field_label}
column of the metadata tibble.
}
\examples{
-supertbl <- tibble::tribble(
- ~redcap_data, ~redcap_metadata,
- tibble::tibble(x = letters[1:3]), tibble::tibble(field_name = "x", field_label = "X Label"),
- tibble::tibble(y = letters[1:3]), tibble::tibble(field_name = "y", field_label = "Y Label")
-)
+superheroes_supertbl
-make_labelled(supertbl)
+make_labelled(superheroes_supertbl)
-make_labelled(supertbl, format_labels = tolower)
+make_labelled(superheroes_supertbl, format_labels = tolower)
\dontrun{
redcap_uri <- Sys.getenv("REDCAP_URI")
diff --git a/man/resolve_formatter.Rd b/man/resolve_formatter.Rd
index b5bd021b..2e35eaf5 100644
--- a/man/resolve_formatter.Rd
+++ b/man/resolve_formatter.Rd
@@ -4,7 +4,7 @@
\alias{resolve_formatter}
\title{Convert user input into label formatting function}
\usage{
-resolve_formatter(format_labels, env = caller_env(n = 2))
+resolve_formatter(format_labels, env = caller_env(n = 2), call = caller_env())
}
\arguments{
\item{format_labels}{argument passed to \code{make_labelled}}
@@ -13,6 +13,8 @@ resolve_formatter(format_labels, env = caller_env(n = 2))
\code{format_labels} contains character elements. The default,
\code{caller_env(n = 2)}, uses the environment from which the user called
\code{make_labelled()}}
+
+\item{call}{the calling environment to use in the error message}
}
\value{
a function
diff --git a/man/superheroes_supertbl.Rd b/man/superheroes_supertbl.Rd
new file mode 100644
index 00000000..49cc3651
--- /dev/null
+++ b/man/superheroes_supertbl.Rd
@@ -0,0 +1,47 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{superheroes_supertbl}
+\alias{superheroes_supertbl}
+\title{Superheroes Data}
+\format{
+\subsection{\code{heroes_information}}{
+
+A \code{tibble} with 734 rows and 12 columns:
+\describe{
+\item{record_id}{REDCap record ID}
+\item{name}{Hero name}
+\item{gender}{Gender}
+\item{eye_color}{Eye color}
+\item{race}{Race}
+\item{hair_color}{Hair color}
+\item{height}{Height}
+\item{weight}{Weight}
+\item{publisher}{Publisher}
+\item{skin_color}{Skin color}
+\item{alignment}{Alignment}
+\item{form_status_complete}{REDCap instrument completed?}
+}
+}
+
+\subsection{\code{super_hero_powers}}{
+
+A \code{tibble} with 5,966 rows and 4 columns:
+\describe{
+\item{record_id}{REDCap record ID}
+\item{redcap_repeat_instance}{REDCap repeat instance}
+\item{power}{Super power}
+\item{form_status_complete}{REDCap instrument completed?}
+}
+}
+}
+\source{
+\url{https://www.superherodb.com/}
+}
+\usage{
+superheroes_supertbl
+}
+\description{
+A dataset of superheroes in a REDCapTidieR \code{supertbl} object
+}
+\keyword{datasets}
diff --git a/tests/testthat/test-bind_tibbles.R b/tests/testthat/test-bind_tibbles.R
index c9318dfe..8c41b51a 100644
--- a/tests/testthat/test-bind_tibbles.R
+++ b/tests/testthat/test-bind_tibbles.R
@@ -42,3 +42,12 @@ test_that("bind_tibbles works with forms specification", {
expect_true(exists("repeated", envir = global_env()))
rm(list = c("nonrepeated", "repeated"), envir = global_env())
})
+
+test_that("bind_tibbles errors with bad inputs", {
+ supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+
+ expect_error(bind_tibbles(123), class = "check_supertbl")
+ expect_error(bind_tibbles(supertbl, environment = "abc"), class = "check_environment")
+ expect_error(bind_tibbles(supertbl, tbls = 123), class = "check_character")
+})
diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R
index 407c3aac..06122c3e 100644
--- a/tests/testthat/test-checks.R
+++ b/tests/testthat/test-checks.R
@@ -58,30 +58,6 @@ test_that("check_forms_exist works", {
expect_error(check_forms_exist(metadata, forms), regexp = "e and f")
})
-
-test_that("check_req_labelled_fields works", {
- # Check data and metadata column errors
- supertbl_no_data <- tibble::tribble(
- ~redcap_metadata,
- tibble(field_name = "x", field_label = "X Label"),
- tibble(field_name = "y", field_label = "Y Label")
- )
-
- supertbl_no_metadata <- tibble::tribble(
- ~redcap_data,
- tibble(x = letters[1:3]),
- tibble(y = letters[1:3])
- )
-
- ## Errors when data is missing
- check_req_labelled_fields(supertbl_no_data) %>%
- expect_error(class = "missing_req_labelled_fields")
-
- ## Errors when metadata is missing
- check_req_labelled_fields(supertbl_no_metadata) %>%
- expect_error(class = "missing_req_labelled_fields")
-})
-
test_that("check_req_labelled_metadata_fields works", {
# Check field_name and field_label within metadata
supertbl_no_field_name <- tibble::tribble(
@@ -104,3 +80,45 @@ test_that("check_req_labelled_metadata_fields works", {
check_req_labelled_metadata_fields(supertbl_no_field_label) %>%
expect_error(class = "missing_req_labelled_metadata_fields")
})
+
+test_that("checkmate wrappers work", {
+
+ # supertbl
+ expect_error(check_arg_is_supertbl(123), class = "check_supertbl")
+
+ missing_col_supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+
+ missing_list_col_supertbl <- tibble(redcap_data = list(), redcap_metadata = 123) %>%
+ as_supertbl()
+
+ good_supertbl <- tibble(redcap_data = list(), redcap_metadata = list()) %>%
+ as_supertbl()
+
+ expect_error(check_arg_is_supertbl(missing_col_supertbl), class = "missing_req_cols")
+ expect_error(check_arg_is_supertbl(missing_list_col_supertbl), class = "missing_req_list_cols")
+ expect_true(check_arg_is_supertbl(good_supertbl))
+
+ # environment
+ expect_error(check_arg_is_env(123), class = "check_environment")
+ expect_true(check_arg_is_env(new.env()))
+
+ # character
+ expect_error(check_arg_is_character(123), class = "check_character")
+ expect_true(check_arg_is_character("abc"))
+
+ # logical
+ expect_error(check_arg_is_logical(123), class = "check_logical")
+ expect_true(check_arg_is_logical(TRUE))
+
+ # choices
+ expect_error(check_arg_choices(123, choices = letters[1:3]), class = "check_choice")
+ expect_true(check_arg_choices("a", choices = letters[1:3]))
+
+ # token
+ expect_error(check_arg_is_valid_token(123), class = "check_character")
+ expect_error(check_arg_is_valid_token(letters[1:3]), class = "check_character")
+ expect_error(check_arg_is_valid_token("abc"), regexp = "The token is not a valid 32-character hexademical value.")
+ expect_true(check_arg_is_valid_token("123456789ABCDEF123456789ABCDEF01"))
+
+})
diff --git a/tests/testthat/test-extract_tibble.R b/tests/testthat/test-extract_tibble.R
index 76aadd1c..49061943 100644
--- a/tests/testthat/test-extract_tibble.R
+++ b/tests/testthat/test-extract_tibble.R
@@ -43,10 +43,20 @@ test_that("extract_tibbles works with a vector and tidyselect selectors", {
)
expect_error(redcaptidier_longitudintal_db %>%
extract_tibbles(tbls = c("repeated", "fake_instrument_name")))
+
+ expect_error(extract_tibbles(123), class = "check_supertbl")
+
})
test_that("extract_tibble works", {
expect_error(extract_tibble(redcaptidier_longitudintal_db, "fake_instrument_name"))
+ expect_error(extract_tibble(123, "my_tibble"), class = "check_supertbl")
+
+ supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+
+ expect_error(extract_tibble(supertbl, tbl = 123), class = "check_character")
+ expect_error(extract_tibble(supertbl, tbl = letters[1:3]), class = "check_character")
expected_out <- redcaptidier_longitudintal_db$redcap_data[[1]]
expect_equal(
diff --git a/tests/testthat/test-labelled.R b/tests/testthat/test-labelled.R
index 31145816..0f9d66e6 100644
--- a/tests/testthat/test-labelled.R
+++ b/tests/testthat/test-labelled.R
@@ -4,7 +4,8 @@ test_that("make_labelled applies labels to all elements of supertibble", {
~redcap_data, ~redcap_metadata, ~redcap_events,
tibble(x = letters[1:3]), tibble(field_name = "x", field_label = "X Label"), tibble(redcap_event = "event_a"),
tibble(y = letters[1:3]), tibble(field_name = "y", field_label = "Y Label"), tibble(redcap_event = "event_b")
- )
+ ) %>%
+ as_supertbl()
out <- make_labelled(supertbl)
@@ -60,7 +61,9 @@ test_that("make_labelled applies all predefined labeles", {
data_cols = NA,
data_size = NA,
data_na_pct = NA
- )
+ ) %>%
+ as_supertbl()
+
supertbl$redcap_data <- list(tibble::tribble(
~redcap_repeat_instance,
@@ -172,7 +175,8 @@ test_that("make_labelled handles supertibble with extra columns", {
supertbl <- tibble::tribble(
~redcap_form_name, ~redcap_data, ~redcap_metadata, ~extra_field,
"form_1", tibble(x = letters[1:3]), tibble(field_name = "x", field_label = "X Label"), "extra"
- )
+ ) %>%
+ as_supertbl()
out <- make_labelled(supertbl)
@@ -193,7 +197,8 @@ test_that("make_labelled handles redcap_metadata tibbles of different sizes ", {
~redcap_form_name, ~redcap_data, ~redcap_metadata,
"form_1", tibble(x = letters[1:3]), tibble(field_name = "x", field_label = "X Label"),
"form_2", tibble(y = letters[1:3]), tibble(field_name = "y", field_label = "Y Label", some_extra_metadata = "123")
- )
+ ) %>%
+ as_supertbl()
out <- make_labelled(supertbl)
@@ -220,7 +225,8 @@ test_that("make_labelled handles supertibbles with NULL redcap_events", {
~redcap_data, ~redcap_metadata, ~redcap_events,
tibble(x = letters[1:3]), tibble(field_name = "x", field_label = "X Label"), tibble(redcap_event = "event_a"),
tibble(y = letters[1:3]), tibble(field_name = "y", field_label = "Y Label"), NULL
- )
+ ) %>%
+ as_supertbl()
out <- make_labelled(supertbl)
@@ -245,7 +251,8 @@ test_that("make_labelled accepts all valid input types to format_labels", {
supertbl <- tibble::tribble(
~redcap_data, ~redcap_metadata,
tibble(x = letters[1:3]), tibble(field_name = "x", field_label = "X Label")
- )
+ ) %>%
+ as_supertbl()
# NULL
out <- make_labelled(supertbl, format_labels = NULL)
@@ -286,3 +293,23 @@ test_that("make_labelled accepts all valid input types to format_labels", {
make_labelled(supertbl, format_labels = 1) %>%
expect_error(class = "unresolved_formatter")
})
+
+test_that("make_labelled errors with bad inputs", {
+ # Input to format_labels is tested above
+
+ expect_error(make_labelled(123), class = "check_supertbl")
+
+ missing_col_supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+ missing_list_col_supertbl <- tibble(redcap_data = list(), redcap_metadata = 123) %>%
+ as_supertbl()
+
+ expect_error(make_labelled(missing_col_supertbl), class = "missing_req_cols")
+ expect_error(make_labelled(missing_list_col_supertbl), class = "missing_req_list_cols")
+})
+
+test_that("make_labelled preserves S3 class", {
+ out <- make_labelled(superheroes_supertbl)
+
+ expect_s3_class(out, "redcap_supertbl")
+})
diff --git a/tests/testthat/test-read_redcap.R b/tests/testthat/test-read_redcap.R
index a3e71b5e..62275fde 100644
--- a/tests/testthat/test-read_redcap.R
+++ b/tests/testthat/test-read_redcap.R
@@ -387,3 +387,59 @@ test_that("read_redcap returns expected survey fields", {
checkmate::expect_class(survey_data$redcap_survey_timestamp, c("POSIXct", "POSIXt"))
})
+
+test_that("read_redcap errors with bad inputs", {
+ # Checking for type and length constraints where relevant
+
+ # redcap uri
+ expect_error(read_redcap(123, classic_token), class = "check_character")
+ expect_error(read_redcap(letters[1:3], classic_token), class = "check_character")
+
+ # token
+ expect_error(read_redcap(redcap_uri, 123), class = "check_character")
+ expect_error(read_redcap(redcap_uri, letters[1:3]), class = "check_character")
+ expect_error(
+ read_redcap(redcap_uri, "abc"),
+ regexp = "The token is not a valid 32-character hexademical value."
+ )
+
+ # raw_or_label
+ expect_error(
+ read_redcap(redcap_uri, classic_token, raw_or_label = "bad option"),
+ class = "check_choice"
+ )
+
+ # forms
+ expect_error(
+ read_redcap(redcap_uri, classic_token, forms = 123),
+ class = "check_character"
+ )
+
+ # export_survey_fields
+ expect_error(
+ read_redcap(redcap_uri, classic_token, export_survey_fields = 123),
+ class = "check_logical"
+ )
+ expect_error(
+ read_redcap(redcap_uri, classic_token, export_survey_fields = c(TRUE, TRUE)),
+ class = "check_logical"
+ )
+
+ # suppress_redcapr_messages
+ expect_error(
+ read_redcap(redcap_uri, classic_token, suppress_redcapr_messages = 123),
+ class = "check_logical"
+ )
+ expect_error(
+ read_redcap(redcap_uri, classic_token, suppress_redcapr_messages = c(TRUE, TRUE)),
+ class = "check_logical"
+ )
+})
+
+test_that("read_redcap returns S3 object", {
+ httptest::with_mock_api({
+ out <- read_redcap(redcap_uri, longitudinal_token)
+ })
+
+ expect_s3_class(out, "redcap_supertbl")
+})
diff --git a/utility/cli_message_examples.R b/utility/cli_message_examples.R
new file mode 100644
index 00000000..a84b1307
--- /dev/null
+++ b/utility/cli_message_examples.R
@@ -0,0 +1,75 @@
+devtools::load_all()
+
+options(rlang_backtrace_on_error_report = "none")
+
+# read_redcap
+
+classic_token <- "123456789ABCDEF123456789ABCDEF01"
+redcap_uri <- "www.google.com"
+
+## redcap_uri
+
+read_redcap(123, classic_token)
+
+read_redcap(letters[1:3], classic_token)
+
+## token
+
+read_redcap(redcap_uri, 123)
+
+read_redcap(redcap_uri, letters[1:3])
+
+## raw_or_label
+
+read_redcap(redcap_uri, classic_token, raw_or_label = "bad option")
+
+## forms
+
+read_redcap(redcap_uri, classic_token, forms = 123)
+
+## export_survey_fields
+
+read_redcap(redcap_uri, classic_token, export_survey_fields = 123)
+
+read_redcap(redcap_uri, classic_token, export_survey_fields = c(TRUE, TRUE))
+
+## suppress_redcapr_messages
+
+read_redcap(redcap_uri, classic_token, suppress_redcapr_messages = 123)
+
+read_redcap(redcap_uri, classic_token, suppress_redcapr_messages = c(TRUE, TRUE))
+
+# bind_tibbles
+
+bind_tibbles(123)
+
+supertbl <- tibble(redcap_data = list())
+bind_tibbles(supertbl, environment = "abc")
+
+bind_tibbles(supertbl, tbls = 123)
+
+# extract_tibbles
+
+extract_tibbles(letters[1:10])
+
+# extract_tibble
+
+extract_tibble(123, "my_tibble")
+
+supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+extract_tibble(supertbl, tbl = 123)
+
+extract_tibble(supertbl, tbl = letters[1:3])
+
+# make_labelled
+
+make_labelled(123)
+
+missing_col_supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+make_labelled(missing_col_supertbl)
+
+missing_list_col_supertbl <- tibble(redcap_data = list(), redcap_metadata = 123) %>%
+ as_supertbl()
+make_labelled(missing_list_col_supertbl)
diff --git a/utility/cli_message_examples_reprex.md b/utility/cli_message_examples_reprex.md
new file mode 100644
index 00000000..8466f00a
--- /dev/null
+++ b/utility/cli_message_examples_reprex.md
@@ -0,0 +1,167 @@
+``` r
+devtools::load_all()
+#> ℹ Loading REDCapTidieR
+
+options(rlang_backtrace_on_error_report = "none")
+
+# read_redcap
+
+classic_token <- "123456789ABCDEF123456789ABCDEF01"
+redcap_uri <- "www.google.com"
+
+## redcap_uri
+
+read_redcap(123, classic_token)
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `123` for `redcap_uri` which is not a valid value
+#> ! Must be of type 'character', not 'double'
+
+read_redcap(letters[1:3], classic_token)
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `a`, `b`, `c` for `redcap_uri` which is not a valid
+#> value
+#> ! Must have length 1, but has length 3
+
+## token
+
+read_redcap(redcap_uri, 123)
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `123` for `token` which is not a valid value
+#> ! Must be of type 'character', not 'double'
+
+read_redcap(redcap_uri, letters[1:3])
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `a`, `b`, `c` for `token` which is not a valid value
+#> ! Must have length 1, but has length 3
+
+## raw_or_label
+
+read_redcap(redcap_uri, classic_token, raw_or_label = "bad option")
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `bad option` for `raw_or_label` which is not a valid
+#> value
+#> ! Must be element of set {'label','raw'}, but is 'bad option'
+
+## forms
+
+read_redcap(redcap_uri, classic_token, forms = 123)
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `123` for `forms` which is not a valid value
+#> ! Must be of type 'character' (or 'NULL'), not 'double'
+
+## export_survey_fields
+
+read_redcap(redcap_uri, classic_token, export_survey_fields = 123)
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `123` for `export_survey_fields` which is not a valid
+#> value
+#> ! Must be of type 'logical', not 'double'
+
+read_redcap(redcap_uri, classic_token, export_survey_fields = c(TRUE, TRUE))
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `TRUE`, `TRUE` for `export_survey_fields` which is not
+#> a valid value
+#> ! Must have length 1, but has length 2
+
+## suppress_redcapr_messages
+
+read_redcap(redcap_uri, classic_token, suppress_redcapr_messages = 123)
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `123` for `suppress_redcapr_messages` which is not a
+#> valid value
+#> ! Must be of type 'logical', not 'double'
+
+read_redcap(redcap_uri, classic_token, suppress_redcapr_messages = c(TRUE, TRUE))
+#> Error in `read_redcap()`:
+#> ✖ You've supplied `TRUE`, `TRUE` for `suppress_redcapr_messages` which
+#> is not a valid value
+#> ! Must have length 1, but has length 2
+
+# bind_tibbles
+
+bind_tibbles(123)
+#> Error in `bind_tibbles()`:
+#> ✖ You've supplied `123` for `supertbl` which is not a valid value
+#> ! Must be of class
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+supertbl <- tibble(redcap_data = list())
+bind_tibbles(supertbl, environment = "abc")
+#> Error in `bind_tibbles()`:
+#> ✖ You've supplied `` for `supertbl` which is not a valid
+#> value
+#> ! Must be of class
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+bind_tibbles(supertbl, tbls = 123)
+#> Error in `bind_tibbles()`:
+#> ✖ You've supplied `` for `supertbl` which is not a valid
+#> value
+#> ! Must be of class
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+# extract_tibbles
+
+extract_tibbles(letters[1:10])
+#> Error in `extract_tibbles()`:
+#> ✖ You've supplied `a`, `b`, `c`, …, `i`, `j` for `supertbl` which is not
+#> a valid value
+#> ! Must be of class
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+# extract_tibble
+
+extract_tibble(123, "my_tibble")
+#> Error in `extract_tibble()`:
+#> ✖ You've supplied `123` for `supertbl` which is not a valid value
+#> ! Must be of class
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+extract_tibble(supertbl, tbl = 123)
+#> Error in `extract_tibble()`:
+#> ✖ You've supplied `123` for `tbl` which is not a valid value
+#> ! Must be of type 'character', not 'double'
+
+extract_tibble(supertbl, tbl = letters[1:3])
+#> Error in `extract_tibble()`:
+#> ✖ You've supplied `a`, `b`, `c` for `tbl` which is not a valid value
+#> ! Must have length 1, but has length 3
+
+# make_labelled
+
+make_labelled(123)
+#> Error in `make_labelled()`:
+#> ✖ You've supplied `123` for `supertbl` which is not a valid value
+#> ! Must be of class
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+missing_col_supertbl <- tibble(redcap_data = list()) %>%
+ as_supertbl()
+make_labelled(missing_col_supertbl)
+#> Error in `make_labelled()`:
+#> ✖ You've supplied `` for `supertbl` which is not a
+#> valid value
+#> ! Must contain `supertbl$redcap_metadata`
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+
+missing_list_col_supertbl <- tibble(redcap_data = list(), redcap_metadata = 123) %>%
+ as_supertbl()
+make_labelled(missing_list_col_supertbl)
+#> Error in `make_labelled()`:
+#> ✖ You've supplied `` for `supertbl` which is not a
+#> valid value
+#> ! `supertbl$redcap_metadata` must be of type 'list'
+#> ℹ `supertbl` must be a REDCapTidieR supertibble, generated using
+#> `read_redcap()`
+```
+
+Created on 2022-12-20 with [reprex v2.0.2](https://reprex.tidyverse.org)