From 2f197f5b9c05cccfb1eeeffc1bea756a3fa2af7b Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Wed, 31 Mar 2021 14:36:17 -0700 Subject: [PATCH 01/14] grab entire capabilities xml and store in pkg env --- R/zzz.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/zzz.R b/R/zzz.R index d72501f5..5f6df295 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -14,7 +14,7 @@ .onLoad <- function(...) { ._bcdataenv_$named_get_record_warned <- FALSE # nocov - ._bcdataenv_$bcdata_dl_limit <- bcdc_single_download_limit() # nocov + ._bcdataenv_$get_capabilities_xml <- bcdc_get_capabilities_xml() # nocov } From fdd4107d3aa12500989f57adf6ae9100fdff3559 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Wed, 31 Mar 2021 14:37:53 -0700 Subject: [PATCH 02/14] use xml to feed into accessor fns --- R/bcdc_options.R | 34 ++++++++++++++++++++++++++++------ R/utils-classes.R | 2 +- 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index a7130fcd..60a66277 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -18,7 +18,7 @@ #' failed calls to the data catalogue. Options in R are reset every time R is re-started. See examples for #' addition ways to restore your initial state. #' -#' `bcdata.max_geom_pred_size` is the maximum size of an object used for a geometric operation. Objects +#' `bcdata.max_geom_pred_size` is the maximum size in bytes of an object used for a geometric operation. Objects #' that are bigger than this value will have a bounding box drawn and apply the geometric operation #' on that simpler polygon. Users can try to increase the maximum geometric predicate size and see #' if the bcdata catalogue accepts their request. @@ -74,22 +74,21 @@ bcdc_options <- function() { "bcdata.chunk_limit", null_to_na(getOption("bcdata.chunk_limit")), 1000, "bcdata.single_download_limit", null_to_na(getOption("bcdata.single_download_limit", - default = ._bcdataenv_$bcdata_dl_limit)), 10000 + default = bcdc_single_download_limit())), 10000 ) } check_chunk_limit <- function(){ chunk_value <- getOption("bcdata.chunk_limit") - chunk_limit <- getOption("bcdata.single_download_limit", default = ._bcdataenv_$bcdata_dl_limit) + chunk_limit <- getOption("bcdata.single_download_limit", default = bcdc_single_download_limit()) if(!is.null(chunk_value) && chunk_value >= chunk_limit){ stop(glue::glue("Your chunk value of {chunk_value} exceed the BC Data Catalogue chunk limit of {chunk_limit}"), call. = FALSE) } } - -bcdc_single_download_limit <- function() { +bcdc_get_capabilities_xml <- function() { if (has_internet()) { url <- "http://openmaps.gov.bc.ca/geo/pub/ows?service=WFS&version=2.0.0&request=Getcapabilities" cli <- bcdata:::bcdc_http_client(url, auth = FALSE) @@ -101,8 +100,31 @@ bcdc_single_download_limit <- function() { )) res <- cc$parse("UTF-8") - doc <- xml2::read_xml(res) + xml2::read_xml(res) + + } else { + message("No access to internet") + invisible(FALSE) + } +} + +bcdc_get_capabilities <- function() { + doc <- ._bcdataenv_$get_capabilities_xml + + features <- xml2::xml_child(doc, 4) + feature_list <- xml2::as_list(features) + purrr::map_dfr(feature_list, ~ { + list(whse_name = .x$Name[[1]] %||% NA_character_, + title = .x$Title[[1]] %||% NA_character_, + cat_url = attr(.x$MetadataURL, "href") %||% NA_character_) + }) +} + + +bcdc_single_download_limit <- function() { + doc <- ._bcdataenv_$get_capabilities_xml + if (inherits(doc, "xml_document")) { constraints <- xml2::xml_find_all(doc, ".//ows:Constraint") count_defaults <- constraints[which(xml2::xml_attrs(constraints) %in% "CountDefault")] xml2::xml_double(count_defaults) diff --git a/R/utils-classes.R b/R/utils-classes.R index c93a259e..97fcb07c 100644 --- a/R/utils-classes.R +++ b/R/utils-classes.R @@ -379,7 +379,7 @@ collect.bcdc_promise <- function(x, ...){ ## Determine total number of records for pagination purposes number_of_records <- bcdc_number_wfs_records(query_list, cli) - if (number_of_records < getOption("bcdata.single_download_limit", default = ._bcdataenv_$bcdata_dl_limit)) { + if (number_of_records < getOption("bcdata.single_download_limit", default = bcdc_single_download_limit())) { cc <- tryCatch(cli$post(body = query_list, encode = "form"), error = function(e) { stop("There was an issue processing this request. From 514d01ecf7a1f3a2b03acc3339c51e1d89c09d38 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Wed, 31 Mar 2021 15:03:28 -0700 Subject: [PATCH 03/14] add column descriptions and test with describe feature --- R/describe-feature.R | 26 +++++++++++++++++++------- man/bcdc_describe_feature.Rd | 1 + man/bcdc_options.Rd | 2 +- tests/testthat/test-describe-feature.R | 6 +++--- 4 files changed, 24 insertions(+), 11 deletions(-) diff --git a/R/describe-feature.R b/R/describe-feature.R index af9d2301..38d748bc 100644 --- a/R/describe-feature.R +++ b/R/describe-feature.R @@ -22,6 +22,7 @@ #' - sticky: whether a column can be separated from the record in a Web Service call via the `dplyr::select` method #' - remote_col_type: class of what is return by the web feature service #' - local_col_type: the column class in R +#' - column_comments: additional metadata specific to that column #' #' @inheritParams bcdc_query_geodata #' @export @@ -53,7 +54,16 @@ bcdc_describe_feature.default <- function(record) { bcdc_describe_feature.character <- function(record){ if (is_whse_object_name(record)) { - return(feature_helper(record)) + bgc <- bcdc_get_capabilities() + cat_record <- bcdc_get_record(bgc$cat_url[grepl(record, bgc$whse_name)]) + + return( + dplyr::left_join( + feature_helper(record), + cat_record$details[,c("column_comments", "column_name")], + by = c("col_name" = "column_name") + ) + ) } bcdc_describe_feature(bcdc_get_record(record)) @@ -69,7 +79,13 @@ bcdc_describe_feature.bcdc_record <- function(record){ ) } - feature_helper(record$layer_name) + dplyr::left_join( + feature_helper(record$layer_name), + record$details[,c("column_comments", "column_name")], + by = c("col_name" = "column_name") + ) + + } parse_raw_feature_tbl <- function(query_list){ @@ -110,15 +126,11 @@ feature_helper <- function(whse_name){ xml_df <- parse_raw_feature_tbl(query_list) geom_type <- attr(xml_df, "geom_type") - ## Identify geometry column and move to last - # xml_df[xml_df$type == geom_type, "name"] <- "geometry" - # xml_df <- dplyr::bind_rows(xml_df[xml_df$name != "geometry",], - # xml_df[xml_df$name == "geometry",]) ## Fix logicals xml_df$nillable = ifelse(xml_df$nillable == "true", TRUE, FALSE) - xml_df <- xml_df[, c("name", "nillable", "type")] + ## Add the id_row back into the front xml_df <- dplyr::bind_rows(id_row, xml_df) colnames(xml_df) <- c("col_name", "sticky", "remote_col_type") diff --git a/man/bcdc_describe_feature.Rd b/man/bcdc_describe_feature.Rd index 46997b95..e89db7ce 100644 --- a/man/bcdc_describe_feature.Rd +++ b/man/bcdc_describe_feature.Rd @@ -26,6 +26,7 @@ The tibble returns the following columns: \item sticky: whether a column can be separated from the record in a Web Service call via the \code{dplyr::select} method \item remote_col_type: class of what is return by the web feature service \item local_col_type: the column class in R +\item column_comments: additional metadata specific to that column } } \description{ diff --git a/man/bcdc_options.Rd b/man/bcdc_options.Rd index 98f5e09f..5c1e58e4 100644 --- a/man/bcdc_options.Rd +++ b/man/bcdc_options.Rd @@ -14,7 +14,7 @@ failed calls to the data catalogue. Options in R are reset every time R is re-st addition ways to restore your initial state. } \details{ -\code{bcdata.max_geom_pred_size} is the maximum size of an object used for a geometric operation. Objects +\code{bcdata.max_geom_pred_size} is the maximum size in bytes of an object used for a geometric operation. Objects that are bigger than this value will have a bounding box drawn and apply the geometric operation on that simpler polygon. Users can try to increase the maximum geometric predicate size and see if the bcdata catalogue accepts their request. diff --git a/tests/testthat/test-describe-feature.R b/tests/testthat/test-describe-feature.R index 9cfb251d..70a4c3f1 100644 --- a/tests/testthat/test-describe-feature.R +++ b/tests/testthat/test-describe-feature.R @@ -16,7 +16,7 @@ test_that("Test that bcdc_describe feature returns the correct columns",{ skip_on_cran() skip_if_net_down() airport_feature <- bcdc_describe_feature("bc-airports") - expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type")) + expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type", "column_comments")) }) @@ -39,14 +39,14 @@ test_that("bcdc_describe_feature accepts a bcdc_record object", { skip_if_net_down() airports <- bcdc_get_record('76b1b7a3-2112-4444-857a-afccf7b20da8') airport_feature <- bcdc_describe_feature(airports) - expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type")) + expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type", "column_comments")) }) test_that("bcdc_describe_feature accepts BCGW name",{ skip_on_cran() skip_if_net_down() 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")) + expect_identical(names(airport_feature), c("col_name", "sticky", "remote_col_type","local_col_type", "column_comments")) }) test_that("bcdc_describe_feature fails on unsupported classes", { From 7c62700748911df5f05b23e9d9c43fd23a310ca0 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 1 Apr 2021 13:16:36 -0700 Subject: [PATCH 04/14] Update R/bcdc_options.R Co-authored-by: Andy Teucher --- R/bcdc_options.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index 60a66277..7876602a 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -125,9 +125,8 @@ bcdc_single_download_limit <- function() { doc <- ._bcdataenv_$get_capabilities_xml if (inherits(doc, "xml_document")) { - constraints <- xml2::xml_find_all(doc, ".//ows:Constraint") - count_defaults <- constraints[which(xml2::xml_attrs(constraints) %in% "CountDefault")] - xml2::xml_double(count_defaults) + count_defaults <- xml2::xml_find_first(doc, ".//ows:Constraint[@name='CountDefault']") + xml2::xml_integer(count_defaults) } else { message("No access to internet") 10000L From 264326790312fd4369bc0b81c632830092bbf9e2 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 1 Apr 2021 13:27:05 -0700 Subject: [PATCH 05/14] return a null and then check for it --- R/bcdc_options.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index 7876602a..a043f68e 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -104,7 +104,7 @@ bcdc_get_capabilities_xml <- function() { } else { message("No access to internet") - invisible(FALSE) + invisible(NULL) } } @@ -124,11 +124,12 @@ bcdc_get_capabilities <- function() { bcdc_single_download_limit <- function() { doc <- ._bcdataenv_$get_capabilities_xml - if (inherits(doc, "xml_document")) { - count_defaults <- xml2::xml_find_first(doc, ".//ows:Constraint[@name='CountDefault']") - xml2::xml_integer(count_defaults) - } else { + if(is.null(doc)) { message("No access to internet") - 10000L + return(10000L) } + + count_defaults <- xml2::xml_find_first(doc, ".//ows:Constraint[@name='CountDefault']") + xml2::xml_integer(count_defaults) + } From 4e4c7c70f4219a9d54035d6bcfd76c49370a5a41 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 1 Apr 2021 13:27:45 -0700 Subject: [PATCH 06/14] better name for the wfs records fn --- R/bcdc_options.R | 4 ++-- R/zzz.R | 2 +- tests/testthat/test-options.R | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index a043f68e..6a542f03 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -88,7 +88,7 @@ check_chunk_limit <- function(){ } } -bcdc_get_capabilities_xml <- function() { +bcdc_get_wfs_records_xml <- function() { if (has_internet()) { url <- "http://openmaps.gov.bc.ca/geo/pub/ows?service=WFS&version=2.0.0&request=Getcapabilities" cli <- bcdata:::bcdc_http_client(url, auth = FALSE) @@ -108,7 +108,7 @@ bcdc_get_capabilities_xml <- function() { } } -bcdc_get_capabilities <- function() { +bcdc_get_wfs_records <- function() { doc <- ._bcdataenv_$get_capabilities_xml features <- xml2::xml_child(doc, 4) diff --git a/R/zzz.R b/R/zzz.R index 5f6df295..e5d9a547 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -14,7 +14,7 @@ .onLoad <- function(...) { ._bcdataenv_$named_get_record_warned <- FALSE # nocov - ._bcdataenv_$get_capabilities_xml <- bcdc_get_capabilities_xml() # nocov + ._bcdataenv_$get_capabilities_xml <- bcdc_get_wfs_records_xml() # nocov } diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index e6d9c9fd..2770dc14 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -34,7 +34,7 @@ test_that("bcdata.single_download_limit", { }) -test_that("bcdata.single_download_limit can be changes",{ +test_that("bcdata.single_download_limit can be changed",{ withr::local_options(list(bcdata.single_download_limit = 13)) expect_equal(getOption("bcdata.single_download_limit"), 13) }) From 78601735cc0c852d80c35a42ad3d568964bc9f44 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 1 Apr 2021 13:28:52 -0700 Subject: [PATCH 07/14] one added fn name change --- R/describe-feature.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/describe-feature.R b/R/describe-feature.R index 38d748bc..6ff118f3 100644 --- a/R/describe-feature.R +++ b/R/describe-feature.R @@ -54,7 +54,7 @@ bcdc_describe_feature.default <- function(record) { bcdc_describe_feature.character <- function(record){ if (is_whse_object_name(record)) { - bgc <- bcdc_get_capabilities() + bgc <- bcdc_get_wfs_records() cat_record <- bcdc_get_record(bgc$cat_url[grepl(record, bgc$whse_name)]) return( From 24635e3d0370ca28e5299af1e6375ed84df7afa8 Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 1 Apr 2021 13:34:55 -0700 Subject: [PATCH 08/14] abstract out joining fn --- R/describe-feature.R | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) diff --git a/R/describe-feature.R b/R/describe-feature.R index 6ff118f3..3863a302 100644 --- a/R/describe-feature.R +++ b/R/describe-feature.R @@ -56,14 +56,7 @@ bcdc_describe_feature.character <- function(record){ if (is_whse_object_name(record)) { bgc <- bcdc_get_wfs_records() cat_record <- bcdc_get_record(bgc$cat_url[grepl(record, bgc$whse_name)]) - - return( - dplyr::left_join( - feature_helper(record), - cat_record$details[,c("column_comments", "column_name")], - by = c("col_name" = "column_name") - ) - ) + return(obj_desc_join(record, cat_record$details)) } bcdc_describe_feature(bcdc_get_record(record)) @@ -78,13 +71,7 @@ bcdc_describe_feature.bcdc_record <- function(record){ call. = FALSE ) } - - dplyr::left_join( - feature_helper(record$layer_name), - record$details[,c("column_comments", "column_name")], - by = c("col_name" = "column_name") - ) - + obj_desc_join(record$layer_name, record$details) } @@ -141,4 +128,10 @@ feature_helper <- function(whse_name){ - +obj_desc_join <- function(x, y) { + dplyr::left_join( + feature_helper(x), + y[,c("column_comments", "column_name")], + by = c("col_name" = "column_name") + ) +} From 1e73fbc43531455aa848c605046ce14eb368a65a Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 1 Apr 2021 13:39:16 -0700 Subject: [PATCH 09/14] update NEWS --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 0b9357a1..7c2df175 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,9 @@ # bcdata 0.2.2.9000 ### IMPROVEMENTS - Setting the `bcdata.single_download_limit` limit dynamically from the getCapabilities endpoint. +- `bcdc_describe_feature` now joins a object description column to the returned object to provide more information about a field +directly in R. #241 + # bcdata 0.2.2 ### IMPROVEMENTS From dc2654c4da671451034f7bbeb60e983c8b138dfa Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 1 Apr 2021 14:50:04 -0700 Subject: [PATCH 10/14] Better xml parsing --- R/bcdc_options.R | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index 6a542f03..ed694f9f 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -91,7 +91,7 @@ check_chunk_limit <- function(){ bcdc_get_wfs_records_xml <- function() { if (has_internet()) { url <- "http://openmaps.gov.bc.ca/geo/pub/ows?service=WFS&version=2.0.0&request=Getcapabilities" - cli <- bcdata:::bcdc_http_client(url, auth = FALSE) + cli <- bcdc_http_client(url, auth = FALSE) cc <- cli$get(query = list( SERVICE = "WFS", @@ -111,25 +111,26 @@ bcdc_get_wfs_records_xml <- function() { bcdc_get_wfs_records <- function() { doc <- ._bcdataenv_$get_capabilities_xml - features <- xml2::xml_child(doc, 4) - feature_list <- xml2::as_list(features) - purrr::map_dfr(feature_list, ~ { - list(whse_name = .x$Name[[1]] %||% NA_character_, - title = .x$Title[[1]] %||% NA_character_, - cat_url = attr(.x$MetadataURL, "href") %||% NA_character_) - }) -} + # d1 is the default xml namespace (see xml2::xml_ns(doc)) + features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType") + tibble::tibble( + whse_name = xml2::xml_text(xml2::xml_find_first(features, "./d1:Name")), + title = xml2::xml_text(xml2::xml_find_first(features, "./d1:Title")), + cat_url = xml2::xml_attr(xml2::xml_find_first(features, "./d1:MetadataURL"), "href") + ) +} bcdc_single_download_limit <- function() { doc <- ._bcdataenv_$get_capabilities_xml - if(is.null(doc)) { + if (is.null(doc)) { message("No access to internet") return(10000L) } - count_defaults <- xml2::xml_find_first(doc, ".//ows:Constraint[@name='CountDefault']") + count_default_xpath <- "./ows:OperationsMetadata/ows:Operation[@name='GetFeature']/ows:Constraint[@name='CountDefault']" + # Looking globally also works but is slower: ".//ows:Constraint[@name='CountDefault']" + count_defaults <- xml2::xml_find_first(doc, count_default_xpath) xml2::xml_integer(count_defaults) - } From e78b3795f6b7fd915f7c7cd8834649248b462b84 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 1 Apr 2021 14:50:26 -0700 Subject: [PATCH 11/14] bcdc_single_download_limit returns integer not double --- tests/testthat/test-options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 2770dc14..7826ae7c 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -43,5 +43,5 @@ test_that("bcdc_single_download_limit returns a number",{ skip_on_cran() skip_if_net_down() lt <- bcdc_single_download_limit() - expect_type(lt, "double") + expect_type(lt, "integer") }) From e5da44508ad1e7720935b4a78a65d27dc1dede9e Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 1 Apr 2021 16:00:17 -0700 Subject: [PATCH 12/14] bcdc_get_wfs_records deal with NULL xml --- R/bcdc_options.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index ed694f9f..c8b283f1 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -111,6 +111,12 @@ bcdc_get_wfs_records_xml <- function() { bcdc_get_wfs_records <- function() { doc <- ._bcdataenv_$get_capabilities_xml + if (is.null(doc)) { + # Try again to get the xml + doc <- ._bcdataenv_$get_capabilities_xml <- suppressMessages(bcdc_get_wfs_records_xml()) + if (is.null(doc)) stop("No access to internet", call. = FALSE) + } + # d1 is the default xml namespace (see xml2::xml_ns(doc)) features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType") From 0aa2a833a56da33b4f306e680200521996a50b58 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 1 Apr 2021 16:03:02 -0700 Subject: [PATCH 13/14] Remove 'pub:' prefix from whse name --- R/bcdc_options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/bcdc_options.R b/R/bcdc_options.R index c8b283f1..ebf8b496 100644 --- a/R/bcdc_options.R +++ b/R/bcdc_options.R @@ -121,7 +121,7 @@ bcdc_get_wfs_records <- function() { features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType") tibble::tibble( - whse_name = xml2::xml_text(xml2::xml_find_first(features, "./d1:Name")), + whse_name = gsub("^pub:", "", xml2::xml_text(xml2::xml_find_first(features, "./d1:Name"))), title = xml2::xml_text(xml2::xml_find_first(features, "./d1:Title")), cat_url = xml2::xml_attr(xml2::xml_find_first(features, "./d1:MetadataURL"), "href") ) From 33eda68a5f5507e12b472fa77c70aaacbb829cbd Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 1 Apr 2021 16:22:11 -0700 Subject: [PATCH 14/14] test bcdc_get_wfs_records --- tests/testthat/test-describe-feature.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test-describe-feature.R b/tests/testthat/test-describe-feature.R index 70a4c3f1..0cb4a3bd 100644 --- a/tests/testthat/test-describe-feature.R +++ b/tests/testthat/test-describe-feature.R @@ -63,3 +63,15 @@ test_that("bcdc_describe_feature fails with non-wfs record", { "No WMS/WFS resource available for this data set") }) +test_that("bcdc_get_wfs_records works", { + skip_if_net_down() + skip_on_cran() + + wfs_records <- bcdc_get_wfs_records() + + expect_equal(names(wfs_records), c("whse_name", "title", "cat_url")) + expect_true(nrow(wfs_records) > 0L) + lapply(wfs_records, function(x) { + expect_true(any(nzchar(x, keepNA = TRUE)) & any(!is.na(x))) + }) +})