add list_directories, list_mailing_lists, and mailing_list_contacts

DESCRIPTION

@@ -51,4 +51,4 @@ VignetteBuilder:
 Encoding: UTF-8
 LazyData: FALSE
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.1

NAMESPACE

@@ -14,7 +14,10 @@ export(generate_url)
 export(getSurvey)
 export(getSurveyQuestions)
 export(getSurveys)
+export(list_directories)
 export(list_distribution_links)
+export(list_mailing_lists)
+export(mailing_list_contacts)
 export(metadata)
 export(qualtRicsConfigFile)
 export(qualtrics_api_credentials)

R/checks.R

@@ -465,7 +465,7 @@ checkarg_include_embedded <-
 checkarg_col_types <-
   function(col_types){
     if(is.null(col_types)){return()}
-    if(class(col_types) != "col_spec"){
+    if(!inherits(col_types, "col_spec")){
       rlang::abort(
         c("Error in argument `col_types`",
           "Must be a `col_spec` object from `readr::cols()`")

R/list_directories.R

@@ -0,0 +1,40 @@
+#' Retrieve a data frame of all directories from Qualtrics
+#'
+#' @template retry-advice
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Register your Qualtrics credentials if you haven't already
+#' qualtrics_api_credentials(
+#'   api_key = "<YOUR-API-KEY>",
+#'   base_url = "<YOUR-BASE-URL>"
+#' )
+#'
+#' # Retrieve a list of all directories
+#' directories <- list_directories()
+#' }
+#'
+
+list_directories <- function(){
+
+  check_credentials()
+
+  # Function-specific API stuff
+  fetch_url <- generate_url(query = "listdirectories")
+
+  elements <- list()
+
+  while(!is.null(fetch_url)){
+
+    res <- qualtrics_api_request("GET", url = fetch_url)
+    elements <- append(elements, res$result$elements)
+    fetch_url <- res$result$nextPage
+
+  }
+
+  x <- purrr::map_df(elements, purrr::flatten)
+
+  return(x)
+
+}

R/list_mailing_lists.R

@@ -0,0 +1,51 @@
+
+#' Retrieve a data frame of all mailing lists for a directory from Qualtrics
+#'
+#' @param directoryID String. Unique directory ID.
+#'
+#' @template retry-advice
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Register your Qualtrics credentials if you haven't already
+#' qualtrics_api_credentials(
+#'   api_key = "<YOUR-API-KEY>",
+#'   base_url = "<YOUR-BASE-URL>"
+#' )
+#'
+#' directories <- list_directories()
+#' mailing_lists <- list_mailing_lists(directories$directoryId[1])
+#'}
+#'
+
+list_mailing_lists <- function(directoryID){
+
+  # qualtrics list mailing lists parameters can be found at
+  # https://api.qualtrics.com/dd83f1535056c-list-mailing-lists
+
+  check_credentials()
+  checkarg_isstring(directoryID)
+
+  fetch_url <- generate_url(query = "listmailinglists",
+                            directoryID = directoryID)
+
+  elements <- list()
+
+  while(!is.null(fetch_url)){
+
+    res <- qualtrics_api_request("GET", url = fetch_url, query = list(includeCount = "true"))
+    elements <- append(elements, res$result$elements)
+    fetch_url <- res$result$nextPage
+
+  }
+
+  x <- tibble::tibble(mailingListId = purrr::map_chr(elements, "mailingListId", .default = NA_character_),
+                      name = purrr::map_chr(elements, "name", .default = NA_character_),
+                      ownerId = purrr::map_chr(elements, "ownerId", .default = NA_character_),
+                      lastModifiedDate = lubridate::as_datetime(purrr::map_dbl(elements, "lastModifiedDate", .default = NA_character_)/1000),
+                      creationDate = lubridate::as_datetime(purrr::map_dbl(elements, "creationDate", .default = NA_character_)/1000),
+                      contactCount = purrr::map_dbl(elements, "contactCount", .default = NA_character_))
+  return(x)
+
+}

R/mailing_list_contacts.R

@@ -0,0 +1,62 @@
+
+#' Retrieve a data frame of all contacts for a mailing list from Qualtrics
+#'
+#' @param directoryID String. Unique directory ID.
+#' @param mailinglistID String. Unique ID of mailing list you want contacts from.
+#'
+#' @template retry-advice
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Register your Qualtrics credentials if you haven't already
+#' qualtrics_api_credentials(
+#'   api_key = "<YOUR-API-KEY>",
+#'   base_url = "<YOUR-BASE-URL>"
+#' )
+#'
+#' directories <- list_directories()
+#' mailing_lists <- list_mailing_lists(directories$directoryId[1])
+#' contacts <- mailing_list_contacts(directories$directoryId[1], mailing_lists$mailingListId[1])
+#'}
+#'
+
+mailing_list_contacts <- function(directoryID, mailinglistID){
+
+  # qualtrics mailing lists contacts parameters can be found at
+  # https://api.qualtrics.com/af95194dd116e-list-contacts-in-mailing-list
+
+  check_credentials()
+  checkarg_isstring(directoryID)
+  checkarg_isstring(mailinglistID)
+
+  fetch_url <- generate_url(query = "mailinglistcontacts",
+                            directoryID = directoryID,
+                            mailinglistID = mailinglistID)
+
+  elements <- list()
+
+  while(!is.null(fetch_url)){
+
+    res <- qualtrics_api_request("GET", url = fetch_url, query = list(includeEmbedded = "true"))
+    elements <- append(elements, res$result$elements)
+    fetch_url <- res$result$nextPage
+
+  }
+
+  x <- tibble::tibble(contactId = purrr::map_chr(elements, "contactId", .default = NA_character_),
+                      firstName = purrr::map_chr(elements, "firstName", .default = NA_character_),
+                      lastName = purrr::map_chr(elements, "lastName", .default = NA_character_),
+                      email = purrr::map_chr(elements, "email", .default = NA_character_),
+                      phone = purrr::map_chr(elements, "phone", .default = NA_character_),
+                      extRef = purrr::map_chr(elements, "extRef", .default = NA_character_),
+                      language = purrr::map_chr(elements, "language", .default = NA_character_),
+                      unsubscribed = purrr::map_lgl(elements, "unsubscribed", .default = NA_character_))
+
+  y = purrr::map_df(elements, "embeddedData", .default = NA_character_)
+
+  x <- cbind(x, y)
+
+  return(x)
+
+}

R/utils.R

@@ -153,6 +153,9 @@ generate_url <-
         fetchdistributions = "{rooturl}/distributions?surveyId={surveyID}",
         fetchdistributionhistory = "{rooturl}/distributions/{distributionID}/history",
         listdistributionlinks = "{rooturl}/distributions/{distributionID}/links?surveyId={surveyID}",
+        listdirectories = "{rooturl}/directories",
+        listmailinglists = "{rooturl}/directories/{directoryID}/mailinglists",
+        mailinglistcontacts = "{rooturl}/directories/{directoryID}/mailinglists/{mailinglistID}/contacts",
         rlang::abort("Internal error: invalid URL generation query")
       )
 
@@ -217,6 +220,7 @@ create_raw_payload <-
 qualtrics_api_request <-
   function(verb = c("GET", "POST"),
            url = url,
+           query = NULL,
            body = NULL,
            as = c("parsed", "raw"),
            ...
@@ -233,6 +237,7 @@ qualtrics_api_request <-
       verb,
       url = url,
       httr::add_headers(headers),
+      query = query,
       body = body,
       times = 4,
       terminate_on = 400:451,