Fix #175

R/arc-select.R

@@ -42,24 +42,24 @@
 #' @export
 #' @examples
 #' \dontrun{
-#'   # define the feature layer url
-#'   furl <- paste0(
-#'     "https://services3.arcgis.com/ZvidGQkLaDJxRSJ2/arcgis/rest",
-#'     "/services/PLACES_LocalData_for_BetterHealth/FeatureServer/0"
-#'   )
+#' # define the feature layer url
+#' furl <- paste0(
+#'   "https://services3.arcgis.com/ZvidGQkLaDJxRSJ2/arcgis/rest",
+#'   "/services/PLACES_LocalData_for_BetterHealth/FeatureServer/0"
+#' )
 #'
-#'   flayer <- arc_open(furl)
+#' flayer <- arc_open(furl)
 #'
-#'   arc_select(
-#'     flayer,
-#'     fields = c("StateAbbr", "TotalPopulation")
-#'   )
+#' arc_select(
+#'   flayer,
+#'   fields = c("StateAbbr", "TotalPopulation")
+#' )
 #'
-#'   arc_select(
-#'     flayer,
-#'     fields = c("OBJECTID", "PlaceName"),
-#'     where = "TotalPopulation > 1000000"
-#'   )
+#' arc_select(
+#'   flayer,
+#'   fields = c("OBJECTID", "PlaceName"),
+#'   where = "TotalPopulation > 1000000"
+#' )
 #' }
 #' @returns An sf object, or a data.frame
 arc_select <- function(
@@ -73,9 +73,7 @@ arc_select <- function(
     predicate = "intersects",
     n_max = Inf,
     page_size = NULL,
-    token = arc_token()
-) {
-
+    token = arc_token()) {
   # Developer note:
   # 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
@@ -107,29 +105,16 @@ arc_select <- function(
   }
 
   # handle fields and where clause if missing
-  fields <- fields %||% query[["outFields"]] %||% "*"
-
-  # if not missing fields collapse to scalar character
-  if (length(fields) > 1) {
-    # check if incorrect field names provided
-    x_fields <- x[["fields"]][["name"]]
-    nindex <- tolower(fields) %in% tolower(x_fields)
-
-    # handle the case where a field is being selected that
-    # is not one of the available fields in the feature layer
-    if (any(!nindex)) {
-      cli::cli_abort(
-        "Field{?s} not in {.arg x}: {.var {fields[!nindex]}}"
-      )
-    }
-    # collapse together
-    fields <- paste0(fields, collapse = ",")
-  }
+  fields <- fields %||% query[["outFields"]]
+
+  fields <- match_fields(
+    fields = fields,
+    values = c(x[["fields"]][["name"]], "")
+  )
 
   query[["outFields"]] <- fields
 
-  # if where is missing set to 1=1
-  query[["where"]] <- where %||% query[["where"]] %||% "1=1"
+  query[["where"]] <- where %||% query[["where"]]
 
   # set returnGeometry depending on on geometry arg
   query[["returnGeometry"]] <- geometry
@@ -170,9 +155,7 @@ collect_layer <- function(
     token = arc_token(),
     page_size = NULL,
     ...,
-    error_call = rlang::caller_env()
-) {
-
+    error_call = rlang::caller_env()) {
   if (length(page_size) > 1) {
     cli::cli_abort("{.arg page_size} must be length 1 not {length(page_size)}")
   } else if (!is.null(page_size) && page_size < 1) {
@@ -191,8 +174,7 @@ collect_layer <- function(
   req <- arc_base_req(x[["url"]], token)
 
   # determine if the layer can query
-  can_query <- switch(
-    class(x),
+  can_query <- switch(class(x),
     "FeatureLayer" = grepl("query", x[["capabilities"]], ignore.case = TRUE),
     "Table" = grepl("query", x[["capabilities"]], ignore.case = TRUE),
     "ImageServer" = x[["supportsAdvancedQueries"]],
@@ -215,6 +197,10 @@ collect_layer <- function(
     query[["outSR"]] <- jsonify::to_json(validate_crs(sf::st_crs(x))[[1]], unbox = TRUE)
   }
 
+  # retain outFields vector and create flag
+  out_fields <- query[["outFields"]]
+  has_out_fields <- !is.null(out_fields) && !identical(out_fields, "*")
+
   # parameter validation ----------------------------------------------------
   # get existing parameters
   query_params <- validate_params(query)
@@ -254,7 +240,8 @@ collect_layer <- function(
   if (is.null(n_feats)) {
     cli::cli_abort(
       c("Can't determine the number of features for {.arg x}.",
-      "*" = "Check to make sure your {.arg where} statement is valid."),
+        "*" = "Check to make sure your {.arg where} statement is valid."
+      ),
       call = error_call
     )
   }
@@ -291,26 +278,33 @@ collect_layer <- function(
     # all_resps[!has_error],
     function(x) {
       parse_esri_json(
-        httr2::resp_body_string(x)
-        )
+        httr2::resp_body_string(x),
+        call = error_call
+      )
     }
   )
 
-  # combine
-  # TODO enhance this with suggested packages similar to arcpbf
-  res <- do.call(rbind, res)
+  # combine results
+  res <- rbind_results(res, call = error_call)
+
+  # Drop fields that aren't selected to avoid returning OBJECTID when not
+  # selected
+  if (rlang::is_named(res) && has_out_fields) {
+    out_fields <- c(out_fields, attr(res, "sf_column"))
+    res_nm <- names(res)
+    res <- res[, tolower(res_nm) %in% tolower(out_fields), drop = FALSE]
+  }
 
-  if (is.null(res)) {
+  if (rlang::is_empty(res)) {
     cli::cli_alert_info("No features returned from query")
-    return(data.frame())
+    return(res)
   }
 
   if (inherits(res, "sf") && is.na(sf::st_crs(res))) {
     sf::st_crs(res) <- sf::st_crs(x)
   }
 
   res
-
 }
 
 
@@ -379,13 +373,13 @@ check_inherits_any <- function(x,
 #' @export
 #' @examples
 #' \dontrun{
-#'   furl <- paste0(
-#'     "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/",
-#'     "USA_Major_Cities_/FeatureServer/0"
-#'   )
+#' furl <- paste0(
+#'   "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/",
+#'   "USA_Major_Cities_/FeatureServer/0"
+#' )
 #'
-#'  flayer <- arc_open(furl)
-#'  update_params(flayer, outFields = "NAME")
+#' flayer <- arc_open(furl)
+#' update_params(flayer, outFields = "NAME")
 #' }
 #' @returns An object of the same class as `x`
 update_params <- function(x, ...) {
@@ -426,12 +420,15 @@ add_offset <- function(.req, .offset, .page_size, .params) {
 #' @keywords internal
 #' @noRd
 validate_params <- function(params) {
-
-  # if output fields are missing set to "*"
-  if (is.null(params[["outFields"]])) params[["outFields"]] <- "*"
+  if (!is.null(params[["outFields"]])) {
+    params[["outFields"]] <- paste0(params[["outFields"]], collapse = ",")
+  } else {
+    # if output fields are missing set to "*"
+    params[["outFields"]] <- "*"
+  }
 
   # if where is missing set it to 1=1
-  if (is.null(params[["where"]])) params[["where"]] <- "1=1"
+  params[["where"]] <- params[["where"]] %||% "1=1"
 
   # set output type to geojson if we return geometry, json if not
   if (is.null(params[["returnGeometry"]]) || isTRUE(params[["returnGeometry"]])) {
@@ -461,3 +458,31 @@ count_results <- function(req, query) {
   RcppSimdJson::fparse(resp)[["count"]]
 }
 
+#' Match fields
+#'
+#' [match_fields()] ensures that fields passed to [arc_select()] match
+#' permissible values.
+#'
+#' @keywords internal
+#' @noRd
+match_fields <- function(fields,
+                         values = NULL,
+                         multiple = TRUE,
+                         error_arg = rlang::caller_arg(fields),
+                         error_call = rlang::caller_env()) {
+  if (is.null(fields) || identical(fields, "*")) {
+    return(fields)
+  }
+
+  if (all(tolower(fields) %in% tolower(values))) {
+    return(fields)
+  }
+
+  rlang::arg_match(
+    fields,
+    values = values,
+    multiple = multiple,
+    error_arg = error_arg,
+    error_call = error_call
+  )
+}

tests/testthat/test-returned-fields.R

@@ -0,0 +1,88 @@
+# Tests to ensure that the correct fields are return
+
+furl <- "https://services.arcgis.com/P3ePLMYs2RVChkJx/ArcGIS/rest/services/USA_Major_Cities_/FeatureServer/0"
+
+flayer <- arc_open(furl)
+# https://github.com/R-ArcGIS/arcgislayers/pull/179
+test_that("arc_select(x, fields = \"\"): returns no fields", {
+  res <- arc_select(flayer, fields = "")
+  expect_identical(colnames(res), "geometry")
+})
+
+test_that('arc_select(x, fields = "", geometry = NULL): returns 0 columns all rows', {
+  expect_identical(
+    dim(arc_select(flayer, fields = "", geometry = FALSE)),
+    c(4186L, 0L)
+  )
+})
+
+
+test_that('arc_select(flayer, fields = "state_abbr") does not include OID', {
+  res <- arc_select(flayer, fields = "state_abbr", n_max = 10)
+  expect_identical(
+    colnames(res),
+    c("STATE_ABBR", "geometry")
+  )
+})
+
+test_that("arc_select() doesnt remove OID with fields", {
+  res <- arc_select(
+    flayer,
+    fields = c("state_abbr", "objectid"), n_max = 10
+  )
+  expect_identical(
+    colnames(res),
+    c("STATE_ABBR", "OBJECTID", "geometry")
+  )
+})
+
+test_that("arc_select() with fields works on tables", {
+  furl <- paste0(
+    "https://services.arcgis.com/P3ePLMYs2RVChkJx/arcgis/rest/services/",
+    "USA_Wetlands/FeatureServer/1"
+  )
+
+  flayer <- arc_open(furl)
+  expect_no_error(arc_select(flayer, fields = "", n_max = 100))
+
+  res <- arc_select(flayer, fields = "objectid", n_max = 100)
+  expect_identical(colnames(res), "OBJECTID")
+
+
+  res <- arc_select(flayer, n_max = 100)
+  expect_identical(
+    colnames(res),
+    list_fields(flayer)[["name"]]
+  )
+})
+
+test_that("arc_select() works with ImageServers", {
+  landsat <- arc_open(
+    "https://landsat2.arcgis.com/arcgis/rest/services/Landsat/MS/ImageServer"
+  )
+
+
+  res <- arc_select(landsat, fields = "Name", n_max = 10)
+
+  expect_identical(
+    colnames(res),
+    c("Name", "geometry")
+  )
+
+  expect_identical(
+    colnames(arc_select(landsat, fields = "objectid", n_max = 1)),
+    c("OBJECTID", "geometry")
+  )
+
+  expect_identical(
+    colnames(
+      arc_select(
+        landsat,
+        fields = c("name", "objectid"),
+        n_max = 1,
+        geometry = FALSE
+      )
+    ),
+    c("Name", "OBJECTID")
+  )
+})