Data.frame layers

R/info.R

@@ -17,7 +17,7 @@
         title = purrr::map_chr(wfs_layers, ~.x$getTitle()),
         abstract = purrr::map_chr(wfs_layers, ~getAbstractNull(.x)),
         class = purrr::map_chr(wfs_layers, ~.x$getClassName()),
-        format = "sf"
+        format = purrr::map_chr(wfs_layers, guess_layer_format)
     ) %>%
         tidyr::separate(
             .data$layer_name,
@@ -44,9 +44,8 @@ emodnet_get_layer_info <- memoise::memoise(.emodnet_get_layer_info)
                          Both cannot be {usethis::ui_value('NULL')}")
     }
 
-    if(is.null(wfs)){
-        wfs <- emodnet_init_wfs_client(service, service_version)
-    }else{check_wfs(wfs)}
+    wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
+    check_wfs(wfs)
 
     caps <- wfs$getCapabilities()
 
@@ -58,7 +57,7 @@ emodnet_get_layer_info <- memoise::memoise(.emodnet_get_layer_info)
         title = purrr::map_chr(caps$getFeatureTypes(), ~.x$getTitle()),
         abstract = purrr::map_chr(caps$getFeatureTypes(), ~getAbstractNull(.x)),
         class = purrr::map_chr(caps$getFeatureTypes(), ~.x$getClassName()),
-        format = "sf"
+        format = purrr::map_chr(caps$getFeatureTypes(), guess_layer_format)
     ) %>%
         tidyr::separate(.data$layer_name, into = c("layer_namespace", "layer_name"),
                         sep = ":")
@@ -96,3 +95,11 @@ getAbstractNull <- function(x){
     abstract <- x$getAbstract()
     ifelse(is.null(abstract), "", abstract)
 }
+
+guess_layer_format <- function(layer) {
+    if (any(layer$getDescription(pretty = T)$type == "geometry")) {
+        "sf"
+    } else {
+        "data.frame"
+    }
+}

R/layer_attributes.R

@@ -32,10 +32,9 @@ layer_attributes_summarise <- function(wfs = NULL,
 layer_attribute_descriptions <- function(wfs = NULL,
                                          service = NULL,
                                          service_version = "2.0.0", layer) {
-    if(is.null(wfs)){
-        wfs <- emodnet_init_wfs_client(service,
-                                       service_version)
-    }else{check_wfs(wfs)}
+
+    wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
+    check_wfs(wfs)
 
     get_layer_metadata(layer, wfs)$getDescription(pretty = TRUE)
 }
@@ -86,10 +85,8 @@ layer_attribute_inspect <- function(wfs = NULL,
                                     service_version = "2.0.0",
                                     layer, attribute) {
 
-    if(is.null(wfs)){
-        wfs <- emodnet_init_wfs_client(service,
-                                       service_version)
-    }else{check_wfs(wfs)}
+    wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
+    check_wfs(wfs)
 
     layer <- match.arg(layer, several.ok = FALSE,
                        choices = emodnet_get_wfs_info(wfs)$layer_name)
@@ -132,10 +129,8 @@ layer_attributes_tbl <- function(wfs = NULL,
                                 service = NULL,
                                 service_version = "2.0.0", layer) {
 
-    if(is.null(wfs)){
-        wfs <- emodnet_init_wfs_client(service,
-                                       service_version)
-    }else{check_wfs(wfs)}
+    wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
+    check_wfs(wfs)
 
     layer <- match.arg(layer, several.ok = FALSE,
                        choices = emodnet_get_wfs_info(wfs)$layer_name)

R/layers.R

@@ -51,27 +51,39 @@
 #' )
 #' }
 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) {
+    layers, crs = NULL, cql_filter = NULL,
+    reduce_layers = FALSE, suppress_warnings = FALSE) {
 
     # check wfs ----------------------------------------------------------------
 
     if (is.null(wfs) & is.null(service)) {
         usethis::ui_stop(
-        "Please provide a valid {usethis::ui_field('service')} name or {usethis::ui_field('wfs')} object.
+            "Please provide a valid {usethis::ui_field('service')} name or {usethis::ui_field('wfs')} object.
          Both cannot be {usethis::ui_value('NULL')} at the same time."
         )
     }
 
-    if (is.null(wfs)) {
-        wfs <- emodnet_init_wfs_client(service, service_version)
-    }
+    wfs <- wfs %||% emodnet_init_wfs_client(service, service_version)
 
     check_wfs(wfs)
 
     # check layers -----------------------------------------
-    layers <- match.arg(layers, several.ok = TRUE,
-                       choices = emodnet_get_wfs_info(wfs)$layer_name)
+    layers <- match.arg(
+        layers,
+        several.ok = TRUE,
+        choices = emodnet_get_wfs_info(wfs)$layer_name
+    )
+
+    formats <- purrr::map_chr(layers, get_layer_format, wfs)
+    if (any(formats != "sf") && reduce_layers) {
+        rlang::abort(
+            c(
+                "Can't reduce layers when one is a data.frame",
+                i = sprintf("data.frame layer(s): %s", toString(layers[formats == "data.frame"]))
+            )
+
+        )
+    }
 
     # check filter vector -----------------------------------------
     cql_filter <- cql_filter %||% rep(NA, times = length(layers))
@@ -140,10 +152,16 @@ check_layer_crs <- function(layer_sf, layer, wfs) {
 
 
 checkmate_crs <- function(sf, crs = NULL) {
+
     if (checkmate::test_null(sf)) {
         return(sf)
     }
 
+    # data.frame layers
+    if (!inherits(sf, "sf")) {
+        return(sf)
+    }
+
     if (is.na(sf::st_crs(sf)) || is.null(sf::st_crs(sf))) {
         usethis::ui_warn("{usethis::ui_field('crs')} missing from `sf` object.")
 
@@ -163,37 +181,42 @@ checkmate_crs <- function(sf, crs = NULL) {
 standardise_crs <- function(out, crs = NULL) {
 
     if (checkmate::test_class(out, "list")) {
-       purrr::map(out, ~checkmate_crs(.x, crs = crs))
+        purrr::map(out, ~checkmate_crs(.x, crs = crs))
     } else {
         checkmate_crs(out, crs = crs)
     }
 }
 
 ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL) {
-
     # check and namespace layers -----------------------------------------------
     namespaced_x <- namespace_layer_names(wfs, x)
 
     layer <- NULL
     if (is.na(cql_filter)) {cql_filter <- NULL}
     if (is.null(cql_filter)) {
         # get layer without cql_filter
-        tryCatch(
+        tryCatch({
 
-            layer <- wfs$getFeatures(namespaced_x) %>%
-                check_layer_crs(layer = x, wfs = wfs),
+            layer <- wfs$getFeatures(namespaced_x)
+            if (inherits(layer, "sf")) {
+                layer <- check_layer_crs(layer, layer = x, wfs = wfs)
+            }
+        },
             error = function(e) {
                 usethis::ui_warn("Download of layer {usethis::ui_value(x)} failed: {usethis::ui_field(e)}")
-                }
+            }
         )
     } else {
         # get layer using cql_filter
-        tryCatch(
-            layer <- wfs$getFeatures(namespaced_x, cql_filter = utils::URLencode(cql_filter)) %>%
-                check_layer_crs(layer = x, wfs = wfs),
+        tryCatch({
+            layer <- wfs$getFeatures(namespaced_x, cql_filter = utils::URLencode(cql_filter))
+            if (inherits(layer, "sf")) {
+              layer <- check_layer_crs(layer, layer = x, wfs = wfs)
+            }
+                },
             error = function(e) {
                 usethis::ui_warn("Download of layer {usethis::ui_value(x)} failed: {usethis::ui_field(e)}")
-                }
+            }
         )
     }
     return(layer)
@@ -202,12 +225,16 @@ ews_get_layer <- function(x, wfs, suppress_warnings = FALSE, cql_filter = NULL)
 namespace_layer_names <- function(wfs, layers) {
 
     info <- emodnet_get_wfs_info(wfs)
-    layers  <- match.arg(layers, choices = info$layer_name,
-                         several.ok = TRUE)
+    layers  <- match.arg(layers, choices = info$layer_name, several.ok = TRUE)
 
     # get layer namespace from info and concatenate with layer name. Otherwise
     # empty list returned in capabilities$findFeatureTypeByName
     info[info$layer_name %in% layers,
-                   c("layer_namespace", "layer_name")] %>%
+        c("layer_namespace", "layer_name")] %>%
         apply(1, FUN = function(x){paste0(x, collapse=":")})
 }
+
+get_layer_format <- function(layer, wfs) {
+    layers <- emodnet_get_wfs_info(wfs)
+    layers$format[layers$layer_name == layer]
+}

tests/testthat/_snaps/layer_attributes.md

@@ -1,4 +1,4 @@
-# layer_attribute_descriptions works
+# layer attributes stuff works
 
           name      type minOccurs maxOccurs nillable
     1       id   integer         0         1     TRUE

tests/testthat/_snaps/layers.md

@@ -9,5 +9,10 @@
 
 # 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"
+
+# works when data.frame layer
+
+    Can't reduce layers when one is a data.frame
+    i data.frame layer(s): OOPS_summaries, OOPS_metadata