merge json branch

R/http.R

@@ -14,6 +14,7 @@ api_user_token <- function() {
 
 api_project_token <- function() {
   if (!exists("TW_PROJECT_TOKEN", envir = globalenv())) {
+    cat("\033[38;2;255;255;0mNo TW_PROJECT_TOKEN variable is set\033[0m\n")
     return()
   }
   get("TW_PROJECT_TOKEN", envir = globalenv())
@@ -23,7 +24,7 @@ add_token_params <- function(query) {
   query <- c(query, list(
                          token = api_user_token(),
                          project_token = api_project_token()))
-  return(query)
+  return(cc(query))
 }
 
 serialize <- function(params) {
@@ -37,7 +38,7 @@ serialize <- function(params) {
     } else {
       url_params <- c(url_params,
                       paste0(
-                             name, "=", 
+                             name, "=",
                              URLencode(as.character(params[[name]]))))
     }
   }
@@ -75,17 +76,22 @@ tw_GET <- function(
     path <- paste0(path, ".csv")
   }
 
-  # if token and project_token are null then add them to the query
+  # if tokens are null then add tokens from global environment
   if (is.null(query$token) && is.null(query$project_token)) {
     query <- add_token_params(query)
   }
+
+
   url_params_string <- serialize(query)
   url <- paste0(api_base_url(), path, url_params_string)
 
   cat(sprintf("\033[32mGET %s\033[39m\n", url))
 
   if (csv) {
-    return(as_tibble(read.csv(url)))
+    return(as_tibble(read.csv(url, sep = "\t",
+                              header = TRUE,
+                              stringsAsFactors = FALSE,
+                              na.strings = c("", "NA"))))
   } else {
     req <- request(url)
     resp <- req_perform(req)

R/tw_biological_associations.R

@@ -76,7 +76,7 @@ tw_biological_associations <- function(subresource = NULL, biological_associatio
   match_identifiers_delimiter = NULL, match_identifiers_type = NULL, 
   namespace_id = NULL, note_exact = NULL, note_text = NULL, notes = NULL, 
   keyword_id_and = NULL, keyword_id_or = NULL, tags = NULL, 
-  token = NULL, project_token = NULL, csv = TRUE, page = 0, per = 50, ...) {
+  token = NULL, project_token = NULL, csv = FALSE, page = 0, per = 50, ...) {
 
   assert(page, c("numeric", "integer"))
   assert(per, c("numeric", "integer"))

R/tw_collection_objects.R

@@ -102,7 +102,7 @@ tw_collection_objects <- function(biocuration_class_id = NULL, biological_associ
   taxon_determinations = NULL, taxon_name_id = NULL, type_material = NULL, type_specimen_taxon_name_id = NULL, 
   user_date_end = NULL, user_date_start = NULL, user_id = NULL, user_target = NULL, validity = NULL, 
   with_buffered_collecting_event = NULL, with_buffered_determinations = NULL, with_buffered_other_labels = NULL, 
-  wkt = NULL, token = NULL, project_token = NULL, page = 0, per = 50, ...) {
+  wkt = NULL, csv = FALSE, token = NULL, project_token = NULL, page = 0, per = 50, ...) {
 
   assert(page, c("numeric", "integer"))
   assert(per, c("numeric", "integer"))
@@ -136,8 +136,8 @@ tw_collection_objects <- function(biocuration_class_id = NULL, biological_associ
     with_buffered_other_labels = with_buffered_other_labels, wkt = wkt, token = token, project_token = project_token,
     page = page, per = per))
 
-  res <- tw_GET(api_base_url(), "/collection_objects", query = args, ...)
-  return(res)
+  df <- tw_GET(api_base_url(), "/collection_objects", query = args, csv = csv, ...)
+  return(df)
 }
 
 

R/tw_otus.R

@@ -37,7 +37,7 @@ tw_otus <- function(asserted_distribution_ids = NULL, biological_association_ids
   keyword_id_or = NULL, name = NULL, note_exact = NULL, note_text = NULL, notes = NULL,
   origin_citations = NULL, otu_id = NULL, tags = NULL,
   taxon_name_classification_id = NULL, taxon_name_id = NULL, 
-  taxon_name_relationship_id = NULL, token = NULL, project_token = NULL, 
+  taxon_name_relationship_id = NULL, csv = FALSE, token = NULL, project_token = NULL, 
   page = 0, per = 50, ...) {
 
   assert(page, c("numeric", "integer"))
@@ -55,7 +55,7 @@ tw_otus <- function(asserted_distribution_ids = NULL, biological_association_ids
     taxon_name_id = taxon_name_id, taxon_name_relationship_id = taxon_name_relationship_id, 
     token = token, project_token = project_token, page = page, per = per))
 
-  res <- tw_GET(api_base_url(), "/otus", query = args, ...)
+  res <- tw_GET(api_base_url(), "/otus", query = args, csv = csv, ...)
   return(res)
 }
 

R/tw_projects.R

@@ -7,6 +7,6 @@
 #' tw_projects()
 #' }
 tw_projects <- function() {
-  res <- tw_GET(api_base_url())
-  return(res)
+  res <- tw_GET(api_base_url(), csv = FALSE)
+  return(res$open_projects)
 }

R/tw_taxon_name_classifications.R

@@ -14,7 +14,7 @@
 #' }
 tw_taxon_name_classifications <- function(taxon_name_id = NULL,
   taxon_name_classification_type = NULL, taxon_name_classification_set = NULL,
-  token = NULL, project_token = NULL, page = 0, per = 50, ...) {
+  csv = FALSE, token = NULL, project_token = NULL, page = 0, per = 50, ...) {
 
   assert(page, c("numeric", "integer"))
   assert(per, c("numeric", "integer"))
@@ -24,10 +24,11 @@ tw_taxon_name_classifications <- function(taxon_name_id = NULL,
     taxon_name_classification_set = taxon_name_classification_set,
     token = token, project_token = project_token, page = page, per = per))
 
-  res <- tw_GET(api_base_url(), "/taxon_name_classifications", body = args, ...)
-  return(res)
+  res <- tw_GET(api_base_url(), "/taxon_name_classifications", query = args, csv = csv, ...)
+  df <- as_tibble(res)
+  return(df)
 }
-
+# TODO: tnc needs a csv endpoint?
 
 #' Taxon Name Classifications
 #'

R/tw_taxon_name_relationships.R

@@ -17,7 +17,7 @@
 tw_taxon_name_relationships <- function(object_taxon_name_id = NULL, 
   subject_taxon_name_id = NULL, taxon_name_id = NULL,
   taxon_name_relationship_set = NULL, taxon_name_relationship_type = NULL,
-  token = NULL, project_token = NULL, page = 0, per = 50, ...) {
+  csv = FALSE, token = NULL, project_token = NULL, page = 0, per = 50, ...) {
 
   assert(page, c("numeric", "integer"))
   assert(per, c("numeric", "integer"))
@@ -28,10 +28,10 @@ tw_taxon_name_relationships <- function(object_taxon_name_id = NULL,
     taxon_name_relationship_type = taxon_name_relationship_type,
     token = token, project_token = project_token, page = page, per = per))
 
-  res <- tw_GET(api_base_url(), "/taxon_name_relationships", body = args, ...)
-  return(res)
-}
-
+  res <- tw_GET(api_base_url(), "/taxon_name_relationships", query = args, csv = csv, ...)
+  df <- as_tibble(res)
+  return(df)
+}  # TODO: tnr needs a csv endpoint?
 
 #' Taxon Name Relationships
 #'

R/tw_taxon_names.R

@@ -68,7 +68,7 @@ tw_taxon_names <- function(ancestors = NULL, author = NULL,
   tags = NULL, taxon_name_author_id_or = NULL, taxon_name_id = NULL,
   taxon_name_relationship = NULL, taxon_name_relationship_type = NULL,
   taxon_name_type = NULL, type_metadata = NULL, validity = NULL, year = NULL,
-  year_end = NULL, year_start = NULL, token = NULL, project_token = NULL, 
+  year_end = NULL, year_start = NULL, csv = FALSE, token = NULL, project_token = NULL, 
   page = 0, per = 50, ...) {
 
   assert(page, c("numeric", "integer"))
@@ -98,8 +98,9 @@ tw_taxon_names <- function(ancestors = NULL, author = NULL,
     year = year, year_end = year_end, year_start = year_start, 
     token = token, project_token = project_token, page = page, per = per))
 
-  res <- tw_GET(api_base_url(), "/taxon_names", query = args, ...)
-  return(res)
+  res <- tw_GET(api_base_url(), "/taxon_names", query = args, csv = csv, ...)
+  df <- as_tibble(res)
+  return(df)
 }
 
 

R/zzz.R

@@ -67,7 +67,7 @@ tol <- function(x) if (is.character(x)) tolower(x) else x
 #' @keywords internal
 #' @return boolean. `TRUE` if http request succeeds, `FALSE` if not
 tw_up <- function() {
-  z <- tryCatch(tw_GET(api_base_url(), "/ping")$pong,
+  z <- tryCatch(tw_GET(api_base_url(), "/ping", csv=FALSE),
      error = function(e) e)
-  if (inherits(z, "error")) FALSE else z
+  if (inherits(z, "error")) FALSE else TRUE
 }

check/rtaxonworks.Rcheck/00_pkg_src/rtaxonworks/DESCRIPTION

@@ -26,7 +26,7 @@ X-schema.org-keywords: biology, science, API, web, api-client,
         taxonomy, species
 X-schema.org-isPartOf: https://ropensci.org
 NeedsCompilation: no
-Packaged: 2024-02-14 23:30:23 UTC; gdo
+Packaged: 2024-02-15 20:03:57 UTC; gdo
 Author: Geoff Ower [aut, cre] (<https://orcid.org/0000-0002-9770-2345>),
   Species File Group [fnd] (https://speciesfilegroup.org/)
 Maintainer: Geoff Ower <gdower@illinois.edu>

check/rtaxonworks.Rcheck/00_pkg_src/rtaxonworks/NAMESPACE

@@ -2,6 +2,8 @@
 
 export(tw_ba)
 export(tw_biological_associations)
+export(tw_co)
+export(tw_collection_objects)
 export(tw_otu)
 export(tw_otus)
 export(tw_projects)

check/rtaxonworks.Rcheck/00_pkg_src/rtaxonworks/R/http.R

@@ -1,6 +1,6 @@
 api_base_url <- function() {
   if (!exists("TW_API_URL", envir = globalenv())) {
-    assign("TW_API_URL", "https://sfg.taxonworks.org/api/v1", envir = globalenv())
+    return("https://sfg.taxonworks.org/api/v1")
   }
   get("TW_API_URL", envir = globalenv())
 }
@@ -61,7 +61,11 @@ tw_ual <- list(`User-Agent` = tw_ua(ongha), `X-USER-AGENT` = tw_ua(ongha))
 #' @return a list of JSON results
 tw_GET <- function(url, path = NULL, query = list(), headers = list(), ...) {
 
-  query <- add_token_params(query)
+  browser()
+  # if token and project_token are null then add them to the query
+  if (is.null(query$token) && is.null(query$project_token)) {
+    query <- add_token_params(query)
+  }
   url_params_string <- serialize(query)
   url <- paste0(api_base_url(), path, url_params_string)