add gna_data_sources() and make gnr_datasources( defunct

relates to #942

NAMESPACE

@@ -242,6 +242,7 @@ export(get_wormsid)
 export(get_wormsid_)
 export(getkey)
 export(gisd_isinvasive)
+export(gna_data_sources)
 export(gna_parse)
 export(gna_search)
 export(gna_verifier)

R/dna_data_sources.R

@@ -0,0 +1,68 @@
+#' Get metadata about GNA data sources
+#'
+#' Downloads metadata about Global Names Architecture (GNA) data sources
+#' available to be used in other GNA functions.
+#'
+#' @param output_type What format of output to return. Either `'json'`,
+#'   `'list'`, or `'table'`.
+#' @param ... Passed to [crul::HttpClient].
+#'
+#' @author Zachary S.L. Foster
+#'
+#' @examples \dontrun{
+#' 
+#' gna_data_sources()
+#' }
+#' 
+#' @export
+gna_data_sources <- function(output_type = 'table', ...) {
+  gna_data_sources_url <- 'https://verifier.globalnames.org/api/v1/data_sources'
+
+  # Check arguments
+  possible_output_types <- c('json', 'table', 'list')
+  if (! output_type %in% possible_output_types) {
+    stop(call. = FALSE, 'The `output_type` value must be one of: ', paste0(possible_output_types, collapse = ', '))
+  }
+
+  # Make and parse API call
+  api <- crul::HttpClient$new(gna_data_sources_url, headers = tx_ual, opts = list(...))
+  response <- api$get()
+  response$raise_for_status()
+  response_json <- response$parse("UTF-8")
+  if (output_type == 'json') {
+    return(response_json)
+  }
+  response_data <- jsonlite::fromJSON(response_json, FALSE)
+
+  # Reformat response data to a list
+  if (output_type == 'list') {
+    return(response_data)
+  }
+
+  # Reformat response data to a table
+  if (output_type == 'table') {
+    used_cols <- c(
+      'id',
+      'titleShort',
+      'title',
+      'description',
+      'curation',
+      'hasTaxonData',
+      'recordCount',
+      'updatedAt',
+      'homeURL',
+      'uuid',
+      'version',
+      'isOutlinkReady',
+      'doi'
+    )
+    response_table <- do.call(rbind, lapply(response_data, function(x) {
+      out <- x[used_cols]
+      names(out) <- used_cols
+      out[unlist(lapply(out, is.null))]  <- NA
+      as.data.frame(out)
+    }))
+    response_table <- tibble::as_tibble(response_table)
+  }
+  return(response_table)
+}

R/gnr_datasources.R

@@ -22,6 +22,9 @@
 #' out[agrep("zoo", out$title, ignore.case = TRUE), ]
 #' }
 gnr_datasources <- function(..., todf) {
+
+  lifecycle::deprecate_warn(when = "v0.9.102", what = "gnr_datasources()", with = "gna_data_sources()")
+
   if (!missing(todf)) stop("todf is defunct", call. = FALSE)
   cli <- crul::HttpClient$new(
     url = "https://resolver.globalnames.org/data_sources.json",

tests/testthat/test-gna_data_sources.R

@@ -0,0 +1,11 @@
+context("gna_data_sources")
+
+test_that("gna_data_sources returns a table", {
+  skip_on_cran()
+  vcr::use_cassette("gna_data_sources", {
+    tmp <- gna_data_sources()
+  })
+  expect_is(tmp, "data.frame")
+  expect_equal(NCOL(tmp), 13)
+})
+