Empty (#49)

* Remove extraneous to-dos. * Deal with empty vectors. Closes #45. Closes #43.
jonthegeek · Aug 16, 2023 · bed3b93 · bed3b93
1 parent bdd4668
commit bed3b93
Show file tree

Hide file tree

Showing 28 changed files with 145 additions and 59 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -19,6 +19,7 @@ Imports:
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
+Config/testthat/parallel: true
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
diff --git a/R/aaa-shared-args.R b/R/aaa-shared-args.R
@@ -6,6 +6,7 @@
 #' @param ... These dots are for future extensions and should be empty.
 #' @param allow_na Logical. Are NA values ok?
 #' @param allow_null Logical. Is NULL an acceptable value?
+#' @param allow_zero_length Logical. Are zero-length vectors acceptable?
 #' @param min_size Integer. The minimum size of the object. Object size will be
 #'   tested using [vctrs::vec_size()].
 #' @param max_size Integer. The maximum size of the object. Object size will be

diff --git a/R/check.R b/R/check.R
@@ -3,24 +3,32 @@
                       x_arg = rlang::caller_arg(x),
                       call = rlang::caller_env()) {
   allow_na <- to_lgl_scalar(allow_na, allow_null = FALSE, call = call)
-  failures <- is.na(x)
-  if (allow_na || !any(failures)) {
+  if (allow_na) {
     return(invisible(NULL))
   }
-  locations <- which(failures)
-  .stop_must(
-    msg = "must not contain NA values.",
-    x_arg = x_arg,
-    additional_msg = c("*" = "NA locations: {locations}"),
-    call = call
-  )
+
+  failures <- is.na(x)
+  if (any(failures)) {
+    locations <- which(failures)
+    .stop_must(
+      msg = "must not contain NA values.",
+      x_arg = x_arg,
+      additional_msg = c("*" = "NA locations: {locations}"),
+      call = call
+    )
+  }
+  return(invisible(NULL))
 }
 
 .check_size <- function(x,
                         min_size,
                         max_size,
                         x_arg = rlang::caller_arg(x),
                         call = rlang::caller_env()) {
+  if (is.null(min_size) && is.null(max_size)) {
+    return(invisible(NULL))
+  }
+
   min_size <- to_int_scalar(min_size, call = call)
   max_size <- to_int_scalar(max_size, call = call)
   .check_x_no_more_than_y(min_size, max_size, call = call)
@@ -53,12 +61,28 @@
 
 .check_scalar <- function(x,
                           allow_null = TRUE,
+                          allow_zero_length = TRUE,
                           x_arg = rlang::caller_arg(x),
                           call = rlang::caller_env(),
                           x_class = object_type(x)) {
-  if (.is_allowed_null(x, allow_null = allow_null, call = call)) {
-    return(invisible(NULL))
+  # TODO: Some of this is redundant.
+  if (!length(x)) {
+    if (is.null(x)) {
+      if (.is_allowed_null(x, allow_null = allow_null, call = call)) {
+        return(invisible(NULL))
+      }
+    } else {
+      allow_zero_length <- to_lgl_scalar(
+        allow_zero_length,
+        allow_null = FALSE,
+        call = call
+      )
+      if (allow_zero_length) {
+        return(invisible(NULL))
+      }
+    }
   }
+
   if (rlang::is_scalar_vector(x)) {
     return(invisible(NULL))
   }

diff --git a/R/cls_unexported.R b/R/cls_unexported.R
@@ -3,13 +3,16 @@
                            to_cls_fn,
                            to_cls_args = list(),
                            allow_null = TRUE,
+                           allow_zero_length = TRUE,
                            x_arg = rlang::caller_arg(x),
                            call = rlang::caller_env(),
                            x_class = object_type(x)) {
   if (is_rlang_cls_scalar(x)) {
     return(x)
   }
+
   force(x_arg)
+  force(call)
   x <- rlang::inject(
     to_cls_fn(
       x,
@@ -23,6 +26,7 @@
   .check_scalar(
     x,
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     x_arg = x_arg,
     call = call,
     x_class = x_class
@@ -43,8 +47,8 @@
                            x_arg = rlang::caller_arg(x),
                            call = rlang::caller_env(),
                            x_class = object_type(x)) {
-  x_arg <- force(x_arg)
-
+  force(x_arg)
+  force(call)
   x <- rlang::inject(
     to_cls_fn(
       x,
@@ -84,17 +88,20 @@
                                   check_cls_value_fn = NULL,
                                   check_cls_value_fn_args = list(),
                                   allow_null = TRUE,
+                                  allow_zero_length = TRUE,
                                   allow_na = TRUE,
                                   x_arg = rlang::caller_arg(x),
                                   call = rlang::caller_env(),
                                   x_class = object_type(x)) {
   rlang::check_dots_empty0(..., call = call)
-  x_arg <- force(x_arg)
+  force(x_arg)
+  force(call)
 
   x <- rlang::inject(
     to_cls_scalar_fn(
       x,
       allow_null = allow_null,
+      allow_zero_length = allow_zero_length,
       !!!to_cls_scalar_args,
       x_arg = x_arg,
       call = call,

diff --git a/R/is.R b/R/is.R
@@ -2,13 +2,5 @@
                              allow_null = TRUE,
                              call = rlang::caller_env()) {
   allow_null <- to_lgl_scalar(allow_null, allow_null = FALSE, call = call)
-  # if (vctrs::vec_size(allow_null) > 1) {
-  #   .stop_must(
-  #     msg = "must have a single {.cls logical} value.",
-  #     x_arg = "allow_null",
-  #     call = call
-  #   )
-  # }
-
   return(is.null(x) && allow_null)
 }
diff --git a/R/stabilize_arg_scalar.R b/R/stabilize_arg_scalar.R
@@ -4,6 +4,7 @@
 #' check for length-1 vectors.
 #'
 #' @inheritParams stabilize_arg
+#' @inheritParams .coerce-params
 #'
 #' @return `x`, unless one of the checks fails.
 #' @export
@@ -15,6 +16,7 @@
 stabilize_arg_scalar <- function(x,
                                  ...,
                                  allow_null = TRUE,
+                                 allow_zero_length = TRUE,
                                  allow_na = TRUE,
                                  x_arg = rlang::caller_arg(x),
                                  call = rlang::caller_env(),
@@ -23,6 +25,7 @@ stabilize_arg_scalar <- function(x,
   .check_scalar(
     x,
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     x_arg = x_arg,
     call = call,
     x_class = x_class

diff --git a/R/stabilize_chr_scalar.R b/R/stabilize_chr_scalar.R
@@ -4,6 +4,7 @@
 #' check for length-1 character vectors.
 #'
 #' @inheritParams stabilize_chr
+#' @inheritParams .coerce-params
 #'
 #' @return `x`, unless one of the checks fails.
 #' @export
@@ -17,6 +18,7 @@
 stabilize_chr_scalar <- function(x,
                                  ...,
                                  allow_null = TRUE,
+                                 allow_zero_length = TRUE,
                                  allow_na = TRUE,
                                  regex = NULL,
                                  x_arg = rlang::caller_arg(x),
@@ -28,6 +30,7 @@ stabilize_chr_scalar <- function(x,
     check_cls_value_fn = .check_value_chr,
     check_cls_value_fn_args = list(regex = regex),
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     allow_na = allow_na,
     x_arg = x_arg,
     call = call,

diff --git a/R/stabilize_int_scalar.R b/R/stabilize_int_scalar.R
@@ -4,6 +4,7 @@
 #' check for length-1 integers.
 #'
 #' @inheritParams stabilize_int
+#' @inheritParams .coerce-params
 #'
 #' @return `x`, unless one of the checks fails.
 #' @export
@@ -17,6 +18,7 @@
 stabilize_int_scalar <- function(x,
                                  ...,
                                  allow_null = TRUE,
+                                 allow_zero_length = TRUE,
                                  allow_na = TRUE,
                                  coerce_character = TRUE,
                                  coerce_factor = TRUE,
@@ -37,6 +39,7 @@ stabilize_int_scalar <- function(x,
       min_value = min_value, max_value = max_value
     ),
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     allow_na = allow_na,
     x_arg = x_arg,
     call = call,

diff --git a/R/stabilize_lgl_scalar.R b/R/stabilize_lgl_scalar.R
@@ -4,6 +4,7 @@
 #' check for length-1 logical vectors.
 #'
 #' @inheritParams stabilize_lgl
+#' @inheritParams .coerce-params
 #'
 #' @return `x`, unless one of the checks fails.
 #' @export
@@ -17,6 +18,7 @@
 stabilize_lgl_scalar <- function(x,
                                  ...,
                                  allow_null = TRUE,
+                                 allow_zero_length = TRUE,
                                  allow_na = TRUE,
                                  x_arg = rlang::caller_arg(x),
                                  call = rlang::caller_env(),
@@ -25,6 +27,7 @@ stabilize_lgl_scalar <- function(x,
     x,
     to_cls_scalar_fn = to_lgl_scalar,
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     allow_na = allow_na,
     x_arg = x_arg,
     call = call,

diff --git a/R/ykwim-package.R → R/stbl-package.R b/R/ykwim-package.R → R/stbl-package.R
diff --git a/R/to_chr.R b/R/to_chr.R
@@ -1,9 +1,3 @@
-# TODO: Document to_chr.
-# TODO: stabilize_chr
-# TODO: to_chr_scalar
-# TODO: stabilize_chr_scalar
-# TODO: See if there's anything to abstract for to_*().
-
 #' Coerce an argument to character
 #'
 #' If a value can be coerced to a character without losing information, do so

diff --git a/R/to_chr_scalar.R b/R/to_chr_scalar.R
@@ -4,6 +4,7 @@
 #' input contains a single value.
 #'
 #' @inheritParams to_chr
+#' @inheritParams .coerce-params
 #'
 #' @return A character vector equivalent to `x`.
 #' @export
@@ -13,6 +14,7 @@
 #' try(to_chr_scalar(letters))
 to_chr_scalar <- function(x,
                           allow_null = TRUE,
+                          allow_zero_length = TRUE,
                           x_arg = rlang::caller_arg(x),
                           call = rlang::caller_env(),
                           x_class = object_type(x)) {
@@ -21,6 +23,7 @@ to_chr_scalar <- function(x,
     is_rlang_cls_scalar = rlang::is_scalar_character,
     to_cls_fn = to_chr,
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     x_arg = x_arg,
     call = call,
     x_class = x_class

diff --git a/R/to_int_scalar.R b/R/to_int_scalar.R
@@ -4,6 +4,7 @@
 #' input contains a single value.
 #'
 #' @inheritParams to_int
+#' @inheritParams .coerce-params
 #'
 #' @return An integer equivalent to `x`.
 #' @export
@@ -13,6 +14,7 @@
 #' try(to_int_scalar(1:10))
 to_int_scalar <- function(x,
                           allow_null = TRUE,
+                          allow_zero_length = TRUE,
                           coerce_character = TRUE,
                           coerce_factor = TRUE,
                           x_arg = rlang::caller_arg(x),
@@ -27,27 +29,9 @@ to_int_scalar <- function(x,
       coerce_factor = coerce_factor
     ),
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     x_arg = x_arg,
     call = call,
     x_class = x_class
   )
-  x_arg <- force(x_arg)
-  x <- to_int(
-    x,
-    allow_null = allow_null,
-    coerce_character = coerce_character,
-    coerce_factor = coerce_factor,
-    x_arg = x_arg,
-    call = call,
-    x_class = x_class
-  )
-
-  .check_scalar(
-    x,
-    allow_null = allow_null,
-    x_arg = x_arg,
-    call = call,
-    x_class = x_class
-  )
-  return(x)
 }
diff --git a/R/to_lgl_scalar.R b/R/to_lgl_scalar.R
@@ -4,6 +4,7 @@
 #' input contains a single value.
 #'
 #' @inheritParams to_lgl
+#' @inheritParams .coerce-params
 #'
 #' @return A logical vector equivalent to `x`.
 #' @export
@@ -13,6 +14,7 @@
 #' try(to_lgl_scalar(c(TRUE, FALSE)))
 to_lgl_scalar <- function(x,
                           allow_null = TRUE,
+                          allow_zero_length = TRUE,
                           x_arg = rlang::caller_arg(x),
                           call = rlang::caller_env(),
                           x_class = object_type(x)) {
@@ -21,6 +23,7 @@ to_lgl_scalar <- function(x,
     is_rlang_cls_scalar = rlang::is_scalar_logical,
     to_cls_fn = to_lgl,
     allow_null = allow_null,
+    allow_zero_length = allow_zero_length,
     x_arg = x_arg,
     call = call,
     x_class = x_class

diff --git a/R/to_null.R b/R/to_null.R
@@ -2,6 +2,9 @@ to_null <- function(x,
                     allow_null = TRUE,
                     x_arg = rlang::caller_arg(x),
                     call = rlang::caller_env()) {
+  if (missing(x)) {
+    .stop_must("must not be missing.", x_arg = "unknown arg", call = call)
+  }
   allow_null <- to_lgl_scalar(allow_null, allow_null = FALSE, call = call)
   if (allow_null) {
     return(NULL)

diff --git a/man/dot-coerce-params.Rd b/man/dot-coerce-params.Rd
diff --git a/man/stabilize_arg_scalar.Rd b/man/stabilize_arg_scalar.Rd