Fix malformed CQL from spatial filters

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

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

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")
 }
 

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(

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
+      <SQL> (INTERSECTS(GEOMETRY, POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0))))
+
+---
+
+    Code
+      cql(filter(filter(promise, INTERSECTS(bbox)), BGC_LABEL != "ZZZ"))
+    Output
+      <SQL> ((INTERSECTS(GEOMETRY, POLYGON ((0 0, 1 0, 1 1, 0 1, 0 0)))) AND ("BGC_LABEL" != 'ZZZ'))
+

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)