Merge pull request #57 from Public-Health-Scotland/bug/sex_all_filter

Workaround for #15
Public-Health-Scotland · Jan 23, 2025 · 016aeed · 016aeed
2 parents 777876c + de0a65a
commit 016aeed
Show file tree

Hide file tree

Showing 4 changed files with 57 additions and 12 deletions.
diff --git a/R/get_resource_sql.R b/R/get_resource_sql.R
@@ -91,11 +91,6 @@ get_resource_sql <- function(sql) {
     )
   }
 
-  # get correct order of columns
-  order <- purrr::map_chr(
-    content$result$fields,
-    ~ .x$id
-  )
 
   # extract the records (rows) from content
   data <- purrr::map_dfr(
@@ -109,19 +104,27 @@ get_resource_sql <- function(sql) {
     }
   )
 
+  # If the query returned no rows, exit now.
+  if (nrow(data) == 0L) {
+    return(data)
+  }
+
+  # get correct order of columns
+  order <- purrr::map_chr(
+    content$result$fields,
+    ~ .x$id
+  )
+  order <- order[!order %in% c("_id", "_full_text")]
+
   # select and reorder columns to reflect
-  cleaner <- data %>%
-    dplyr::select(
-      dplyr::all_of(order),
-      -dplyr::matches("_id"), -dplyr::matches("_full_text")
-    )
+  cleaner <- dplyr::select(data, dplyr::all_of(order))
 
   # warn if limit may have been surpassed
-  if (nrow(cleaner) == 32000) {
+  if (nrow(cleaner) == 32000L) {
     cli::cli_warn(c(
       "Row number limit",
       i = "SQL queries are limitted to returning 32,000 results.
-      This may have effected the results of your query."
+      This may have affected the results of your query."
     ))
   }
 

diff --git a/R/parse_row_filters.R b/R/parse_row_filters.R
@@ -41,6 +41,12 @@ parse_row_filters <- function(row_filters, call = rlang::caller_env()) {
     )
   }
 
+  # Check if Sex = All was specified
+  # There is a bug on CKAN which makes this not work, unless we use the SQL endpoint
+  if ("Sex" %in% names(row_filters) && "All" %in% row_filters[["Sex"]]) {
+    return(FALSE)
+  }
+
   # check if any filters in list have length > 1
   multiple <- purrr::map_lgl(row_filters, ~ length(.x) > 1)
 

diff --git a/tests/testthat/test-get_resource.R b/tests/testthat/test-get_resource.R
@@ -124,3 +124,22 @@ test_that("errors on invalid filters", {
     regexp = "col_select: invalid value"
   )
 })
+
+test_that("We can filter data with `Sex = 'All'`", {
+  pops <- get_resource(
+    res_id = "27a72cc8-d6d8-430c-8b4f-3109a9ceadb1",
+    row_filters = list("Sex" = "All"),
+    col_select = c("Year", "HB", "AllAges", "Sex")
+  )
+
+  expect_s3_class(pops, "tbl_df")
+  expect_equal(nrow(pops), 645)
+  expect_named(pops, c(
+    "Year",
+    "HB",
+    "AllAges",
+    "Sex"
+  ))
+  expect_length(unique(pops$HB), 15)
+  expect_setequal(pops$Sex, "All")
+})
diff --git a/tests/testthat/test-parse_row_filters.R b/tests/testthat/test-parse_row_filters.R
@@ -29,6 +29,23 @@ test_that("returns FALSE for length > 1", {
   )
 })
 
+test_that("returns FALSE if `Sex = 'All'` is given", {
+  expect_false(
+    parse_row_filters(list("Sex" = "All"))
+  )
+
+  expect_false(
+    parse_row_filters(list("Sex" = c("Male", "All")))
+  )
+
+  expect_false(
+    parse_row_filters(list(
+      "Sex" = "All",
+      "HBT" = "S1234"
+    ))
+  )
+})
+
 test_that("throws error when un-named", {
   expect_error(
     parse_row_filters(list(1, 2)),