Enable multiple filters to be supplied by using get_resource_sql

R/get_resource.R

@@ -40,12 +40,39 @@ get_resource <- function(res_id,
   # check res_id
   check_res_id(res_id)
 
+  parsed_col_select <- parse_col_select(col_select)
+  parsed_row_filters <- parse_row_filters(row_filters)
+
+  if (is.logical(parsed_row_filters) && !parsed_row_filters) {
+    if (!is.null(row_filters)) {
+      col_select_sql <- paste0("\"", paste(col_select, collapse = "\",\""), "\"")
+
+      row_filters_sql <- paste(
+        purrr::imap_chr(
+          row_filters,
+          function(value, col) paste0("\"", col, "\"=\'", value, "\'", collapse = " OR ")
+        ),
+        collapse = ") AND ("
+      )
+
+      sql <- sprintf(
+        "SELECT %s FROM \"%s\" WHERE (%s) %s",
+        col_select_sql,
+        res_id,
+        row_filters_sql,
+        dplyr::if_else(is.null(rows), "", paste("LIMIT", rows))
+      )
+
+      return(get_resource_sql(sql))
+    }
+  }
+
   # define query
   query <- list(
     id = res_id,
     limit = rows,
-    q = parse_row_filters(row_filters),
-    fields = parse_col_select(col_select)
+    q = parsed_row_filters,
+    fields = parsed_col_select
   )
 
   # if dump should be used, use it

R/parse_row_filters.R

@@ -4,7 +4,7 @@
 #' @return a json as a character string
 #' @keywords internal
 #' @noRd
-parse_row_filters <- function(row_filters) {
+parse_row_filters <- function(row_filters, call = rlang::caller_env()) {
   # exit function if no filters
   if (is.null(row_filters)) {
     return(NULL)
@@ -14,42 +14,45 @@ parse_row_filters <- function(row_filters) {
   if (class(row_filters) != "list" && !is.character(row_filters) && !is.numeric(row_filters)) {
     cli::cli_abort(
       "{.arg row_filters} must be a named {.cls list} or a named
-      {.cls character} or {.cls numeric} vector, not a {.cls {class(row_filters)}}."
+      {.cls character} or {.cls numeric} vector, not a {.cls {class(row_filters)}}.",
+      call = call
     )
   }
 
   # Ensure it's elements are named
   if (is.null(names(row_filters)) || any(names(row_filters) == "")) {
-    cli::cli_abort("{.arg row_filters} should be a named {.cls list}.")
+    cli::cli_abort(
+      "{.arg row_filters} should be a named {.cls list}.",
+      call = call
+    )
   }
 
-  # check if any filters in list have length > 1
-  too_many <- purrr::map_lgl(row_filters, ~ length(.x) > 1)
-
-  if (any(too_many)) {
-    cli::cli_abort(c(
-      "Invalid input for {.arg row_filters}",
-      i = "The {.val {names(row_filters)[which(too_many)]}} filter{?s} {?has/have} too many values.",
-      x = "The {.arg row_filters} list must only contain vectors of length 1."
-    ))
-  }
 
   # check if any items in the list/vector are duplicates
   duplicates <- duplicated(names(row_filters))
   if (any(duplicates)) {
-    cli::cli_abort(c(
-      "Invalid input for {.arg row_filters}",
-      x = "The {.val {names(row_filters)[which(duplicates)]}} filter{?s} {?is/are} duplicated.",
-      i = "Only one filter per field is currently supported by {.fun get_resource}."
-    ))
+    cli::cli_abort(
+      c(
+        "Invalid input for {.arg row_filters}",
+        x = "The {.val {names(row_filters)[which(duplicates)]}} filter{?s} {?is/are} duplicated.",
+        i = "Only one filter per field is currently supported by {.fun get_resource}."
+      ),
+      call = call
+    )
+  }
+
+  # check if any filters in list have length > 1
+  multiple <- purrr::map_lgl(row_filters, ~ length(.x) > 1)
+
+  if (any(multiple)) {
+    cli::cli_alert_info("Multiple filters were supplied, defaulting to SQL.")
+    return(FALSE)
   }
 
   filter_body <- paste0(
     '"', names(row_filters), '":"', row_filters, '"',
     collapse = ","
   )
 
-  return(
-    paste0("{", filter_body, "}")
-  )
+  return(paste0("{", filter_body, "}"))
 }

tests/testthat/test-get_resource.R

@@ -30,3 +30,35 @@ test_that("returns data with row specifications", {
   expect_equal(nrow(get_resource(res_id = gp_list_apr_2021, rows = 999)), 926) %>%
     expect_warning()
 })
+
+test_that("returns data for multiple filters", {
+  expect_message(
+    data_row_limit <- get_resource(
+      res_id = "e4985a62-9d59-4e71-8800-3f7ca29ffe0c",
+      col_select = c("GPPractice", "DMDCode"),
+      row_filters = list("GPPractice" = c("80005", "80202")),
+      rows = 100
+    )
+  )
+
+  expect_s3_class(data_row_limit, "tbl_df")
+  expect_equal(nrow(data_row_limit), 100)
+  expect_named(data_row_limit, c("GPPractice", "DMDCode"))
+
+  expect_message(
+    data_full <- get_resource(
+      res_id = "e4985a62-9d59-4e71-8800-3f7ca29ffe0c",
+      col_select = c("GPPractice", "DMDCode", "PrescribedType"),
+      row_filters = list(
+        "GPPractice" = c("80005", "80202"),
+        "PrescribedType" = "AMP"
+      )
+    )
+  )
+
+  expect_s3_class(data_full, "tbl_df")
+  expect_equal(nrow(data_full), 1108)
+  expect_named(data_full, c("GPPractice", "DMDCode", "PrescribedType"))
+  expect_length(unique(data_full$GPPractice), 2)
+  expect_length(unique(data_full$PrescribedType), 1)
+})

tests/testthat/test-parse_row_filters.R

@@ -23,11 +23,13 @@ test_that("throws error for bad types", {
   )
 })
 
-test_that("throws error for length > 1", {
-  expect_error(
+test_that("returns FALSE for length > 1", {
+  expect_false(
     parse_row_filters(list(x = letters)),
-    regexp = " has too many values\\."
-  )
+  ) %>%
+    expect_message(
+      "Multiple filters were supplied, defaulting to SQL"
+    )
 })
 
 test_that("throws error when un-named", {