GH-50603: [R] remove assertthat dependency + improve error messages

ci/conda_env_r.txt

@@ -15,7 +15,6 @@
 # specific language governing permissions and limitations
 # under the License.
 
-r-assertthat
 r-base
 r-bit64
 r-dplyr

r/DESCRIPTION

@@ -33,13 +33,12 @@ SystemRequirements: C++20; for AWS S3 support on Linux, libcurl and openssl, and
     cmake >= 3.26 (build-time only, and only for full source build)
 Biarch: true
 Imports:
-    assertthat,
     bit64 (>= 0.9-7),
     glue,
     methods,
     purrr,
     R6,
-    rlang (>= 1.0.0),
+    rlang (>= 1.2.0),
     stats,
     tidyselect (>= 1.0.0),
     utils,

r/NAMESPACE

@@ -428,8 +428,6 @@ export(write_parquet)
 export(write_to_raw)
 export(write_tsv_dataset)
 importFrom(R6,R6Class)
-importFrom(assertthat,assert_that)
-importFrom(assertthat,is.string)
 importFrom(bit64,integer64)
 importFrom(glue,glue)
 importFrom(methods,as)
@@ -460,9 +458,14 @@ importFrom(rlang,as_quosure)
 importFrom(rlang,call2)
 importFrom(rlang,call_args)
 importFrom(rlang,call_name)
+importFrom(rlang,caller_arg)
 importFrom(rlang,caller_env)
+importFrom(rlang,check_bool)
 importFrom(rlang,check_dots_empty)
 importFrom(rlang,check_dots_empty0)
+importFrom(rlang,check_number_decimal)
+importFrom(rlang,check_number_whole)
+importFrom(rlang,check_string)
 importFrom(rlang,dots_list)
 importFrom(rlang,dots_n)
 importFrom(rlang,enexpr)
@@ -482,15 +485,22 @@ importFrom(rlang,is_bare_character)
 importFrom(rlang,is_bare_list)
 importFrom(rlang,is_call)
 importFrom(rlang,is_character)
+importFrom(rlang,is_closure)
 importFrom(rlang,is_empty)
+importFrom(rlang,is_environment)
 importFrom(rlang,is_false)
 importFrom(rlang,is_formula)
 importFrom(rlang,is_integerish)
 importFrom(rlang,is_interactive)
 importFrom(rlang,is_list)
+importFrom(rlang,is_logical)
+importFrom(rlang,is_missing)
+importFrom(rlang,is_na)
+importFrom(rlang,is_null)
 importFrom(rlang,is_quosure)
 importFrom(rlang,is_string)
 importFrom(rlang,is_symbol)
+importFrom(rlang,is_vector)
 importFrom(rlang,list2)
 importFrom(rlang,new_data_mask)
 importFrom(rlang,new_environment)
@@ -508,6 +518,7 @@ importFrom(rlang,quo_set_expr)
 importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
+importFrom(rlang,stop_input_type)
 importFrom(rlang,sym)
 importFrom(rlang,syms)
 importFrom(rlang,trace_back)

r/NEWS.md

@@ -19,6 +19,9 @@
 
 # arrow 25.0.0.9000
 
+## Minor improvements and fixes
+- arrow no longer depends on assertthat and has impr (@olivroy, #50525).
+
 # arrow 25.0.0
 
 ## Breaking changes

r/R/array.R

@@ -417,7 +417,9 @@ DictionaryArray$create <- function(x, dict = NULL) {
     return(Array$create(x))
   }
 
-  assert_that(!is.null(dict))
+  if (is.null(dict)) {
+    stop("dict cannot be `NULL`.", call. = FALSE)
+  }
   if (!is.Array(x)) {
     x <- Array$create(x)
   }
@@ -450,18 +452,17 @@ StructArray$create <- function(...) {
 
 #' @export
 `[[.StructArray` <- function(x, i, ...) {
+  assert_is(i, c("character", "numeric", "integer"))
   if (is.character(i)) {
     x$GetFieldByName(i)
   } else if (is.numeric(i)) {
     x$field(i - 1)
-  } else {
-    stop("'i' must be character or numeric, not ", class(i), call. = FALSE)
   }
 }
 
 #' @export
 `$.StructArray` <- function(x, name, ...) {
-  assert_that(is.string(name))
+  check_string(name)
   if (name %in% ls(x)) {
     get(name, x)
   } else {

r/R/arrow-datum.R

@@ -29,9 +29,7 @@ ArrowDatum <- R6Class(
       call_function("cast", self, options = opts)
     },
     SortIndices = function(descending = FALSE) {
-      assert_that(is.logical(descending))
-      assert_that(length(descending) == 1L)
-      assert_that(!is.na(descending))
+      check_bool(descending, allow_na = FALSE)
       call_function(
         "sort_indices",
         self,
@@ -285,8 +283,7 @@ filter_rows <- function(x, i, keep_na = TRUE, ...) {
 #' @importFrom utils head
 #' @export
 head.ArrowDatum <- function(x, n = 6L, ...) {
-  assert_is(n, c("numeric", "integer"))
-  assert_that(length(n) == 1)
+  check_number_decimal(n)
   len <- NROW(x)
   if (n < 0) {
     # head(x, negative) means all but the last n rows
@@ -306,8 +303,7 @@ head.ArrowDatum <- function(x, n = 6L, ...) {
 #' @importFrom utils tail
 #' @export
 tail.ArrowDatum <- function(x, n = 6L, ...) {
-  assert_is(n, c("numeric", "integer"))
-  assert_that(length(n) == 1)
+  check_number_decimal(n)
   if (!is.integer(n)) {
     n <- floor(n)
   }

r/R/arrow-package.R

@@ -19,15 +19,16 @@
 #' @importFrom R6 R6Class
 #' @importFrom purrr as_mapper map map2 map_chr map2_chr map_dbl map_dfr map_int map_lgl keep imap imap_chr
 #' @importFrom purrr compact flatten reduce walk
-#' @importFrom assertthat assert_that is.string
 #' @importFrom rlang list2 %||% is_false abort dots_n warn enquo quo_is_null enquos is_integerish quos quo
 #' @importFrom rlang eval_tidy new_data_mask syms env new_environment env_bind set_names exec
 #' @importFrom rlang is_bare_character quo_get_expr quo_get_env quo_set_expr .data seq2 is_interactive
 #' @importFrom rlang expr caller_env is_character quo_name is_quosure enexpr enexprs as_quosure
 #' @importFrom rlang is_list call2 is_empty as_function as_label arg_match is_symbol is_call call_args
 #' @importFrom rlang quo_set_env quo_get_env is_formula quo_is_call f_rhs parse_expr f_env new_quosure
 #' @importFrom rlang new_quosures expr_text caller_env check_dots_empty check_dots_empty0 dots_list is_string inform
-#' @importFrom rlang is_bare_list call_name
+#' @importFrom rlang is_bare_list call_name check_string check_number_whole check_number_decimal check_bool
+#' @importFrom rlang is_logical caller_env caller_arg stop_input_type is_null is_closure
+#' @importFrom rlang is_environment is_na is_vector is_missing
 #' @importFrom tidyselect vars_pull eval_select eval_rename
 #' @importFrom glue glue
 #' @importFrom bit64 integer64

r/R/arrow-tabular.R

@@ -36,26 +36,34 @@ ArrowTabular <- R6Class(
       if (is.integer(i)) {
         i <- Array$create(i)
       }
-      assert_that(is.Array(i))
+      if (!is.Array(i)) {
+        stop("`i` must be an Array.")
+      }
       call_function("take", self, i)
     },
     Filter = function(i, keep_na = TRUE) {
       if (is.logical(i)) {
         i <- Array$create(i)
       }
-      assert_that(is.Array(i, "bool"))
+      if (!is.Array(i, "bool")) {
+        stop("i must be an Array of bool", call. = FALSE)
+      }
       call_function("filter", self, i, options = list(keep_na = keep_na))
     },
     SortIndices = function(names, descending = FALSE) {
-      assert_that(is.character(names))
-      assert_that(length(names) > 0)
-      assert_that(!anyNA(names))
+      # if rlang adds allow_empty argument https://github.com/r-lib/rlang/pull/1745
+      # use allow_empty = FALSE instead
+      check_character(names, allow_na = FALSE)
+      if (length(names) == 0) {
+        stop("names can't be empty.", call. = FALSE)
+      }
       if (length(descending) == 1L) {
         descending <- rep_len(descending, length(names))
       }
-      assert_that(is.logical(descending))
-      assert_that(identical(length(names), length(descending)))
-      assert_that(!anyNA(descending))
+      check_logical(descending, allow_na = FALSE)
+      if (length(names) != length(descending)) {
+        stop("names and descending must have a common length", call. = FALSE)
+      }
       call_function(
         "sort_indices",
         self,
@@ -142,18 +150,17 @@ as.data.frame.ArrowTabular <- function(x, row.names = NULL, optional = FALSE, ..
 
 #' @export
 `[[.ArrowTabular` <- function(x, i, ...) {
+  assert_is(i, c("character", "numeric"))
   if (is.character(i)) {
     x$GetColumnByName(i)
   } else if (is.numeric(i)) {
     x$column(i - 1)
-  } else {
-    stop("'i' must be character or numeric, not ", class(i), call. = FALSE)
   }
 }
 
 #' @export
 `$.ArrowTabular` <- function(x, name, ...) {
-  assert_that(is.string(name))
+  check_string(name)
   if (name %in% ls(x)) {
     get(name, x)
   } else {
@@ -163,10 +170,10 @@ as.data.frame.ArrowTabular <- function(x, row.names = NULL, optional = FALSE, ..
 
 #' @export
 `[[<-.ArrowTabular` <- function(x, i, value) {
-  if (!is.character(i) && !is.numeric(i)) {
-    stop("'i' must be character or numeric, not ", class(i), call. = FALSE)
+  assert_is(i, c("character", "numeric"))
+  if (length(i) != 1 || is.na(i)) {
+    stop("`i` must be length 1 and not NA", call. = FALSE)
   }
-  assert_that(length(i) == 1, !is.na(i))
 
   if (is.null(value)) {
     if (is.character(i)) {
@@ -209,7 +216,7 @@ as.data.frame.ArrowTabular <- function(x, row.names = NULL, optional = FALSE, ..
 
 #' @export
 `$<-.ArrowTabular` <- function(x, i, value) {
-  assert_that(is.string(i))
+  check_string(i)
   # We need to check if `i` is in names in case it is an active binding (e.g.
   # `metadata`, in which case we use assign to change the active binding instead
   # of the column in the table)

r/R/compression.R

@@ -47,7 +47,7 @@ Codec <- R6Class(
   )
 )
 Codec$create <- function(type = "gzip", compression_level = NA) {
-  if (is.string(type)) {
+  if (is_string(type)) {
     type <- util___Codec__Create(
       compression_from_name(type),
       compression_level
@@ -104,7 +104,7 @@ compression_from_name <- function(name) {
 CompressedOutputStream <- R6Class("CompressedOutputStream", inherit = OutputStream)
 CompressedOutputStream$create <- function(stream, codec = "gzip", compression_level = NA) {
   codec <- Codec$create(codec, compression_level = compression_level)
-  if (is.string(stream)) {
+  if (is_string(stream)) {
     stream <- FileOutputStream$create(stream)
   }
   assert_is(stream, "OutputStream")
@@ -118,7 +118,7 @@ CompressedOutputStream$create <- function(stream, codec = "gzip", compression_le
 CompressedInputStream <- R6Class("CompressedInputStream", inherit = InputStream)
 CompressedInputStream$create <- function(stream, codec = "gzip", compression_level = NA) {
   codec <- Codec$create(codec, compression_level = compression_level)
-  if (is.string(stream)) {
+  if (is_string(stream)) {
     stream <- ReadableFile$create(stream)
   }
   assert_is(stream, "InputStream")

r/R/compute.R

@@ -44,8 +44,10 @@
 #' @include chunked-array.R
 #' @include scalar.R
 call_function <- function(function_name, ..., args = list(...), options = empty_named_list()) {
-  assert_that(is.string(function_name))
-  assert_that(is.list(options), !is.null(names(options)))
+  check_string(function_name)
+  if (!is.list(options) || is.null(names(options))) {
+    stop("options must be a named list.", call. = FALSE)
+  }
 
   datum_classes <- c("Array", "ChunkedArray", "RecordBatch", "Table", "Scalar")
   valid_args <- map_lgl(args, ~ inherits(., datum_classes))
@@ -152,7 +154,9 @@ collect_arrays_from_dots <- function(dots) {
     return(dots[[1]])
   }
 
-  assert_that(all(map_lgl(dots, is.Array)))
+  if (!all(map_lgl(dots, is.Array))) {
+    stop("dots must all be Arrays.", call. = FALSE)
+  }
   arrays <- unlist(lapply(dots, function(x) {
     if (inherits(x, "ChunkedArray")) {
       x$chunks
@@ -176,8 +180,10 @@ quantile.ArrowDatum <- function(
     x <- Array$create(x)
   }
   assert_is(probs, c("numeric", "integer"))
-  assert_that(length(probs) > 0)
-  assert_that(all(probs >= 0 & probs <= 1))
+  # if check_numbers_decimal() gets added in rlang, https://github.com/r-lib/rlang/issues/1714
+  if (length(probs) == 0 || !all(probs >= 0 & probs <= 1)) {
+    stop("probs must be a probability vector between 0 and 1.")
+  }
   if (!na.rm && x$null_count > 0) {
     stop("Missing values not allowed if 'na.rm' is FALSE", call. = FALSE)
   }

r/R/csv.R

@@ -440,7 +440,7 @@ csv_read_options <- function(
   encoding = "UTF-8",
   skip_rows_after_names = 0L
 ) {
-  assert_that(is.string(encoding))
+  check_string(encoding)
 
   options <- csv___ReadOptions__initialize(
     list(
@@ -646,14 +646,14 @@ csv_write_options <- function(
   quoting_style_opts <- c("Needed", "AllValid", "None")
   quoting_style <- match(quoting_style, quoting_style_opts) - 1L
 
-  assert_that(is.logical(include_header))
-  assert_that(is_integerish(batch_size, n = 1, finite = TRUE), batch_size > 0)
-  assert_that(is.character(delimiter))
-  assert_that(is.character(null_string))
-  assert_that(!is.na(null_string))
-  assert_that(length(null_string) == 1)
-  assert_that(!grepl('"', null_string), msg = "na argument must not contain quote characters.")
-  assert_that(is.character(eol))
+  check_bool(include_header)
+  check_number_whole(batch_size, min = 1, allow_infinite = FALSE)
+  check_string(delimiter)
+  check_string(null_string, allow_na = FALSE)
+  if (grepl('"', null_string)) {
+    stop("na argument must not contain quote characters.", call. = FALSE)
+  }
+  check_string(eol)
 
   csv___WriteOptions__initialize(
     list(
@@ -930,17 +930,17 @@ write_csv_arrow <- function(
   write_options = NULL,
   ...
 ) {
-  unsupported_passed_args <- names(list(...))
-
-  if (length(unsupported_passed_args)) {
-    stop(
-      "The following ",
-      ngettext(length(unsupported_passed_args), "argument is ", "arguments are "),
-      "not yet supported in Arrow: ",
-      oxford_paste(unsupported_passed_args),
-      call. = FALSE
+  # every other argument is not supported in arrow and inform those arguments
+  # are not yet supported in arrow.
+  check_dots_empty(error = function(cnd) {
+    rlang::abort(
+      c(
+        "Arguments not yet supported in Arrow",
+        conditionMessage(cnd)
+      ),
+      call = call("write_csv_arrow")
     )
-  }
+  })
 
   if (!missing(file) && !missing(sink)) {
     stop(