From ca10de5c5abea421a9c7b9641c570e175546c5b0 Mon Sep 17 00:00:00 2001 From: James McMahon Date: Thu, 28 Nov 2024 10:14:18 +0000 Subject: [PATCH 1/2] Use `get_resource_sql` to deal with multiple filters --- R/get_resource.R | 31 +++++++++++++++++++++++++++-- R/parse_row_filters.R | 45 +++++++++++++++++++++++-------------------- 2 files changed, 53 insertions(+), 23 deletions(-) diff --git a/R/get_resource.R b/R/get_resource.R index 743039b..bd6a353 100644 --- a/R/get_resource.R +++ b/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 diff --git a/R/parse_row_filters.R b/R/parse_row_filters.R index 4144d3c..fcd5f71 100644 --- a/R/parse_row_filters.R +++ b/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,34 +14,39 @@ 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( @@ -49,7 +54,5 @@ parse_row_filters <- function(row_filters) { collapse = "," ) - return( - paste0("{", filter_body, "}") - ) + return(paste0("{", filter_body, "}")) } From aa6073b4ae45644838ef49fb5b8f1e976706bb58 Mon Sep 17 00:00:00 2001 From: James McMahon Date: Thu, 28 Nov 2024 10:14:39 +0000 Subject: [PATCH 2/2] Add and update tests --- tests/testthat/test-get_resource.R | 32 +++++++++++++++++++++++++ tests/testthat/test-parse_row_filters.R | 10 ++++---- 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-get_resource.R b/tests/testthat/test-get_resource.R index 128a0ce..cb3f5bd 100644 --- a/tests/testthat/test-get_resource.R +++ b/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) +}) diff --git a/tests/testthat/test-parse_row_filters.R b/tests/testthat/test-parse_row_filters.R index 90558d5..64ba3d5 100644 --- a/tests/testthat/test-parse_row_filters.R +++ b/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", {