Fixes for dbplyr 2.5.0 and handling of failing GetCapabilities requests

NEWS.md

@@ -1,5 +1,9 @@
 # bcdata (development version)
 
+* Make functions more robust to non-functioning WMS/WFS GetCapabilities requests (#339, #341)
+* dbplyr 2.5.0 has made the requirement for using `!!` or 
+  `local()` for local functions more restrictive; updated tests
+  and examples (#341).
 * Deprecate the `bcdata.single_download_limit` option, as it was mostly redundant with `bcdata.chunk_limit`, and should always be set by the server. Please set the page size limit for paginated requests via the `bcdata.chunk_limit` option (#332)
 
 # bcdata 0.4.1

R/bcdc_options.R

@@ -140,7 +140,7 @@ bcdc_get_capabilities <- function() {
 bcdc_get_wfs_records <- function() {
   doc <- bcdc_get_capabilities()
 
-  if (is.null(doc)) stop("Unable to access wfs record listing", call. = FALSE)
+  if (is.null(doc)) stop("Unable to access wfs listing from server. Please open an issue. ", call. = FALSE)
 
   # d1 is the default xml namespace (see xml2::xml_ns(doc))
   features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType")
@@ -156,7 +156,7 @@ bcdc_single_download_limit <- function() {
   doc <- bcdc_get_capabilities()
 
   if (is.null(doc)) {
-    message("Unable to access wfs record listing, using default download limit of 10000")
+    message("Unable to access server to determine single download limit; using default download limit of 10000")
     return(10000L)
   }
 

tests/testthat/helper-bcdata.R

@@ -16,3 +16,10 @@ skip_if_net_down <- function() {
   }
   testthat::skip("no internet")
 }
+
+skip_if_no_capabilities <- function() {
+  if (!is.null(bcdc_get_capabilities())) {
+    return()
+  }
+  testthat::skip("GetCapabilities request is broken")
+}

tests/testthat/test-describe-feature.R

@@ -43,6 +43,7 @@ test_that("bcdc_describe_feature accepts a bcdc_record object", {
 test_that("bcdc_describe_feature accepts BCGW name",{
   skip_on_cran()
   skip_if_net_down()
+  skip_if_no_capabilities()
   airport_feature <- bcdc_describe_feature("WHSE_IMAGERY_AND_BASE_MAPS.GSR_AIRPORTS_SVW")
   expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type", "column_comments"))
 })
@@ -57,13 +58,15 @@ test_that("bcdc_describe_feature fails on unsupported classes", {
 test_that("bcdc_describe_feature fails with non-wfs record", {
   skip_if_net_down()
   skip_on_cran()
+  skip_if_no_capabilities()
   expect_error(bcdc_describe_feature("dba6c78a-1bc1-4d4f-b75c-96b5b0e7fd30"),
                "No WFS resource available for this data set")
 })
 
 test_that("bcdc_get_wfs_records works", {
   skip_if_net_down()
   skip_on_cran()
+  skip_if_no_capabilities()
 
   wfs_records <- bcdc_get_wfs_records()
 

tests/testthat/test-geom-operators.R

@@ -16,7 +16,7 @@ if (has_internet() && identical(Sys.getenv("NOT_CRAN"), "true")) {
     collect()
 }
 
-test_that("bcdc_check_geom_size outputs message with low threshold",{
+test_that("bcdc_check_geom_size outputs message with low threshold", {
   skip_on_cran()
   skip_if_net_down()
 
@@ -25,7 +25,7 @@ test_that("bcdc_check_geom_size outputs message with low threshold",{
   expect_false(bcdc_check_geom_size(local))
 })
 
-test_that("bcdc_check_geom_size is silent with high threshold",{
+test_that("bcdc_check_geom_size is silent with high threshold", {
   skip_on_cran()
   skip_if_net_down()
 
@@ -34,7 +34,7 @@ test_that("bcdc_check_geom_size is silent with high threshold",{
 })
 
 
-test_that("WITHIN works",{
+test_that("WITHIN works", {
   skip_on_cran()
   skip_if_net_down()
 
@@ -49,7 +49,7 @@ test_that("WITHIN works",{
 })
 
 
-test_that("INTERSECTS works",{
+test_that("INTERSECTS works", {
   skip_on_cran()
   skip_if_net_down()
 
@@ -61,7 +61,6 @@ test_that("INTERSECTS works",{
 
   expect_s3_class(remote, "sf")
   expect_equal(attr(remote, "sf_column"), "geometry")
-
 })
 
 test_that("RELATE works", {
@@ -115,7 +114,7 @@ test_that("BBOX works with an sf bbox", {
 
   remote <- suppressWarnings(
     bcdc_query_geodata("bc-parks-ecological-reserves-and-protected-areas") %>%
-      filter(FEATURE_LENGTH_M <= 1000, BBOX(sf::st_bbox(local))) %>%
+      filter(FEATURE_LENGTH_M <= 1000, BBOX(!!sf::st_bbox(local))) %>%
       collect()
   )
 
@@ -144,7 +143,7 @@ test_that("Other predicates work with an sf bbox", {
 
   remote <- suppressWarnings(
     bcdc_query_geodata("bc-parks-ecological-reserves-and-protected-areas") %>%
-      filter(FEATURE_LENGTH_M <= 1000, INTERSECTS(sf::st_bbox(local))) %>%
+      filter(FEATURE_LENGTH_M <= 1000, INTERSECTS(!!sf::st_bbox(local))) %>%
       collect()
   )
 

tests/testthat/test-options.R

@@ -25,7 +25,7 @@ test_that("bcdata.chunk_limit",{
     expect_error(check_chunk_limit())
   })
   withr::with_options(list(bcdata.chunk_limit = 10), {
-    expect_silent(check_chunk_limit())
+    expect_true(is.numeric(check_chunk_limit()))
     expect_equal(check_chunk_limit(), 10)
   })
 })
@@ -36,8 +36,9 @@ test_that("bcdata.single_download_limit is deprecated but works", {
   skip_on_cran()
   withr::local_options(list(bcdata.single_download_limit = 1))
   withr::local_envvar(list(BCDC_KEY = NULL)) # so snapshot not affected by message
-  expect_snapshot(
-    bcdc_query_geodata(record = '76b1b7a3-2112-4444-857a-afccf7b20da8')
+  expect_s3_class(
+    bcdc_query_geodata(record = '76b1b7a3-2112-4444-857a-afccf7b20da8'), 
+    "bcdc_promise"
   )
 })
 

tests/testthat/test-query-geodata-filter.R

@@ -231,9 +231,9 @@ test_that("a BCGW name works with filter", {
                                     xmax = 1696644.998, ymax = 1589145.873),
                                   crs = 3005))
 
-  expect_silent(ret <- bcdc_query_geodata("WHSE_IMAGERY_AND_BASE_MAPS.GSR_AIRPORTS_SVW") %>%
+  ret <- bcdc_query_geodata("WHSE_IMAGERY_AND_BASE_MAPS.GSR_AIRPORTS_SVW") %>%
     filter(WITHIN(little_box)) %>%
-    collect())
+    collect()
   expect_equal(nrow(ret), 367)
 })
 
@@ -274,7 +274,7 @@ test_that("Nesting functions inside a CQL geometry predicate works (#146)", {
     bcdc_query_geodata("local-and-regional-greenspaces") %>%
                  filter(DWITHIN(st_buffer(the_geom, 10000, nQuadSegs = 2), 100, "meters"))
     ),
-    "Unable to process query")
+    "Cannot translate")
 })
 
 test_that("works with dates", {

tests/testthat/test-query-geodata-select.R

@@ -51,9 +51,9 @@ test_that("select reduces the number of columns when a sticky ",{
 test_that("select works with BCGW name", {
   skip_on_cran()
   skip_if_net_down()
-  expect_silent(ret <- bcdc_query_geodata(bcgw_point_record) %>%
+  expect_s3_class(bcdc_query_geodata(bcgw_point_record) %>%
                   select(AIRPORT_NAME, DESCRIPTION) %>%
-                  collect())
+                  collect(), "sf")
 })
 
 

tests/testthat/test-utils.R

@@ -58,6 +58,7 @@ test_that("is_whse_object_name works", {
 test_that("bcdc_get_capabilities works", {
   skip_on_cran()
   skip_if_net_down()
+  skip_if_no_capabilities()
 
   old_get_caps <- ._bcdataenv_$get_capabilities_xml