diff --git a/R/get_resource_sql.R b/R/get_resource_sql.R index 0df6ba0..79c76bf 100644 --- a/R/get_resource_sql.R +++ b/R/get_resource_sql.R @@ -25,7 +25,8 @@ #' #' ```sql = "SELECT * FROM \"\" WHERE \"Age\" = '34'"```. #' -#' @seealso [get_resource()] for downloading a resource without using a SQL query. +#' @seealso [get_resource()] for downloading a resource without using a +#' SQL query. #' #' @return a [tibble][tibble::tibble-package] with the query results. #' Only 32,000 rows can be returned from a single SQL query. @@ -55,40 +56,41 @@ #' row_filters = row_filter #' ) get_resource_sql <- function(sql) { - if (length(sql) > 1) { + if (length(sql) != 1) { cli::cli_abort(c( - "SQL validation error.", - i = "{.var sql} must be of length 1", - x = "You entered an object of length {length(sql)}." + x = "SQL validation error.", + i = "{.var sql} must be length 1 not {length(sql)}." )) } - if (!("character" %in% class(sql))) { + if (!inherits(sql, "character")) { cli::cli_abort(c( - "SQL validation error.", - i = "{.var sql} must be of class {.cls character}", - x = "You entered an object of class {.cls {class(sql)[1]}}." + x = "SQL validation error.", + i = "{.var sql} must be of class {.cls character} not {.cls {class(sql)}}." )) } - # remove spaces - sql <- gsub(" ", "", sql) - sql <- gsub("\n", "", sql) - # check query is a SELECT statement - if (substr(sql, 1, 6) != "SELECT") { + if (!grepl("^\\s*?SELECT", sql)) { cli::cli_abort(c( - "SQL validation error.", - i = "{.var sql} must start with SELECT" + x = "SQL validation error.", + i = "{.var sql} must start with {.val SELECT}" )) } - # add query field prefix + # Add the SQL statement to the query query <- list("sql" = sql) # attempt get request content <- phs_GET("datastore_search_sql", query) + if (!is.null(content[["result"]][["records_truncated"]])) { + cli::cli_warn( + "The data was truncated because your query matched more than the + maximum number of rows." + ) + } + # get correct order of columns order <- purrr::map_chr( content$result$fields, diff --git a/man/get_resource_sql.Rd b/man/get_resource_sql.Rd index 4f2d4cd..a0d16ee 100644 --- a/man/get_resource_sql.Rd +++ b/man/get_resource_sql.Rd @@ -59,5 +59,6 @@ df2 <- get_resource( ) } \seealso{ -\code{\link[=get_resource]{get_resource()}} for downloading a resource without using a SQL query. +\code{\link[=get_resource]{get_resource()}} for downloading a resource without using a +SQL query. } diff --git a/tests/testthat/test-get_resource_sql.R b/tests/testthat/test-get_resource_sql.R index 734ab60..8c02002 100644 --- a/tests/testthat/test-get_resource_sql.R +++ b/tests/testthat/test-get_resource_sql.R @@ -4,24 +4,25 @@ test_that("throws errors on invalid sql argument", { # wrong class expect_error( get_resource_sql(9000), - regexp = "You entered an object of class " + regexp = "must be of class" ) # wrong length expect_error( get_resource_sql(letters), - regexp = "You entered an object of length 26." + regexp = "must be length 1 not 26\\." ) # wrong start expect_error( get_resource_sql("this is wrong"), - regexp = "`sql` must start with SELECT" + regexp = "`sql` must start with" ) }) -test_that("gets expected data", { - sql <- " +test_that("gets expected data for a simple SQL query", { + data <- get_resource_sql( + sql = " SELECT \"TotalCancelled\",\"TotalOperations\",\"Hospital\",\"Month\" FROM @@ -29,13 +30,27 @@ test_that("gets expected data", { WHERE \"Hospital\" = 'D102H' " - df <- get_resource_sql(sql) + ) + + expect_s3_class(data, "tbl") + expect_equal(unique(data$Hospital), "D102H") + expect_named(data, c("TotalCancelled", "TotalOperations", "Hospital", "Month")) +}) - expect_equal(unique(df$Hospital), "D102H") - expect_equal( - c("TotalCancelled", "TotalOperations", "Hospital", "Month"), - names(df) +test_that("gets expected data for a joined SQL query", { + data <- get_resource_sql( + sql = paste( + "SELECT pops.\"Year\", pops.\"HB\", lookup.\"HBName\", pops.\"AllAges\"", + "FROM \"27a72cc8-d6d8-430c-8b4f-3109a9ceadb1\" AS pops", + "JOIN \"652ff726-e676-4a20-abda-435b98dd7bdc\" AS lookup", + "ON pops.\"HB\" = lookup.\"HB\"", + "WHERE pops.\"Sex\" = 'All' AND pops.\"Year\" > 2006" + ) ) + + expect_s3_class(data, "tbl") + expect_gt(min(as.integer(data$Year)), 2006L) + expect_named(data, c("Year", "HB", "HBName", "AllAges")) }) test_that("SQL errors", {