diff --git a/DESCRIPTION b/DESCRIPTION index c5d614f9..1520705c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -60,7 +60,6 @@ VignetteBuilder: knitr Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.3 Collate: 'bcdata-package.R' 'bcdc-get-citation.R' @@ -86,3 +85,4 @@ Collate: 'zzz.R' Config/testthat/edition: 3 Config/testthat/parallel: true +Config/roxygen2/version: 8.0.0 diff --git a/NEWS.md b/NEWS.md index 86bb1a41..45b3f281 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # bcdata (development version) +* Fixed a bug where `filter()` calls using CQL geometry predicates (such as + `INTERSECTS()`) produced malformed CQL that the server rejected with an HTTP + 400 error. The CQL leaked a spurious `TRUE AS "drop_null"` clause and extra + parentheses following the removal of `c.sql()` in dbplyr 2.6.0 (#368). + # bcdata 0.5.2 * Removed dependency on `leaflet.extras`, using `leaflet::addControl()` instead diff --git a/R/bcdc_search.R b/R/bcdc_search.R index 3341ec7b..de83eb50 100644 --- a/R/bcdc_search.R +++ b/R/bcdc_search.R @@ -39,7 +39,9 @@ bcdc_search_facets <- function( "groups" ) ) { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov facet <- match.arg(facet, several.ok = TRUE) query <- paste0("\"", facet, "\"", collapse = ",") @@ -72,7 +74,7 @@ bcdc_search_facets <- function( } #' @export -#' @describeIn bcdc_list_group_records +#' @describeIn bcdc_list_group_records List the available groups in the B.C. Data Catalogue. #' bcdc_list_groups <- function() bcdc_search_facets("groups") @@ -91,7 +93,9 @@ bcdc_list_groups <- function() bcdc_search_facets("groups") #' } bcdc_list_group_records <- function(group) { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov cli <- bcdc_catalogue_client("action/group_package_show") @@ -116,7 +120,7 @@ bcdc_list_group_records <- function(group) { } #' @export -#' @describeIn bcdc_list_organization_records +#' @describeIn bcdc_list_organization_records List the available organizations in the B.C. Data Catalogue. #' bcdc_list_organizations <- function() bcdc_search_facets("organization") @@ -135,7 +139,9 @@ bcdc_list_organizations <- function() bcdc_search_facets("organization") #' } bcdc_list_organization_records <- function(organization) { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov option_package_limit <- getOption("bcdata.max_package_search_limit", 1000) @@ -175,7 +181,9 @@ bcdc_list_organization_records <- function(organization) { #' ) #' } bcdc_list <- function() { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov l_new_ret <- 1 ret <- character() @@ -240,7 +248,9 @@ bcdc_search <- function( groups = NULL, n = 100 ) { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov # TODO: allow terms to be passed as a vector, and allow use of | for OR terms <- process_search_terms(...) @@ -345,7 +355,9 @@ bcdc_search <- function( #' ) #' } bcdc_get_record <- function(id) { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov id <- slug_from_url(id) @@ -443,7 +455,9 @@ as.bcdc_organization <- function(x, description) { #' #' @export bcdc_tidy_resources <- function(record) { - if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov + if (!has_internet()) { + stop("No access to internet", call. = FALSE) + } # nocov UseMethod("bcdc_tidy_resources") } diff --git a/R/utils-classes.R b/R/utils-classes.R index f873d54a..9fafc6c8 100644 --- a/R/utils-classes.R +++ b/R/utils-classes.R @@ -328,13 +328,10 @@ filter.bcdc_promise <- function(.data, ...) { ## Change CQL query on the fly if geom is not GEOMETRY current_cql = specify_geom_name(.data$cols_df, current_cql) - # Add cql filter statement to any existing cql filter statements. - # ensure .data$query_list$CQL_FILTER is class sql even if NULL, so - # dispatches on sql class and dbplyr::c.sql method is used - .data$query_list$CQL_FILTER <- c( - dbplyr::sql(.data$query_list$CQL_FILTER), - current_cql, - drop_null = TRUE + # Append the new clause to any existing CQL filter. + .data$query_list$CQL_FILTER <- dbplyr::sql( + .data$query_list$CQL_FILTER, + current_cql ) as.bcdc_promise(list( diff --git a/man/bcdata-package.Rd b/man/bcdata-package.Rd index f68e87c5..17629502 100644 --- a/man/bcdata-package.Rd +++ b/man/bcdata-package.Rd @@ -25,6 +25,7 @@ Useful links: Authors: \itemize{ + \item Andy Teucher \email{andy.teucher@gmail.com} (\href{https://orcid.org/0000-0002-7840-692X}{ORCID}) \item Sam Albers \email{sam.albers@gmail.com} (\href{https://orcid.org/0000-0002-9270-7884}{ORCID}) [contributor] \item Stephanie Hazlitt \email{stephhazlitt@gmail.com} (\href{https://orcid.org/0000-0002-3161-2304}{ORCID}) [contributor] } diff --git a/man/bcdc_list_group_records.Rd b/man/bcdc_list_group_records.Rd index 8ae8e8e7..02f32901 100644 --- a/man/bcdc_list_group_records.Rd +++ b/man/bcdc_list_group_records.Rd @@ -18,7 +18,7 @@ https://catalogue.data.gov.bc.ca/group or accessed directly from R using \code{b } \section{Functions}{ \itemize{ -\item \code{bcdc_list_groups()}: +\item \code{bcdc_list_groups()}: List the available groups in the B.C. Data Catalogue. }} \examples{ diff --git a/man/bcdc_list_organization_records.Rd b/man/bcdc_list_organization_records.Rd index 3dd8ab38..04fe1279 100644 --- a/man/bcdc_list_organization_records.Rd +++ b/man/bcdc_list_organization_records.Rd @@ -18,7 +18,7 @@ https://catalogue.data.gov.bc.ca/organizations or accessed directly from R using } \section{Functions}{ \itemize{ -\item \code{bcdc_list_organizations()}: +\item \code{bcdc_list_organizations()}: List the available organizations in the B.C. Data Catalogue. }} \examples{ diff --git a/tests/testthat/_snaps/query-geodata-filter.md b/tests/testthat/_snaps/query-geodata-filter.md new file mode 100644 index 00000000..1fec1e76 --- /dev/null +++ b/tests/testthat/_snaps/query-geodata-filter.md @@ -0,0 +1,14 @@ +# filter() builds clean CQL without a drop_null artifact (#368) + + Code + cql(filter(promise, INTERSECTS(bbox))) + Output + (INTERSECTS(GEOMETRY, POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)))) + +--- + + Code + cql(filter(filter(promise, INTERSECTS(bbox)), BGC_LABEL != "ZZZ")) + Output + ((INTERSECTS(GEOMETRY, POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)))) AND ("BGC_LABEL" != 'ZZZ')) + diff --git a/tests/testthat/test-query-geodata-filter.R b/tests/testthat/test-query-geodata-filter.R index 1f57aeeb..66480090 100644 --- a/tests/testthat/test-query-geodata-filter.R +++ b/tests/testthat/test-query-geodata-filter.R @@ -173,6 +173,38 @@ test_that("Different combinations of predicates work", { ) }) +test_that("filter() builds clean CQL without a drop_null artifact (#368)", { + # Exercises the CQL append path in filter.bcdc_promise offline. A minimal + # promise is sufficient because filter() only consults cols_df and query_list. + # The snapshots let us confirm at a glance that a single predicate is wrapped + # in exactly one set of parentheses and that no TRUE AS "drop_null" leaks in. + cols_df <- data.frame( + col_name = c("GEOMETRY", "BGC_LABEL"), + remote_col_type = c("gml:GeometryPropertyType", "xsd:string"), + stringsAsFactors = FALSE + ) + promise <- as.bcdc_promise(list( + query_list = list(typeNames = "test", CQL_FILTER = NULL), + cli = NULL, + record = NULL, + cols_df = cols_df + )) + + bbox <- st_as_sfc(st_bbox( + c(xmin = 0, ymin = 0, xmax = 1, ymax = 1), + crs = 3005 + )) + cql <- function(p) finalize_cql(p$query_list$CQL_FILTER) + + # A single spatial clause. + expect_snapshot(cql(filter(promise, INTERSECTS(bbox)))) + + # A chained second clause AND-joined onto the first. + expect_snapshot( + cql(filter(filter(promise, INTERSECTS(bbox)), BGC_LABEL != "ZZZ")) + ) +}) + test_that("subsetting works locally", { x <- c("a", "b") y <- data.frame(id = x, stringsAsFactors = FALSE)