Improve get_resource_sql

R/get_resource_sql.R

@@ -25,7 +25,8 @@
 #'
 #' ```sql = "SELECT * FROM \"<res_id>\" 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,

tests/testthat/test-get_resource_sql.R

@@ -4,38 +4,53 @@ test_that("throws errors on invalid sql argument", {
   # wrong class
   expect_error(
     get_resource_sql(9000),
-    regexp = "You entered an object of class <numeric>"
+    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
        \"bcc860a4-49f4-4232-a76b-f559cf6eb885\"
      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", {