diff --git a/R/arc-select.R b/R/arc-select.R index 5c9c217..2830697 100644 --- a/R/arc-select.R +++ b/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,18 +278,26 @@ 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))) { @@ -310,7 +305,6 @@ collect_layer <- function( } 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 + ) +} diff --git a/tests/testthat/test-returned-fields.R b/tests/testthat/test-returned-fields.R new file mode 100644 index 0000000..e7c4397 --- /dev/null +++ b/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") + ) +})