moved to using markdown docs fix #176

replaced all possible uses of httr to use crul instead (some deps still use httr) fix #174
fixed all as.* fxns to pass on curl options to the unerlying http client fix #177
tidied most lined to 80 line width

Author: sckott

DESCRIPTION

@@ -8,17 +8,19 @@ Description: A programmatic interface to many species occurrence data sources,
     System ('OBIS'), and Atlas of Living Australia ('ALA'). Includes
     functionality for retrieving species occurrence data, and combining
     those data.
-Version: 0.6.2.9140
+Version: 0.6.6.9100
 License: MIT + file LICENSE
 Authors@R: c(
-    person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus@gmail.com"),
+    person("Scott", "Chamberlain", role = c("aut", "cre"),
+      email = "myrmecocystus@gmail.com"),
     person("Karthik", "Ram", role = "ctb"),
     person("Ted", "Hart", role = "ctb")
     )
 URL: https://github.com/ropensci/spocc
 BugReports: https://github.com/ropensci/spocc/issues
 LazyData: true
 VignetteBuilder: knitr
+Roxygen: list(markdown = TRUE)
 Imports:
     utils,
     rgbif (>= 0.9.5),
@@ -27,7 +29,7 @@ Imports:
     rvertnet (>= 0.5.0),
     ridigbio (>= 0.3.3),
     lubridate (>= 1.5.0),
-    httr (>= 1.1.0),
+    crul (>= 0.3.4),
     whisker (>= 0.3-2),
     jsonlite (>= 1.1),
     data.table (>= 1.9.6),

LICENSE

@@ -1,2 +1,2 @@
-YEAR: 2016
+YEAR: 2017
 COPYRIGHT HOLDER: Scott Chamberlain

NAMESPACE

@@ -89,10 +89,6 @@ export(wkt2bbox)
 export(wkt_vis)
 importFrom(data.table,rbindlist)
 importFrom(data.table,setDF)
-importFrom(httr,GET)
-importFrom(httr,content)
-importFrom(httr,stop_for_status)
-importFrom(httr,warn_for_status)
 importFrom(jsonlite,toJSON)
 importFrom(lubridate,as_date)
 importFrom(lubridate,now)

R/ala_helpers.R

@@ -1,4 +1,4 @@
-ala_base <- function() "http://biocache.ala.org.au/ws/occurrences"
+ala_base <- function() "http://biocache.ala.org.au"
 
 ala_search <- function(taxon = NULL, limit = 500, offset = 0, fq = NULL,
   facet = "off", facets = NULL, sort = NULL, dir = NULL, flimit = NULL, 
@@ -12,22 +12,29 @@ ala_search <- function(taxon = NULL, limit = 500, offset = 0, fq = NULL,
     foffset = foffset, fprefix = fprefix, lat = lat, lon = lon,
     radius = radius, wkt = geometry
   ))
-  res <- httr::GET(file.path(ala_base(), "search"), query = args, ...)
-  httr::stop_for_status(res)
-  jsonlite::fromJSON(httr::content(res, "text", encoding = "UTF-8"), flatten = TRUE)
+  cli <- crul::HttpClient$new(
+    url = ala_base(),
+    opts = list(...)
+  )
+  out <- cli$get(path = "ws/occurrences/search", query = args)
+  out$raise_for_status()
+  jsonlite::fromJSON(out$parse("UTF-8"), flatten = TRUE)
 }
 
 ala_occ_id <- function(id, ...) {
   if (length(id) > 1) {
-    lapply(file.path(ala_base(), id), ala_GET, ...)
+    lapply(id, ala_GET, ...)
   } else {
-    ala_GET(file.path(ala_base(), id), ...)
+    ala_GET(id, ...)
   }
 }
 
-ala_GET <- function(url, args = list(), ...) {
-  res <- httr::GET(url, args, ...)
-  httr::stop_for_status(res)
-  jsonlite::fromJSON(httr::content(res, "text", encoding = "UTF-8"), 
-                     flatten = TRUE)  
+ala_GET <- function(id, args = list(), ...) {
+  cli <- crul::HttpClient$new(
+    url = ala_base(),
+    opts = list(...)
+  )
+  out <- cli$get(path = file.path("ws/occurrence", id), query = args)
+  out$raise_for_status()
+  jsonlite::fromJSON(out$parse("UTF-8"), flatten = TRUE)
 }

R/antweb_helpers.R

@@ -4,40 +4,57 @@ aw_data2 <- function(genus = NULL, species = NULL, scientific_name = NULL,
   limit = NULL, offset = NULL, quiet = FALSE, callopts = list()) {
 
   # Check for minimum arguments to run a query
-  main_args <- sc(as.list(c(scientific_name, genus, country, type, habitat, bbox)))
+  main_args <- sc(as.list(c(scientific_name, genus, country, type, 
+                            habitat, bbox)))
   date_args <- sc(as.list(c(min_date, max_date)))
   elev_args <- sc(as.list(c(min_elevation, max_elevation)))
   arg_lengths <- c(length(main_args), length(date_args), length(elev_args))
 
   stopifnot(any(arg_lengths) > 0)
   decimal_latitude <- decimal_longitude <- NA
-  if(!is.null(scientific_name)) {
+  if (!is.null(scientific_name)) {
     genus <- strsplit(scientific_name, " ")[[1]][1]
     species <- strsplit(scientific_name, " ")[[1]][2]
   }
 
-  base_url <- "http://www.antweb.org/api/v2/"
+  base_url <- "http://www.antweb.org"
   original_limit <- limit
   args <- sc(as.list(c(genus = genus, species = species, bbox = bbox, 
-                       min_elevation = min_elevation, max_elevation = max_elevation, 
+                       min_elevation = min_elevation, 
+                       max_elevation = max_elevation, 
                        habitat = habitat, country = country, type = type, 
                        min_date = min_date, max_date = max_date, limit = 1, 
                        offset = offset, georeferenced = georeferenced)))
-  results <- GET(base_url, query = args, callopts)
-  warn_for_status(results)
-  data <- jsonlite::fromJSON(content(results, "text", encoding = "UTF-8"), FALSE)
+  cli <- crul::HttpClient$new(url = base_url, opts = callopts)
+  out <- cli$get(path = "api/v2", query = args)
+  out$raise_for_status()
+  data <- jsonlite::fromJSON(out$parse("UTF-8"), FALSE)
   data <- sc(data) # Remove NULL
 
-  if(data$count > 1000 & is.null(limit)) {
+  if (data$count > 1000 && is.null(limit)) {
     args$limit <- 1000
-    results <- GET(base_url, query = args)
-    if(!quiet) message(sprintf("Query contains %s results. First 1000 retrieved. Use the offset argument to retrieve more \n", data$count))
+    cli <- crul::HttpClient$new(url = base_url, opts = callopts)
+    out <- cli$get(path = "api/v2", query = args)
+    out$raise_for_status()
+    results <- out$parse("UTF-8")
+    
+    if (!quiet) {
+      message(
+        gsub('\n', '', sprintf(
+          "Query contains %s results. 
+          First 1000 retrieved. Use the offset argument to retrieve more \n", 
+          data$count))
+      )
+    }
   } else { 
     args$limit <- original_limit
-    results <- GET(base_url, query = args)
+    cli <- crul::HttpClient$new(url = base_url, opts = callopts)
+    out <- cli$get(path = "api/v2", query = args)
+    out$raise_for_status()
+    results <- out$parse("UTF-8")
   }
 
-  data <- jsonlite::fromJSON(content(results, "text", encoding = "UTF-8"), FALSE)
+  data <- jsonlite::fromJSON(results, FALSE)
   data <- sc(data)
 
   if (identical(data$specimens$empty_set, "No records found.")) {
@@ -46,18 +63,21 @@ aw_data2 <- function(genus = NULL, species = NULL, scientific_name = NULL,
     if (!quiet) message(sprintf("%s results available for query.", data$count))
     data_df <- lapply(data$specimens, function(x){ 
       x$images <- NULL	 	
-      # In a future fix, I should coerce the image data back to a df and add it here.
-      df <- data.frame(t(unlist(x)), stringsAsFactors=FALSE)
-      df
+      # In a future fix, I should coerce the image data back to a df and 
+      # add it here.
+      data.frame(t(unlist(x)), stringsAsFactors = FALSE)
     })
     final_df <- rbindlist(data_df, use.names = TRUE, fill = TRUE)
     setDF(final_df)
-    names(final_df)[grep("geojson.coord1", names(final_df))] <- "decimal_latitude"
-    names(final_df)[grep("geojson.coord2", names(final_df))] <- "decimal_longitude"
+    names(final_df)[grep("geojson.coord1", names(final_df))] <- 
+      "decimal_latitude"
+    names(final_df)[grep("geojson.coord2", names(final_df))] <- 
+      "decimal_longitude"
     # There seem to be extra field when searching for just a genus
     final_df$decimalLatitude <- NULL
     final_df$decimalLongitude <- NULL
-    final_df$minimumElevationInMeters <- as.numeric(final_df$minimumElevationInMeters)
+    final_df$minimumElevationInMeters <- 
+      as.numeric(final_df$minimumElevationInMeters)
     list(count = data$count, call = args, data = final_df)
   }
 }	

R/as.ala.R

@@ -3,58 +3,59 @@
 #' @export
 #'
 #' @param x Various inputs, including the output from a call to
-#' \code{\link{occ}} (class occdat), \code{\link{occ2df}} (class data.frame),
+#' [occ()] (class occdat), [occ2df()] (class data.frame),
 #' or a list, numeric, alakey, or occkey.
+#' @param ... curl options; named parameters passed on to [crul::HttpClient()]
 #' @return One or more in a list of both class alakey and occkey
 #' @examples \dontrun{
-#' # spnames <- c('Barnardius zonarius', 'Grus rubicunda', 'Cracticus tibicen')
-#' # out <- occ(query=spnames, from='ala', limit=2)
-#' # (res <- occ2df(out))
-#' # (tt <- as.ala(out))
-#' # as.ala(x = res$key[1])
+#' spnames <- c('Barnardius zonarius', 'Grus rubicunda', 'Cracticus tibicen')
+#' out <- occ(query=spnames, from='ala', limit=2)
+#' (res <- occ2df(out))
+#' (tt <- as.ala(out))
+#' as.ala(x = res$key[1])
 #' }
-as.ala <- function(x) {
+as.ala <- function(x, ...) {
   UseMethod("as.ala")
 }
 
 #' @export
-as.ala.alakey <- function(x) x
+as.ala.alakey <- function(x, ...) x
 
 #' @export
-as.ala.occkey <- function(x) x
+as.ala.occkey <- function(x, ...) x
 
 #' @export
-as.ala.occdat <- function(x) {
+as.ala.occdat <- function(x, ...) {
   x <- occ2df(x)
-  make_ala_df(x)
+  make_ala_df(x, ...)
 }
 
 #' @export
-as.ala.data.frame <- function(x) make_ala_df(x)
+as.ala.data.frame <- function(x, ...) make_ala_df(x, ...)
 
 #' @export
-as.ala.character <- function(x) make_ala(x)
+as.ala.character <- function(x, ...) make_ala(x, ...)
 
 #' @export
-as.ala.list <- function(x){
+as.ala.list <- function(x, ...) { 
   lapply(x, function(z) {
     if (inherits(z, "alakey")) {
-      as.ala(z)
+      as.ala(z, ...)
     } else {
-      make_ala(z)
+      make_ala(z, ...)
     }
   })
 }
 
-make_ala_df <- function(x){
+make_ala_df <- function(x, ...) {
   tmp <- x[x$prov %in% "ala", ]
   if (NROW(tmp) == 0) {
     stop("no data from ALA found", call. = FALSE)
   } else {
-    stats::setNames(lapply(tmp$key, make_ala), tmp$key)
+    stats::setNames(lapply(tmp$key, make_ala, ...), tmp$key)
   }
 }
 
-make_ala <- function(y, ...){
+make_ala <- function(y, ...) {
   structure(ala_occ_id(id = y, ...), class = c("alakey", "occkey"))
 }

R/as.antweb.R

@@ -2,9 +2,10 @@
 #'
 #' @export
 #'
-#' @param x Various inputs, including the output from a call to \code{\link{occ}}
-#' (class occdat), \code{\link{occ2df}} (class data.frame), or a list, numeric,
+#' @param x Various inputs, including the output from a call to [occ()]
+#' (class occdat), [occ2df()] (class data.frame), or a list, numeric,
 #' character, or antwebkey, or occkey.
+#' @param ... curl options; named parameters passed on to [crul::HttpClient()]
 #' @return One or more in a list of both class antwebkey and occkey
 #' @examples \dontrun{
 #' spp <- c("linepithema humile", "acanthognathus")
@@ -18,52 +19,53 @@
 #' as.antweb(uu[[1]])
 #' as.antweb(tt[1:2])
 #' }
-as.antweb <- function(x) UseMethod("as.antweb")
+as.antweb <- function(x, ...) UseMethod("as.antweb")
 
 #' @export
-as.antweb.antwebkey <- function(x) x
+as.antweb.antwebkey <- function(x, ...) x
 
 #' @export
-as.antweb.occkey <- function(x) x
+as.antweb.occkey <- function(x, ...) x
 
 #' @export
-as.antweb.occdat <- function(x) {
+as.antweb.occdat <- function(x, ...) {
   x <- occ2df(x)
-  make_antweb_df(x)
+  make_antweb_df(x, ...)
 }
 
 #' @export
-as.antweb.data.frame <- function(x) make_antweb_df(x)
+as.antweb.data.frame <- function(x, ...) make_antweb_df(x, ...)
 
 #' @export
-as.antweb.character <- function(x) make_antweb(x)
+as.antweb.character <- function(x, ...) make_antweb(x, ...)
 
 #' @export
-as.antweb.list <- function(x){
+as.antweb.list <- function(x, ...) {
   lapply(x, function(z) {
     if (inherits(z, "antwebkey")) {
-      as.antweb(z)
+      as.antweb(z, ...)
     } else {
-      make_antweb(z)
+      make_antweb(z, ...)
     }
   })
 }
 
-make_antweb_df <- function(x){
+make_antweb_df <- function(x, ...) {
   tmp <- x[ x$prov %in% "antweb" ,  ]
   if (NROW(tmp) == 0) {
     stop("no data from antweb found", call. = FALSE)
   } else {
-    stats::setNames(lapply(tmp$key, make_antweb), tmp$key)
+    stats::setNames(lapply(tmp$key, make_antweb, ...), tmp$key)
   }
 }
 
 make_antweb <- function(y, ...){
   structure(get_antweb(y, ...), class = c("antwebkey", "occkey"))
 }
 
-get_antweb <- function(z) {
-  res <- GET(sprintf('http://antweb.org/api/v2/?occurrenceId=CAS:ANTWEB:%s', z))
-  stop_for_status(res)
-  jsonlite::fromJSON(content(res, "text", encoding = "UTF-8"))
+get_antweb <- function(z, ...) {
+  cli <- crul::HttpClient$new(url = "http://antweb.org", opts = list(...))
+  out <- cli$get(path = paste0('api/v2/?occurrenceId=CAS:ANTWEB:', z))
+  out$raise_for_status()
+  jsonlite::fromJSON(out$parse("UTF-8"))
 }