Merge pull request #53 from Public-Health-Scotland/feature/improve_er…

…ror_messages

Use `rlang::caller_env()` so that errors report more sensibly

R/check_dataset_name.R

@@ -6,27 +6,33 @@
 #' @param dataset_name a resource ID
 #' @keywords internal
 #' @noRd
-check_dataset_name <- function(dataset_name) {
+check_dataset_name <- function(dataset_name, call = rlang::caller_env()) {
   # Starts and ends in a lowercase letter or number
   # Has only lowercase alphanum or hyphens inbetween
   dataset_name_regex <- "^[a-z0-9][a-z0-9\\-]+?[a-z0-9]$"
 
   if (!inherits(dataset_name, "character")) {
-    cli::cli_abort(c(
-      "The dataset name supplied {.var {dataset_name}} is invalid.",
-      "x" = "dataset_name must be of type character.",
-      "i" = "You supplied a {.cls {class(dataset_name)[0]}} value."
-    ))
+    cli::cli_abort(
+      c(
+        "The dataset name supplied {.var {dataset_name}} is invalid.",
+        "x" = "dataset_name must be of type character.",
+        "i" = "You supplied a {.cls {class(dataset_name)[0]}} value."
+      ),
+      call = call
+    )
   }
 
 
   if (!grepl(dataset_name_regex, dataset_name)) {
-    cli::cli_abort(c(
-      "The dataset name supplied {.var {dataset_name}} is invalid",
-      "x" = "dataset_name must be in dash-case
+    cli::cli_abort(
+      c(
+        "The dataset name supplied {.var {dataset_name}} is invalid",
+        "x" = "dataset_name must be in dash-case
       (e.g., lowercase-words-separated-by-dashes).",
-      "i" = "You can find dataset names in the URL
+        "i" = "You can find dataset names in the URL
       of a dataset's page on {.url www.opendata.nhs.scot}."
-    ))
+      ),
+      call = call
+    )
   }
 }

R/check_res_id.R

@@ -8,32 +8,41 @@
 #' @return TRUE / FALSE indicating the validity of the res_id
 #' @keywords internal
 #' @noRd
-check_res_id <- function(res_id) {
+check_res_id <- function(res_id, call = rlang::caller_env()) {
   # check res_id is single value
   if (length(res_id) > 1) {
-    cli::cli_abort(c(
-      "Argument {.var res_id} must be of length 1.",
-      i = "You supplied a res_id with a length of {length(res_id)}",
-      x = "`get_resource` does not currently support
+    cli::cli_abort(
+      c(
+        "Argument {.var res_id} must be of length 1.",
+        i = "You supplied a res_id with a length of {length(res_id)}",
+        x = "`get_resource` does not currently support
       requests for multiple resources simultaneously."
-    ))
+      ),
+      call = call
+    )
   }
 
   # check res_id is character
   if (!inherits(res_id, "character")) {
-    cli::cli_abort(c(
-      "Argument {.var res_id} must be of type character",
-      i = "You supplied a {.var res_id} with type  {.cls {class(res_id)[1]}}"
-    ))
+    cli::cli_abort(
+      c(
+        "Argument {.var res_id} must be of type character",
+        i = "You supplied a {.var res_id} with type  {.cls {class(res_id)[1]}}"
+      ),
+      call = call
+    )
   }
 
   # check regex pattern
   res_id_regex <-
     "^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$"
   if (!grepl(res_id_regex, res_id)) {
-    cli::cli_abort(c(
-      "Argument {.var res_id} is in an invalid format.",
-      i = "You can find a resource's ID in the URL of it's page on {.url www.opendata.nhs.scot}."
-    ))
+    cli::cli_abort(
+      c(
+        "Argument {.var res_id} is in an invalid format.",
+        i = "You can find a resource's ID in the URL of it's page on {.url www.opendata.nhs.scot}."
+      ),
+      call = call
+    )
   }
 }

R/dump_download.R

@@ -4,17 +4,20 @@
 #' @return dataframe containing resource records
 #' @keywords internal
 #' @noRd
-dump_download <- function(res_id) {
+dump_download <- function(res_id, call = rlang::caller_env()) {
   # fetch the data
   content <- suppressMessages(
     phs_GET("dump", res_id)
   )
 
   # if content is a web page
   if ("xml_document" %in% class(content)) {
-    cli::cli_abort(c(
-      "Can't find resource with ID {.var {res_id}} in datastore."
-    ))
+    cli::cli_abort(
+      c(
+        "Can't find resource with ID {.var {res_id}} in datastore."
+      ),
+      call = call
+    )
   }
 
   # return data

R/error_check.R

@@ -3,14 +3,17 @@
 #' @param content object produced by `httr::content`
 #' @keywords internal
 #' @noRd
-error_check <- function(content) {
+error_check <- function(content, call = rlang::caller_env()) {
   # if content is not a list,
   # stop for content (a string describing an error)
   if (!is.list(content)) {
-    cli::cli_abort(c(
-      "API error",
-      x = content
-    ))
+    cli::cli_abort(
+      c(
+        "API error",
+        x = content
+      ),
+      call = call
+    )
   }
 
   # if there is no error status/message in the content,
@@ -24,8 +27,11 @@ error_check <- function(content) {
 
   # generate error message and stop
   error_text <- parse_error(content$error)
-  cli::cli_abort(c(
-    "API error.",
-    x = error_text
-  ))
+  cli::cli_abort(
+    c(
+      "API error.",
+      x = error_text
+    ),
+    call = call
+  )
 }

R/get_latest_resource_id.R

@@ -17,7 +17,7 @@
 #' @return a string with the resource id
 #' @keywords internal
 #' @noRd
-get_latest_resource_id <- function(dataset_name) {
+get_latest_resource_id <- function(dataset_name, call = rlang::caller_env()) {
   # send the api request
   query <- list("id" = dataset_name)
   content <- phs_GET("package_show", query)
@@ -53,5 +53,7 @@ get_latest_resource_id <- function(dataset_name) {
   if (all_id_data_first_row$created_date == all_id_data_first_row$most_recent_date_created) {
     return(all_id_data_first_row$id)
   }
-  cli::cli_abort("The most recent id could not be identified")
+  cli::cli_abort("The most recent id could not be identified",
+    call = call
+  )
 }

R/parse_col_select.R

@@ -5,13 +5,16 @@
 #' @return a character string
 #' @keywords internal
 #' @noRd
-parse_col_select <- function(col_select) {
+parse_col_select <- function(col_select, call = rlang::caller_env()) {
   if (is.null(col_select)) {
     return(NULL)
   }
 
   if (!inherits(col_select, "character")) {
-    cli::cli_abort("{.arg col_select} must be a {.cls character} vector, not a {.cls {class(col_select)}} vector.")
+    cli::cli_abort(
+      "{.arg col_select} must be a {.cls character} vector, not a {.cls {class(col_select)}} vector.",
+      call = call
+    )
   }
 
   return(paste0(col_select, collapse = ","))

R/phs_GET.R

@@ -5,7 +5,7 @@
 #' @return content of a httr::GET request
 #' @keywords internal
 #' @noRd
-phs_GET <- function(action, query, verbose = FALSE) {
+phs_GET <- function(action, query, verbose = FALSE, call = rlang::caller_env()) {
   # define URL
   url <- request_url(action, query)
 
@@ -21,10 +21,13 @@ phs_GET <- function(action, query, verbose = FALSE) {
 
   # Check for a response from the server
   if (!inherits(response, "response")) {
-    cli::cli_abort(c(
-      "Can't connect to the CKAN server.",
-      i = "Check your network/proxy settings."
-    ))
+    cli::cli_abort(
+      c(
+        "Can't connect to the CKAN server.",
+        i = "Check your network/proxy settings."
+      ),
+      call = call
+    )
   }
 
   # Extract the content from the HTTP response
@@ -33,7 +36,7 @@ phs_GET <- function(action, query, verbose = FALSE) {
   )
 
   # detect/handle errors
-  error_check(content)
+  error_check(content, call = call)
 
   if (verbose) cat("GET request successful.\n")
   return(content)

R/request_url.R

@@ -5,7 +5,7 @@
 #' @return a URL as a character string
 #' @keywords internal
 #' @noRd
-request_url <- function(action, query) {
+request_url <- function(action, query, call = rlang::caller_env()) {
   # check action is valid
   valid_actions <- c(
     "datastore_search",
@@ -16,10 +16,13 @@ request_url <- function(action, query) {
     "resource_show"
   )
   if (!(action %in% valid_actions)) {
-    cli::cli_abort(c(
-      "API call failed.",
-      x = "{.val {action}} is an invalid {.arg action} argument."
-    ))
+    cli::cli_abort(
+      c(
+        "API call failed.",
+        x = "{.val {action}} is an invalid {.arg action} argument."
+      ),
+      call = call
+    )
   }
 
   base_url <- "https://www.opendata.nhs.scot"

R/suggest_dataset_name.R

@@ -4,7 +4,7 @@
 #' @param dataset_name a string to be matched against valid dataset names
 #' @keywords internal
 #' @noRd
-suggest_dataset_name <- function(dataset_name) {
+suggest_dataset_name <- function(dataset_name, call = rlang::caller_env()) {
   content <- phs_GET("package_list", "")
 
   dataset_names <- unlist(content$result)
@@ -14,20 +14,26 @@ suggest_dataset_name <- function(dataset_name) {
 
   # if min distance is too big, abort
   if (min(string_distances) > 10) {
-    cli::cli_abort(c(
-      "Can't find the dataset name
+    cli::cli_abort(
+      c(
+        "Can't find the dataset name
       {.var {dataset_name}}, or a close match.",
-      i = "Find a dataset's name in the URL
+        i = "Find a dataset's name in the URL
       of its page on {.url www.opendata.nhs.scot.}"
-    ))
+      ),
+      call = call
+    )
   }
 
   # find closet match
   closest_match <- dataset_names[which(string_distances == min(string_distances))]
 
   # throw error with suggestion
-  cli::cli_abort(c(
-    "Can't find the dataset name {.var {dataset_name}}.",
-    "i" = "Did you mean {?any of }{.val {closest_match}}?"
-  ))
+  cli::cli_abort(
+    c(
+      "Can't find the dataset name {.var {dataset_name}}.",
+      "i" = "Did you mean {?any of }{.val {closest_match}}?"
+    ),
+    call = call
+  )
 }