new version 2023.12.1 with two bug fixes and a new wrapper function

R/easy_redcap.R

@@ -0,0 +1,59 @@
+
+#' Retrieve project API key if stored, if not, set and retrieve
+#'
+#' @param key.name character vector of key name
+#'
+#' @return character vector
+#' @importFrom keyring key_list key_get key_set
+#' @export
+get_api_key <- function(key.name) {
+  if (key.name %in% keyring::key_list()$service) {
+    keyring::key_get(service = key.name)
+  } else {
+    keyring::key_set(service = key.name, prompt = "Write REDCap API key:")
+    keyring::key_get(service = key.name)
+  }
+}
+
+
+#' Secure API key storage and data acquisition in one
+#'
+#' @param project.name The name of the current project (for key storage with
+#' `keyring::key_set()`)
+#' @param widen.data argument to widen the exported data
+#' @param ... arguments passed on to `REDCapCAST::read_redcap_tables()`
+#'
+#' @return data.frame or list depending on widen.data
+#' @importFrom purrr reduce
+#' @importFrom dplyr left_join
+#' @export
+easy_redcap <- function(project.name, widen.data = TRUE, ...) {
+  project.name <- "ENIGMA"
+
+  key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API"))
+
+  out <- read_redcap_tables(
+    token = key,
+    ...
+  )
+
+  all_names <- out |>
+    lapply(names) |>
+    Reduce(c, x = _) |>
+    unique()
+
+  if (widen.data) {
+    if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
+      all_names)) {
+      if (length(out) == 1) {
+        out <- out[[1]]
+      } else {
+        out <- out |> purrr::reduce(dplyr::left_join)
+      }
+    } else {
+      out <- out |> redcap_wider()
+    }
+  }
+
+  out
+}

R/read_redcap_tables.R

@@ -55,7 +55,7 @@ read_redcap_tables <- function(uri,
     if (!is.null(events)){
     event_test <- events %in% unique(arm_event_inst$data$unique_event_name)
 
-    if (any(!forms_test)){
+    if (any(!event_test)){
       stop("Not all supplied event names are valid")
     }
     }

R/utils.r

@@ -144,6 +144,8 @@ sanitize_split <- function(l,
 #'
 match_fields_to_form <- function(metadata, vars_in_data) {
 
+  metadata <- data.frame(metadata)
+
   field_form_name <- grepl(".*([Ff]ield|[Ff]orm)[._][Nn]ame$",names(metadata))
   field_type <- grepl(".*[Ff]ield[._][Tt]ype$",names(metadata))