Add coerce_* args. (#17)

Closes #14

NAMESPACE

@@ -6,7 +6,6 @@ S3method(to_int,complex)
 S3method(to_int,default)
 S3method(to_int,double)
 S3method(to_int,factor)
-S3method(to_int,hexmode)
 S3method(to_int,integer)
 S3method(to_int,logical)
 export(object_type)

R/stabilize_common.R

@@ -8,8 +8,8 @@
   if (is.null(x)) {
     return(x)
   }
-  rlang::check_dots_empty0(..., call = call)
 
+  rlang::check_dots_empty0(..., call = call)
   .check_na(x, allow_na, x_arg, call)
   .check_size(x, min_size, max_size, x_arg, call)
   return(x)

R/stabilize_int.R

@@ -3,6 +3,7 @@
 #' More details soon.
 #'
 #' @inheritParams .coerce-params
+#' @inheritParams to_int
 #' @param min_value Integer scalar. The lowest allowed value for `x`. If `NULL`
 #'   (default) values are not checked.
 #' @param max_value Integer scalar. The highest allowed value for `x`. If `NULL`
@@ -19,6 +20,8 @@ stabilize_int <- function(x,
                           ...,
                           allow_null = TRUE,
                           allow_na = TRUE,
+                          coerce_character = TRUE,
+                          coerce_factor = TRUE,
                           min_size = NULL,
                           max_size = NULL,
                           min_value = NULL,
@@ -27,7 +30,15 @@ stabilize_int <- function(x,
                           call = rlang::caller_env()) {
   # TODO: Update these examples to show the fancy stuff.
   x_arg <- force(x_arg)
-  x <- to_int(x, allow_null = allow_null, x_arg = x_arg, call = call)
+
+  x <- to_int(
+    x,
+    allow_null = allow_null,
+    coerce_character = coerce_character,
+    coerce_factor = coerce_factor,
+    x_arg = x_arg,
+    call = call
+  )
   .check_value_int(
     x,
     min_value = min_value, max_value = max_value,

R/to_int.R

@@ -6,6 +6,12 @@
 #' default values, but should be faster.
 #'
 #' @inheritParams .coerce-params
+#' @param coerce_character Logical. Should character vectors such as "1" and
+#'   "2.0" be coerced to integer?
+#' @param coerce_factor Logical. Should factors with values such as "1" and
+#'   "2.0" be coerced to integer? Note that this function uses the character
+#'   value from the factor, while [as.integer()] uses the integer index of the
+#'   factor.
 #'
 #' @return An integer equivalent to `x`.
 #' @export
@@ -16,12 +22,13 @@
 #' to_int(1 + 0i)
 to_int <- function(x,
                    allow_null = TRUE,
+                   coerce_character = TRUE,
+                   coerce_factor = TRUE,
                    x_arg = rlang::caller_arg(x),
                    call = rlang::caller_env()) {
   UseMethod("to_int")
 }
 
-
 #' @export
 to_int.integer <- function(x,
                            ...,
@@ -30,16 +37,9 @@ to_int.integer <- function(x,
   return(x)
 }
 
-#' @export
-to_int.hexmode <- function(x,
-                           ...,
-                           x_arg = rlang::caller_arg(x),
-                           call = rlang::caller_env()) {
-  return(as.integer(x))
-}
-
 #' @export
 to_int.NULL <- function(x,
+                        ...,
                         allow_null = TRUE,
                         x_arg = rlang::caller_arg(x),
                         call = rlang::caller_env()) {
@@ -71,39 +71,53 @@ to_int.logical <- function(x,
 #' @export
 to_int.character <- function(x,
                              ...,
+                             coerce_character = TRUE,
                              x_arg = rlang::caller_arg(x),
                              call = rlang::caller_env()) {
-  cast <- suppressWarnings(as.integer(x))
-  cast_double <- suppressWarnings(as.double(x))
-  x_na <- is.na(x)
-  non_numbers <- xor(x_na, is.na(cast))
-  bad_precision <- cast != cast_double & !x_na
-  failures <- non_numbers | bad_precision
+  if (coerce_character) {
+    cast <- suppressWarnings(as.integer(x))
+    cast_double <- suppressWarnings(as.double(x))
+    x_na <- is.na(x)
+    non_numbers <- xor(x_na, is.na(cast))
+    bad_precision <- cast != cast_double & !x_na
+    failures <- non_numbers | bad_precision
 
-  if (!any(failures)) {
-    return(cast)
-  }
+    if (!any(failures)) {
+      return(cast)
+    }
+
+    if (any(non_numbers)) {
+      .stop_incompatible(
+        x, integer(), non_numbers,
+        due_to = "incompatible values", x_arg, call
+      )
+    }
 
-  if (any(non_numbers)) {
     .stop_incompatible(
-      x, integer(), non_numbers,
-      due_to = "incompatible values", x_arg, call
+      x, integer(), bad_precision,
+      due_to = "loss of precision", x_arg, call
     )
   }
-
-  .stop_incompatible(
-    x, integer(), bad_precision,
-    due_to = "loss of precision", x_arg, call
+  cli::cli_abort(
+    "Can't coerce {.arg {x_arg}} to {.cls integer}.",
+    call = call
   )
 }
 
 #' @export
 to_int.factor <- function(x,
                           ...,
+                          coerce_factor = TRUE,
                           x_arg = rlang::caller_arg(x),
                           call = rlang::caller_env()) {
-  return(
-    to_int(as.character(x), ..., x_arg = x_arg, call = call)
+  if (coerce_factor) {
+    return(
+      to_int(as.character(x), ..., x_arg = x_arg, call = call)
+    )
+  }
+  cli::cli_abort(
+    "Can't coerce {.arg {x_arg}} to {.cls integer}.",
+    call = call
   )
 }
 

tests/testthat/_snaps/to_int.md

@@ -52,6 +52,22 @@
 
 # to_int() works for chrs
 
+    Code
+      to_int(given, coerce_character = FALSE)
+    Condition
+      Error:
+      ! Can't coerce `given` to <integer>.
+
+---
+
+    Code
+      wrapper(given, coerce_character = FALSE)
+    Condition
+      Error in `wrapper()`:
+      ! Can't coerce `wrapper_val` to <integer>.
+
+---
+
     Code
       to_int(given)
     Condition
@@ -70,6 +86,22 @@
       x Can't convert some values due to loss of precision.
       * Locations: 4
 
+---
+
+    Code
+      to_int(given, coerce_character = FALSE)
+    Condition
+      Error:
+      ! Can't coerce `given` to <integer>.
+
+---
+
+    Code
+      wrapper(given, coerce_character = FALSE)
+    Condition
+      Error in `wrapper()`:
+      ! Can't coerce `wrapper_val` to <integer>.
+
 ---
 
     Code
@@ -90,6 +122,22 @@
       x Can't convert some values due to incompatible values.
       * Locations: 4
 
+---
+
+    Code
+      to_int(given, coerce_character = FALSE)
+    Condition
+      Error:
+      ! Can't coerce `given` to <integer>.
+
+---
+
+    Code
+      wrapper(given, coerce_character = FALSE)
+    Condition
+      Error in `wrapper()`:
+      ! Can't coerce `wrapper_val` to <integer>.
+
 # to_int() works for complexes
 
     Code
@@ -112,6 +160,22 @@
 
 # to_int() works for factors
 
+    Code
+      to_int(given, coerce_factor = FALSE)
+    Condition
+      Error:
+      ! Can't coerce `given` to <integer>.
+
+---
+
+    Code
+      wrapper(given, coerce_factor = FALSE)
+    Condition
+      Error in `wrapper()`:
+      ! Can't coerce `wrapper_val` to <integer>.
+
+---
+
     Code
       to_int(given)
     Condition
@@ -130,7 +194,7 @@
       x Can't convert some values due to incompatible values.
       * Locations: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, ..., 25, and 26
 
-# to_int() works for hexbins, etc
+# to_int() errors properly for raw, etc
 
     Code
       to_int(given)

tests/testthat/test-stabilize_int.R

@@ -4,8 +4,6 @@ wrapper <- function(wrapper_val, ...) {
 
 # The _int part of this is tested in to_int.
 
-# TODO: Move NA and size checks into a general stabilize_vector()
-
 test_that("stabilize_int returns NULL", {
   expect_identical(
     stabilize_int(NULL),