➕ Add check_that helper function

Author: francisbarton

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(check_container_class)
 export(check_envvar)
+export(check_that)
 export(get_auth_token)
 export(get_container)
 export(list_container_names)

R/azkit_helpers.R

@@ -1,3 +1,29 @@
+#' An alternative to stopifnot/assert_that etc
+#'
+#' If the predicate function is true of `x` then `x` is returned. Otherwise,
+#'  an error is thrown with a custom `message`.
+#'
+#' @param x The object to be checked
+#' @param predicate The predicate function used to check `x`
+#' @param message A custom error message, as a string. Will be shown to the
+#'  user if the predicate check does not succeed. Can include `glue`d variables
+#'  and `{cli}` semantic markup.
+#' @param pf Set as [parent.frame()] so variables in the caller environment can
+#'  be used in the custom error message.
+#' @seealso [check_vec]
+#' @export
+check_that <- function(x, predicate, message, pf = parent.frame()) {
+  if (predicate(x)) {
+    x
+  } else {
+    cli::cli_abort(message, call = rlang::caller_call(), .envir = pf)
+  }
+}
+
+
+#' @keywords internal
+ct_error_msg <- \(text) paste0("{.fn check_that}: ", text)
+
 #' An alternative to stopifnot/assert_that etc
 #'
 #' This function makes it easy to use the `{purrr}` functions `every()`,
@@ -6,10 +32,9 @@
 #' Not suitable for checking if `length(x) == 1` as it will check vectors
 #' element-wise, so will potentially return TRUE even if `length(x) > 1`
 #'
-#' @param x The object to be checked
 #' @param predicate The predicate function used to check elements of `x`
 #' @param message A custom error message, as a string. Will be shown to the
-#'  user if the predicate check does not succeed. Can include `glue` variables
+#'  user if the predicate check does not succeed. Can include `glue`d variables
 #'  and `{cli}` semantic markup. Variable values will be searched for in the
 #'  environment of the caller function (not in the environment of `check_vec()`
 #'  ). This makes it easier to include informative values in the message.
@@ -19,8 +44,7 @@
 #'  predicate. "none" can be used to generate an inverse predicate, or the
 #'  situation where success means that none of the elements of x satisfies the
 #'  predicate. "some" is unlikely to be useful often, but it is available.
-#' @param pf Set as [parent.frame()] so variables in the caller environment can
-#'  be used in the custom error message.
+#' @inheritParams check_that
 #' @seealso [check_scalar_type()]
 #' @keywords internal
 check_vec <- function(
@@ -50,8 +74,8 @@ cv_error_msg <- \(text) paste0("{.fn check_vec}: ", text)
 #' Possible values for the `type` parameter are: "character", "logical", "list",
 #'  "integer", "double", "string", "bool", "bytes", "raw", "vector", "complex".
 #  Supplying "string" or "bool" will additionally check that `x` is not missing.
-#' @seealso [check_vec()]
-#' @inheritParams check_vec
+#' @seealso [check_that]
+#' @inheritParams check_that
 #' @param type A string defining the R object type that `x` is checked to be
 #' @keywords internal
 check_scalar_type <- function(
@@ -91,7 +115,7 @@ cst_error_msg <- \(text) paste0("{.fn check_scalar_type}: ", text)
 #'
 #' Will error if x is equal to `""`, or if it is otherwise missing or invalid.
 #' With the exception that if x is NULL, then NULL will be passed through.
-#' @inheritParams check_vec
+#' @inheritParams check_that
 #' @param message A custom error message, as a string. Will be shown to the
 #'  user if the check does not pass. Can include `glue` variables and `{cli}`
 #'  semantic markup. Variable values will be searched for in the environment of

R/get_container.R

@@ -19,9 +19,9 @@ get_container <- function(container_name = NULL, ...) {
   token <- get_auth_token(...)
   endpoint <- get_default_endpoint(token)
   container_names <- list_container_names(token)
-  not_found_msg <- cv_error_msg("Container {.val {cont_nm}} not found")
+  not_found_msg <- ct_error_msg("Container {.val {cont_nm}} not found")
   cont_nm |>
-    check_vec(\(x) x %in% container_names, not_found_msg) |>
+    check_that(\(x) x %in% container_names, not_found_msg) |>
     AzureStor::blob_container(endpoint = endpoint)
 }
 

R/list_files.R

@@ -31,8 +31,8 @@
 list_files <- function(container, path = "", ext = "", recursive = TRUE) {
   stopifnot(rlang::is_character(c(path, ext), 2))
   stopifnot(rlang::is_bool(recursive))
-  pnf_msg <- cv_error_msg("Path {.val {path}} not found")
-  check_vec(path, \(x) AzureStor::blob_dir_exists(container, x), pnf_msg)
+  pnf_msg <- ct_error_msg("Path {.val {path}} not found")
+  check_that(path, \(x) AzureStor::blob_dir_exists(container, x), pnf_msg)
 
   tbl <- AzureStor::list_blobs(container, path, recursive = recursive)
   if (nrow(tbl) > 0) {

R/read_azure_files.R

@@ -1,6 +1,6 @@
 #' Read a parquet file from Azure storage
 #'
-#' @param container An Azure container object, as returned by [get_container()]
+#' @param container An Azure container object, as returned by [get_container]
 #' @param file The name of the file to be read, as a string. NB The file
 #'  extension does not need to be included (though it can be). The function
 #'  will error if multiple files are somehow matched.
@@ -14,8 +14,8 @@
 #'  being read. Useful for checking the function is doing what is expected, but
 #'  can be turned off with `FALSE`. Can be set persistently with the option
 #'  "azkit.info". If `NULL` then it will default to the value of
-#'  [rlang::is_interactive()] (ie `TRUE` for interactive sessions).
-#' @param ... optional arguments to be passed through to [arrow::read_parquet()]
+#'  [rlang::is_interactive] (that is, `TRUE` for interactive sessions).
+#' @param ... optional arguments to be passed through to [arrow::read_parquet]
 #' @returns A tibble
 #' @examples \dontrun{
 #'   # if a full filepath is available then path can be ignored
@@ -95,9 +95,9 @@ check_blob_exists <- function(container, file, ext, info, path) {
     dplyr::filter(dplyr::if_any("name", \(x) x == {{ file_path }})) |>
     dplyr::pull("name")
 
-  msg1 <- cv_error_msg("no matching {ext} file found")
+  msg1 <- ct_error_msg("no matching {ext} file found")
   msg2 <- cst_error_msg("multiple matching {ext} files found")
-  check_vec(filepath_out, rlang::is_character, msg1) # check length > 0
+  check_that(filepath_out, \(x) length(x) > 0, msg1) # check length > 0
   check_scalar_type(filepath_out, "character", msg2) # check length == 1
 
   info_option <- getOption("azkit.info")

man/check_blob_exists.Rd

@@ -235,7 +235,7 @@ test_that("tdd of check_blob_exists", {
         dplyr::pull("name")
       stop_msg1 <- glue::glue("no matching {file_ext} file found")
       stop_msg2 <- glue::glue("multiple matching {file_ext} files found")
-      check_vec(filepath, rlang::is_character, stop_msg1) # check length > 0
+      check_that(filepath, \(x) length(x) > 0, stop_msg1) # check length > 0
       check_scalar_type(filepath, "character", stop_msg2) # check length == 1
     }
     expect_error(check_blob_exists(support_container, "unmatched"), "matching")
@@ -254,7 +254,7 @@ test_that("tdd of check_blob_exists", {
         dplyr::pull("name")
       stop_msg1 <- glue::glue("no matching {file_ext} file found")
       stop_msg2 <- glue::glue("multiple matching {file_ext} files found")
-      check_vec(filepath, rlang::is_character, stop_msg1) # check length > 0
+      check_that(filepath, \(x) length(x) > 0, stop_msg1) # check length > 0
       check_scalar_type(filepath, "character", stop_msg2) # check length == 1
       filepath
     }