Enable passing Vendor parameters to ows4R::GetFeature()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: EMODnetWFS
 Title: Access EMODnet Web Feature Service data through R
-Version: 2.0.1.9000
+Version: 2.0.1.9001
 Authors@R: c(
     person("Anna", "Krystalli", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0002-2378-4915")),

NEWS.md

@@ -1,5 +1,6 @@
 # EMODnetWFS (development version)
 
+* Added ability to pass vendor parameter to `EMODnetWFS::emodnet_get_layers()` queries (#88).
 * Added memoising (caching during each R session) of the functions getting services
  and layers information (#52).
 

R/layers.R

@@ -19,6 +19,8 @@
 #' @param reduce_layers whether to reduce output layers to a single `sf` object.
 #' @param suppress_warnings logical. Whether to suppress messages of layer
 #' download failures.
+#' @param ... additional vendor parameter arguments passed to [`ows4R::GetFeature()`](https://docs.geoserver.org/stable/en/user/services/wfs/reference.html#getfeature).
+#' For example, including `count=1` returns the first available feature.
 #' @return If `reduce_layers = FALSE` (default), a list of `sf`
 #' objects, one element for each layer. Any layers for which download was
 #' unsuccessful will be NULL. If `reduce_layers = TRUE`, all layers are
@@ -49,10 +51,18 @@
 #'   cql_filter = "sitename='Territory sea (12 nm)'",
 #'   reduce_layers = TRUE
 #' )
+#' # Usage of vendor parameter
+#' emodnet_get_layers(
+#'   service = "human_activities",
+#'   layers = "maritimebnds",
+#'   count = 1,
+#'   reduce_layers = TRUE
+#' )
 #' }
 emodnet_get_layers <- function(wfs = NULL, service = NULL, service_version = "2.0.0",
                                layers, crs = NULL, cql_filter = NULL,
-                               reduce_layers = FALSE, suppress_warnings = FALSE) {
+                               reduce_layers = FALSE, suppress_warnings = FALSE,
+                               ...) {
 
     # check wfs ----------------------------------------------------------------
 
@@ -89,10 +99,16 @@ emodnet_get_layers <- function(wfs = NULL, service = NULL, service_version = "2.
 
 
     # get features -------------------------------------------------------------
+    # unnamed function and explicit passing of ellipses used because of idiosyncratic use of ...
+    # within purrr::map2 function.
+    # See: https://stackoverflow.com/questions/48215325/passing-ellipsis-arguments-to-map-function-purrr-package-r
     out <- purrr::map2(
         .x = layers, .y = cql_filter,
-        ~ews_get_layer(.x, wfs, cql_filter = .y),
-        wfs, suppress_warnings
+        .f = function(x, y, wfs, suppress_warnings, ...){
+        ews_get_layer(x, wfs = wfs, cql_filter = y,
+                       suppress_warnings = suppress_warnings, ...)
+            },
+        wfs, suppress_warnings, ...
     ) %>%
         stats::setNames(layers)
 
@@ -169,7 +185,7 @@ standardise_crs <- function(out, crs = NULL) {
     }
 }
 
-ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL) {
+ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL, ...) {
 
     # check and namespace layers -----------------------------------------------
     namespaced_x <- namespace_layer_names(wfs, x)
@@ -180,7 +196,7 @@ ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL)
         # get layer without cql_filter
         tryCatch(
 
-            layer <- wfs$getFeatures(namespaced_x) %>%
+            layer <- wfs$getFeatures(namespaced_x, ...) %>%
                 check_layer_crs(layer = x, wfs = wfs),
             error = function(e) {
                 usethis::ui_warn("Download of layer {usethis::ui_value(x)} failed: {usethis::ui_field(e)}")
@@ -189,7 +205,9 @@ ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL)
     } else {
         # get layer using cql_filter
         tryCatch(
-            layer <- wfs$getFeatures(namespaced_x, cql_filter = utils::URLencode(cql_filter)) %>%
+            layer <- wfs$getFeatures(namespaced_x,
+                                     cql_filter = utils::URLencode(cql_filter),
+                                     ...) %>%
                 check_layer_crs(layer = x, wfs = wfs),
             error = function(e) {
                 usethis::ui_warn("Download of layer {usethis::ui_value(x)} failed: {usethis::ui_field(e)}")

tests/testthat/_snaps/layers.md

@@ -9,5 +9,5 @@
 
 # emodnet_get_layers errors well when bad layer
 
-    'arg' should be one of "mediseh_cor_abs_pnt", "mediseh_cor_abs_poly", "mediseh_cymodocea_pnt", "Species_gridded_abundances_10year", "Species_gridded_abundances_2year", "Species_gridded_abundances_3year", "Species_gridded_abundance_all", "mediseh_halophila_pnt", "mediseh_maerl_pnt", "mediseh_maerl_poly", "mediseh_posidonia_model", "mediseh_coral_model", "mediseh_maerl_model", "OOPS_errors", "OOPS_metadata", "OOPS_products", "OOPS_products_vliz", "OOPS_regions", "OOPS_summaries", "mediseh_cor_pnt", "mediseh_cor_poly", "mediseh_posidonia_abs", "mediseh_posidonia_nodata", "mediseh_posidonia_current_pnt", "mediseh_posidonia_current_shape", "mediseh_posidonia_historical_shape", "mediseh_posidonia_historical_pnt", "mediseh_ruppia_c_pnt", "mediseh_ruppia_m_pnt", "mediseh_zostera_m_pnt", "mediseh_zostera_n_pnt"
+    'arg' should be one of "mediseh_cor_abs_pnt", "mediseh_cor_abs_poly", "mediseh_cymodocea_pnt", "Species_gridded_abundances_10year", "Species_gridded_abundances_2year", "Species_gridded_abundances_3year", "Species_gridded_abundance_all", "mediseh_halophila_pnt", "mediseh_maerl_pnt", "mediseh_maerl_poly", "mediseh_posidonia_model", "mediseh_coral_model", "mediseh_maerl_model", "OOPS_errors", "OOPS_metadata", "OOPS_products", "OOPS_products_vliz", "OOPS_regions", "OOPS_summaries", "mediseh_cor_pnt", "mediseh_cor_poly", "mediseh_posidonia_abs", "mediseh_posidonia_nodata", "mediseh_posidonia_current_pnt", "mediseh_posidonia_current_shape", "mediseh_posidonia_historical_shape", "mediseh_posidonia_historical_pnt", "mediseh_ruppia_c_pnt", "mediseh_ruppia_m_pnt", "mediseh_zostera_m_pnt", "mediseh_zostera_n_pnt", "grey_seal", "harbour_seal"