Merge pull request #197 from R-ArcGIS/pbf

utilize arcpbf when possible add tests

DESCRIPTION

@@ -21,6 +21,7 @@ Encoding: UTF-8
 LazyData: true
 Imports: 
     arcgisutils (>= 0.2.0),
+    arcpbf (>= 0.1.2),
     cli,
     httr2 (>= 1.0.0),
     jsonify,

NEWS.md

@@ -1,5 +1,7 @@
-# arcgislayers 0.3.0
+# arcgislayers (development)
 
+- Now uses [`{arcpbf}`](https://r.esri.com/arcpbf/index.html) when a layer supports protocol buffers. 
+  - This is an ~3x speed improvement over json processing.
 - New `query_layer_attachments()` and `download_attachments()` help you access and download attachments to a layer
 - `arc_raster()` now downloads the exported image to a temp file instead of creating a connection to the url returned. This fixes an issue where rasters would stop working after the url had been removed. 
 - Add `alias` argument to `arc_read()` allowing replacement or labelling of field names with alias values (#169)

R/arc-select.R

@@ -78,7 +78,7 @@ arc_select <- function(
   # For this function we extract the query object and manipulate the elements
   # inside of the query object to modify our request. We then splice those
   # values back into `x` and send our request
-  # note that everything that goes into our quey must be the json that will
+  # note that everything that goes into our query must be the json that will
   # be sent directly to the API request which is why we convert it to json
   # before we use `update_params()`
   check_inherits_any(x, c("FeatureLayer", "Table", "ImageServer"))
@@ -107,13 +107,16 @@ arc_select <- function(
   # handle fields and where clause if missing
   fields <- fields %||% query[["outFields"]]
 
+  # make sure that fields actually exist
   fields <- match_fields(
     fields = fields,
     values = c(x[["fields"]][["name"]], "")
   )
 
+  # include the fields the query
   query[["outFields"]] <- fields
 
+  # include the where clause if present
   query[["where"]] <- where %||% query[["where"]]
 
   # set returnGeometry depending on on geometry arg
@@ -197,7 +200,14 @@ collect_layer <- function(
 
   # parameter validation ----------------------------------------------------
   # get existing parameters
-  query_params <- validate_params(query)
+
+  # determine_format() chooses between pbf and json
+  out_f <- determine_format(x)
+
+  query_params <- validate_params(
+    query,
+    out_f
+  )
 
   # Offsets -----------------------------------------------------------------
 
@@ -218,24 +228,24 @@ collect_layer <- function(
     error_call = error_call
   )
 
-  # identify any errors
-  # TODO: determine how to handle errors
-  # has_error <- vapply(all_resps, function(x) inherits(x, "error"), logical(1))
-
-  # fetch the results
-  res <- lapply(
-    all_resps,
-    # all_resps[!has_error],
-    function(x) {
-      parse_esri_json(
-        httr2::resp_body_string(x),
-        call = error_call
-      )
-    }
-  )
+  if (out_f == "pbf") {
+    res <- arcpbf::resps_data_pbf(all_resps)
+  } else {
+    # fetch the results
+    res <- lapply(
+      all_resps,
+      # all_resps[!has_error],
+      function(x) {
+        parse_esri_json(
+          httr2::resp_body_string(x),
+          call = error_call
+        )
+      }
+    )
 
-  # combine results
-  res <- rbind_results(res, call = error_call)
+    # combine results
+    res <- rbind_results(res, call = error_call)
+  }
 
   # Drop fields that aren't selected to avoid returning OBJECTID when not
   # selected
@@ -425,7 +435,7 @@ add_offset <- function(.req, .offset, .page_size, .params) {
 #'
 #' @keywords internal
 #' @noRd
-validate_params <- function(params) {
+validate_params <- function(params, f = "json") {
   if (!is.null(params[["outFields"]])) {
     params[["outFields"]] <- paste0(params[["outFields"]], collapse = ",")
   } else {
@@ -438,9 +448,9 @@ validate_params <- function(params) {
 
   # set output type to geojson if we return geometry, json if not
   if (is.null(params[["returnGeometry"]]) || isTRUE(params[["returnGeometry"]])) {
-    params[["f"]] <- "json"
+    params[["f"]] <- f
   } else {
-    params[["f"]] <- "json"
+    params[["f"]] <- f
   }
 
   params
@@ -451,7 +461,8 @@ validate_params <- function(params) {
 count_results <- function(req, query, n_max = Inf, error_call = rlang::caller_env()) {
   n_req <- httr2::req_body_form(
     httr2::req_url_path_append(req, "query"),
-    !!!validate_params(query),
+    # count results should always use json
+    !!!validate_params(query, query[["f"]]),
     returnCountOnly = "true"
   )
 
@@ -615,3 +626,41 @@ validate_page_size <- function(
 
   page_size
 }
+
+
+# Protocol Buffer helpers ------------------------------------------------
+
+supports_pbf <- function(x, arg = rlang::caller_arg(x), call = rlang::caller_call()) {
+  # verify that x is an layer
+  obj_check_layer(x, arg, call)
+
+  # extract supported query formats
+  query_formats_raw <- x[["supportedQueryFormats"]]
+
+  # perform a check to make sure the supported query formats are
+  # actually there if not return false. This shouldn't happen though.
+  if (is.null(query_formats_raw)) {
+    return(FALSE)
+  }
+
+  # split and convert to lower case
+  formats <- tolower(strsplit(query_formats_raw, ", ")[[1]])
+  # if for some reason the first element is null we return false
+  # note sure of the utility of this check though.
+
+  if (is.null(formats)) {
+    return(FALSE)
+  }
+
+  # perform the check
+  "pbf" %in% formats
+}
+
+determine_format <- function(x, arg = rlang::caller_arg(x), call = rlang::caller_call()) {
+  use_pbf <- supports_pbf(x, arg, call)
+  if (use_pbf) {
+    "pbf"
+  } else {
+    "json"
+  }
+}

tests/testthat/test-pbf.R

@@ -0,0 +1,16 @@
+test_that("supports pbf: polygons", {
+  furl <- "https://services3.arcgis.com/ZvidGQkLaDJxRSJ2/ArcGIS/rest/services/PLACES_LocalData_for_BetterHealth/FeatureServer/1"
+  x <- arc_open(furl)
+  expect_no_error(arc_select(x, where = "stateabbr = 'GA' and pop2010 > 100000"))
+})
+
+test_that("supports pbf: points", {
+  x <- arc_open("https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Major_Cities_/FeatureServer/0")
+  expect_no_error(arc_select(x, n_max = 1000L))
+})
+
+test_that("does not support pbf: multilinestring", {
+  furl <- "https://egisp.dot.ga.gov/arcgis/rest/services/ARCWEBSVCMAP/MapServer/1"
+  x <- arc_open(furl)
+  expect_no_error(arc_select(x, n_max = 10))
+})