Use Western Australia's Web Feature Services in R

wa_web_feature_services.R

# Get all DPIRD boundary data sets available from the Public Services Slip WA and save data for use in an R package.

# HT to Thierry Onkelinx, Hans Van Calster, Floris Vanderhaeghe for their post,
# <https://inbo.github.io/tutorials/tutorials/spatial_wfs_services/>, but I
# modified this to work to save .Rds files for use in an R package, not just
# saving to disk and chose to use {httr2} in place of {httr}.

# NOTE: This URL is only for public boundaries,
<https://public-services.slip.wa.gov.au/public/services/SLIP_Public_Services/Boundaries_WFS/MapServer/WFSServer>,
there are others, see <https://catalogue.data.wa.gov.au/dataset> for other orgs and types of data

wfs_pb_wa <-
  "https://public-services.slip.wa.gov.au/public/services/SLIP_Public_Services/Boundaries_WFS/MapServer/WFSServer"

url <- httr2::url_parse(wfs_pb_wa)
url$query <- list(service = "wfs",
                  version = "2.0.0", # facultative
                  request = "GetCapabilities")
request <- httr2::url_build(url)
wa_client <- ows4R::WFSClient$new(wfs_wa,
                                  serviceVersion = "2.0.0")

wa_features <- wa_client$getFeatureTypes(pretty = TRUE)
wa_features <-
  gsub("SLIP_Public_Services_Boundaries_WFS:", "", wa_features$name)
dpird_features <- grep("DPIRD", wa_features, value = TRUE)

#' Get a named data set from WA's Web Feature Service
#' @param x The name of the desired data set to fetch.
#'
get_wfs_data <- function(x) {
  url$query <- list(
    service = "wfs",
    version = "2.0.0",
    request = "GetFeature",
    typename = x,
    srsName = "EPSG:4326"
  )
  request <- httr2::url_build(url)
  sf::read_sf(request) |>
    sf::st_transform(crs = 28350)
}

# get all the data sets for DPIRD
dpird_data <- lapply(X = dpird_features, FUN = get_wfs_data)

# tidy up the names of the objects in the R session
names(dpird_data) <- tolower(sub("\\__[^.]*$", "", dpird_features))

# this will save objects for use in package
library(usethis)
purrr::walk2(dpird_data, names(dpird_data), function(obj, name) {
  assign(name, obj)
  do.call("use_data",
          list(as.name(name), overwrite = TRUE, compress = "xz"))
})