traitbank - switch to using cypher query setup, update man files, fix #…

…112

DESCRIPTION

@@ -5,7 +5,7 @@ Description: Species trait data from many different sources, including
     from the USDA plants database, data from 'EOL' 'Traitbank', 
     Coral traits data (<https://coraltraits.org>), 'Birdlife' International, 
     and more.
-Version: 0.3.0.9310
+Version: 0.3.3.9310
 Authors@R: c(
     person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus@gmail.com"),
     person("Zachary", "Foster", role = "aut"),
@@ -25,7 +25,7 @@ Depends:
 Imports:
     jsonlite (>= 0.9.19),
     httr (>= 1.1.0),
-    crul (>= 0.3.8),
+    crul (>= 0.6.0),
     tibble (>= 1.3.4),
     data.table (>= 1.9.6),
     readr (>= 1.1.1),
@@ -39,4 +39,4 @@ Suggests:
     testthat,
     dplyr,
     plyr
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.1

R/traitbank.R

@@ -1,54 +1,48 @@
-#' Search for traits from EOL's Traitbank.
+#' Search for traits from EOL's Traitbank
 #'
 #' @export
-#'
-#' @param pageid A page id. I know, not ideal. Would be better if this was a trait
-#' id or trait name. This is the page ID for a taxon, not a trait. Apparently, traits
-#' don't have pages. Note: this parameter used to be \code{trait}, but badly
-#' mis-represented what the input actually represents.
-#' @param cache_ttl Cache code
-#' @param ... Curl options passed on to \code{\link[httr]{GET}}
-#' @references http://eol.org/info/516
-#' @author Scott Chamberlain \email{myrmecocystus@@gmail.com}
-#' @details See http://eol.org/data_glossary for human readable definitions for
-#' the attribute terms that EOL uses. Go to http://eol.org/data_search for the
-#' web interface to Traitbank.
+#' @param query (character) a query to the EOL Cypher service that holds
+#' Traitbank data. required. no default query given. see examples
+#' @param key (character) EOL Cypher query API key. required, either
+#' passed in or as an environment variable
+#' @param ... Curl options passed on to \code{\link[crul]{verb-GET}}
+#' @references https://github.com/EOL/eol_website/blob/master/doc/api.md
+#' https://github.com/EOL/eol_website/blob/master/doc/query-examples.md
+#' @details \code{traitbank} is an interface to the EOL Cypher query.
+#' Note that the previous interface EOL had for Traits has been completely
+#' replaced - thus, this function is completely different. You no longer
+#' query by EOL page id, but using the query language for a database
+#' called Neo4J. See the docs for help. Later we plan to make a more
+#' user friendly interface to get Traitbank data that doesn't
+#' require knowing the Neo4J query syntax
+#' @section Authentication:
+#' You'll need an EOL cypher key to use this function. Get one by signing
+#' in to your EOL account https://eol.org/users/sign_in then head to
+#' https://eol.org/services/authenticate to get a key. Store your key
+#' in your .Renviron file or similar under the name "EOL_CYPHER_KEY",
+#' and we will use that key in this function. Alternatively, you can
+#' pass in your key to the key parameter, but we do not recommend
+#' doing that as you risk accidentally committing your key to the
+#' public web.
+#' @return a list
 #' @examples \dontrun{
-#' # Get data for Balaenoptera musculus (http://eol.org/pages/328574/)
-#' res <- traitbank(328574)
-#' res$context
-#' names( res$graph )
-#' head( res$graph )
+#' # traitbank_query function
+#' traitbank(query = "MATCH (n:Trait) RETURN n LIMIT 1;")
 #'
-#' # Get data for Closterocerus formosus (http://eol.org/pages/846827/)
-#' traitbank(846827)
-#' }
-traitbank <- function(pageid, cache_ttl = NULL, ...) {
-  args <- traitsc(list(cache_ttl = cache_ttl))
-  if (length(args) == 0) args <- NULL
-  res <- traitbank_GET(paste0(tburl(), pageid), args, ...)
-  if (all(c("item", "@context") %in% names(res)) && "traits" %in% names(res$item)) {
-    df <- res$item$traits
-    df <- stats::setNames(df, tolower(names(df)))
-    ct <- res$`@context`
-  } else {
-    temp <- lapply(res, names)
-    temp <- paste(shQuote(paste(rep(names(temp), times = lengths(temp)), unlist(temp),
-      sep = ":")), collapse = ", ")
-    message("API of eol's traitbank appears to have changed. Object structure\n",
-      "\t* expected (among other elements): 'item$traits' and '@context'",
-      "\t* received:", temp)
-    df <- ct <- NULL
-  }
-  structure(list(context = ct, graph = tibble::as_tibble(df)),
-            class = "traitbank")
-}
-
-traitbank_GET <- function(url, args = list(), ...){
-  res <- GET(url, query = args, ...)
-  stop_for_status(res)
-  txt <- content(res, "text", encoding = "UTF-8")
-  jsonlite::fromJSON(txt, TRUE, flatten = TRUE)
+#' # traitbank function
+#' res <- traitbank(query = "MATCH (n:Trait) RETURN n LIMIT 2;")
+#' res
+traitbank <- function(query, key = NULL, ...) {
+  assert(query, "character")
+  assert(key, "character")
+  if (is.null(key)) key <- Sys.getenv("EOL_CYPHER_KEY", "")
+  if (!nzchar(key)) stop("no EOL Cypher key found; see help file")
+  x = crul::HttpClient$new(
+      url = "https://eol.org",
+      headers = list(Authorization = paste0("JWT ", key)),
+      opts = list(...)
+  )
+  res <- x$get("service/cypher", query = list(query = query))
+  res$raise_for_status()
+  jsonlite::fromJSON(res$parse("UTF-8"), TRUE)
 }
-
-tburl <- function() 'http://eol.org/api/traits/'

R/zzz.R

@@ -72,3 +72,18 @@ dtread <- function(x) {
     data.table::fread(x, stringsAsFactors = FALSE, data.table = FALSE)
   )
 }
+
+asdt <- function(x) {
+  tibble::as_tibble(
+    data.table::rbindlist(x, fill = TRUE, use.names = TRUE)
+  )
+}
+
+assert <- function (x, y) {
+  if (!is.null(x)) {
+    if (!inherits(x, y)) {
+      stop(deparse(substitute(x)), " must be of class ",
+          paste0(y, collapse = ", "), call. = FALSE)
+    }
+  }
+}

tests/testthat/helper-traits.R

@@ -6,11 +6,11 @@ check_betydb <- function(url){
 }
 
 ## only run if eol.org is up
-check_traitbank <- function(url){
-  if (httr::status_code(httr::GET("http://eol.org/api")) != 200) {
-    skip("eol's traitbank is offline.")
-  }
-}
+# check_traitbank <- function(url){
+#   if (httr::status_code(httr::GET("http://eol.org/api")) != 200) {
+#     skip("eol's traitbank is offline.")
+#   }
+# }
 
 #' Clean up any option changes to exactly match a previous state,
 #' *unsetting* any options not present in the old list. 
@@ -27,4 +27,4 @@ reset_opts <- function(old_opts){
 	removed_vals <- options(nulls)
 
 	invisible(c(reset_vals, removed_vals))
-}
+}