R/query_layer.R

In MatthewJWhittle/getarc: An R Wrapper for the ArcGIS Rest API

#' Query Layer
#'
#' Query a layer on an arcgis server
#'
#' @param endpoint a string defining the enpoint url.
#' It can be generated by the \code{feature_server_endpoint} and \code{map_server_endpoint} functons.
#' See https://developers.arcgis.com/rest/services-reference/get-started-with-the-services-directory.htm
#' @param my_token an access token acquired via \code{get_token}
#' @param in_geometry the geometry to use when applying a spatial filter to the layer. This should be an sf object with only one geometry. If you want to query with multiple geometries, the best practice is to use sf::st_union() to combine them. Bounding boxes are accepted by this argument and are the fastest.
#' @param spatial_filter The type of spatial filter. Defaults to intersection (intersects).
#' Options are: intersects, contains, crosses, envelope_intersects, index_intersects, overlaps, touches, within
#' @param out_fields the fields of the layer to return (character vector)
#' @param where an optional SQL where query formatted as a single string. See the documentation for what is accepted
#' @param query a named vector of parameters to include in the query
#' @param crs the output crs, defaulting to 4326
#' @param return_geometry should the geometry be returned or just a table?
#' @param return_n how many features (maximum) should be returned by the query?
#' @param geometry_precision The number of decimal places in the response geometries returned by the query operation
#' @param cache either: TRUE to use default caching (in the cache directory set with set_cache_directory()); a path to an alternative cache location or NULL for no caching (default)
#'
#' @return an sf object
#' @export query_layer
#'
#' @importFrom sf st_transform
#' @importFrom lubridate with_tz
#' @importFrom sf st_write
#' @importFrom dplyr pull
#' @importFrom dplyr bind_rows
#' @importFrom dplyr filter
#' @importFrom sf st_read
#' @importFrom glue glue
#' @importFrom utils modifyList
query_layer <-
  function(endpoint,
           in_geometry = NULL,
           spatial_filter = "intersects",
           return_geometry = TRUE,
           where = NULL,
           out_fields = c("*"),
           return_n = NULL,
           geometry_precision = NULL,
           query = list(),
           crs = 4326,
           my_token = NULL,
           cache = NULL) {
    #https://developers.arcgis.com/rest/services-reference/layer-feature-service-.htm
    # It would be useful to add a line of code in here to check and auto refresh the token
    # Get the details of the layer to
    layer_details <- get_layer_details(endpoint = endpoint, my_token = my_token)

    # Get the unique ID field from the layer details.
    id_field <-
      get_unique_id_field(endpoint = endpoint,
                          layer_details = layer_details)



    argument_parameters <-
      list(
        returnGeometry = lower_logical(return_geometry),
        outFields = format_out_fields(id_field, out_fields),
        resultRecordCount = return_n,
        geometryPrecision = geometry_precision,
        where = where
      )
    argument_parameters <- drop_null(argument_parameters)

    user_query <- utils::modifyList(query, argument_parameters, keep.null = FALSE)


    # If an in_geometry has been specified then generate the spatial query and combine with the query parameters
    if (!is.null(in_geometry)) {
      spatial_query <- spatial_query(x = in_geometry,
                                     spatial_filter = esri_spatial_filter(spatial_filter))
      user_query <- utils::modifyList(user_query, spatial_query, keep.null = FALSE)
    }

    query <- query_object(default = default_query_parameters(map_server = map_server(endpoint)),
                          user_query = user_query,
                          my_token = my_token)



    cache_object <-
      init_cache(
        endpoint = endpoint,
        query = query,
        cache = cache,
        layer_details = layer_details,
        id_field = id_field,
        my_token = my_token
      )
    # IF there haven't been any changes & the user has specified to use the cache
    # then return the cached data
    if (!cache_object$any_changes & cache_object$use_cache) {
      if (return_geometry & any(c("sf", "sfc") %in% class(cache_object$data_cache))) {
        # If it is spatial data then return with the right CRS
        # Return the data in the right CRS
        return(st_transform(cache_object$data_cache, crs = crs))
      }
      return(cache_object$data_cache)
    }

    # Drop parts of the query that are NULL which was automatically done for vectors
    # But isn't now it is a list object
    cache_object$query <- drop_null(cache_object$query)

    # Get the data by feature IDs allowing us to exceed the max record count
    data <-
      get_by_fids(endpoint = endpoint,
                  query = cache_object$query,
                  my_token = my_token,
                  return_geometry = return_geometry,
                  return_n = return_n,
                  layer_details = layer_details,
                  out_fields = out_fields,
                  object_ids = cache_object$object_ids)

    ####
    # Parse the variables -----
    # This should probably be wrapped up into one parsing function at some point
    data <-
      parse_coded_domains(data,
                          domain_lookup(layer_details))

    data <- parse_datetimes(data = data,
                            layer_details = layer_details)

    # Parse variable types
    data <- parse_types(x  = data,
                        layer_details = layer_details)


    # Print a warning if the query didn't return any data
    if (nrow(data) == 0) {
      warning("No data returned by query.")
    }
    data <- refresh_cache(data, cache_object)

        # If the specified crs is not 4326 (the current crs) then transform the data
    # This might be redundant as we can specify the outcrs when requesting the data

    # Transform data after dealing with cache as data should always be saved as 4326 in geojson
    if (crs != 4326 &
        return_geometry & any(c("sf", "sfc") %in% class(data))) {
      data <- data %>% sf::st_transform(crs = crs)
    }

    return(data)

  }