Implemented S7 by swapping the rate class and subclasses from S3

DESCRIPTION

@@ -19,7 +19,8 @@ Imports:
     lifecycle (>= 1.0.3),
     magrittr (>= 1.5.0),
     rlang (>= 1.1.1),
-    vctrs (>= 0.6.3)
+    vctrs (>= 0.6.3),
+    S7 (>= 0.2.0)
 Suggests: 
     covr,
     dplyr (>= 0.7.8),

NAMESPACE

@@ -6,10 +6,6 @@ S3method(as_mapper,list)
 S3method(as_mapper,numeric)
 S3method(print,purrr_function_compose)
 S3method(print,purrr_function_partial)
-S3method(print,purrr_rate_backoff)
-S3method(print,purrr_rate_delay)
-S3method(rate_sleep,purrr_rate_backoff)
-S3method(rate_sleep,purrr_rate_delay)
 export("%>%")
 export("%@%")
 export("%||%")
@@ -200,6 +196,7 @@ export(walk)
 export(walk2)
 export(when)
 export(zap)
+import(S7)
 import(rlang)
 import(vctrs)
 importFrom(cli,cli_progress_bar)

R/package-purrr.R

@@ -1,6 +1,7 @@
 #' @keywords internal
 #' @import rlang
 #' @import vctrs
+#' @import S7
 #' @importFrom cli cli_progress_bar
 #' @importFrom lifecycle deprecated
 #' @useDynLib purrr, .registration = TRUE

R/rate.R

@@ -17,21 +17,66 @@
 #' @name rate-helpers
 NULL
 
+rate <- new_class(
+  "rate",
+  package = "purrr",
+  properties = list(
+    jitter = new_property(class_logical,
+      validator = function(value) {
+        if (!is_bool(value)) {
+          "must be a logical of length 1"
+        }
+      }
+    ),
+    max_times = new_property(class_numeric,
+      validator = function(value) {
+        if (!is_number(value, allow_infinite = TRUE)) {
+          "must be a numeric or `Inf`"
+        }
+      }
+    ), state = new_property(class_environment)
+  ),
+  constructor = function(jitter = TRUE, max_times = 3, state = env(i = 0L)) {
+    force(jitter)
+    force(max_times)
+    force(state)
+
+    new_object(S7_object(),
+      jitter = jitter, max_times = max_times, state = state
+    )
+  }
+)
+
+
 #' @rdname rate-helpers
 #' @param pause Delay between attempts in seconds.
 #' @export
-rate_delay <- function(pause = 1,
-                       max_times = Inf) {
-
-  check_number_decimal(pause, allow_infinite = TRUE, min = 0)
-
-  new_rate(
-    "purrr_rate_delay",
-    pause = pause,
-    max_times = max_times,
-    jitter = FALSE
-  )
-}
+rate_delay <- new_class("rate_delay",
+  parent = rate,
+  package = "purrr",
+  properties = list(
+    pause = new_property(class_numeric, validator = function(value) {
+      check_number_decimal(value, allow_infinite = TRUE, min = 0)
+    }),
+    max_times = new_property(class_numeric,
+      default = Inf,
+      validator = function(value) {
+        if (!is_number(value, allow_infinite = TRUE)) {
+          "must be a numeric or `Inf`"
+        }
+      }
+    )
+  ),
+  constructor = function(pause = 1, max_times = Inf, jitter = FALSE) {
+    force(pause)
+    force(jitter)
+    force(max_times)
+
+    new_object(rate(jitter = jitter, max_times = max_times),
+      pause = pause
+    )
+  }
+)
 
 #' @rdname rate-helpers
 #' @param pause_base,pause_cap `rate_backoff()` uses an exponential
@@ -41,72 +86,63 @@ rate_delay <- function(pause = 1,
 #'   only necessary if you need pauses less than one second (which may
 #'   not be kind to the server, use with caution!).
 #' @export
-rate_backoff <- function(pause_base = 1,
-                         pause_cap = 60,
-                         pause_min = 1,
-                         max_times = 3,
-                         jitter = TRUE) {
-
-  check_number_decimal(pause_base, min = 0)
-  check_number_decimal(pause_cap, allow_infinite = TRUE, min = 0)
-  check_number_decimal(pause_min, allow_infinite = TRUE, min = 0)
-  check_number_whole(max_times, min = 1)
-  check_bool(jitter)
-
-  new_rate(
-    "purrr_rate_backoff",
-    pause_base = pause_base,
-    pause_cap = pause_cap,
-    pause_min = pause_min,
-    max_times = max_times,
-    jitter = jitter
-  )
-}
-
-new_rate <- function(.subclass, ..., jitter = TRUE, max_times = 3) {
-  stopifnot(
-    is_bool(jitter),
-    is_number(max_times) || identical(max_times, Inf)
-  )
-
-  rate <- list(
-    ...,
-    state = env(i = 0L),
-    jitter = jitter,
-    max_times = max_times
-  )
+rate_backoff <- new_class(
+  "rate_backoff",
+  parent = rate,
+  package = "purrr",
+  properties = list(
+    pause_base = new_property(class_numeric, validator = function(value) {
+      check_number_decimal(value, min = 0) # TODO: maybe allow_infinite needs to be FALSE?
+    }),
+    pause_cap = new_property(class_numeric, validator = function(value) {
+      check_number_decimal(value, allow_infinite = TRUE, min = 0)
+    }),
+    pause_min = new_property(class_numeric, validator = function(value) {
+      check_number_decimal(value, allow_infinite = TRUE, min = 0)
+    })
+  ),
+  constructor = function(pause_base = 1, pause_cap = 60, pause_min = 1, max_times = 3, jitter = TRUE) {
+    force(pause_base)
+    force(pause_cap)
+    force(pause_min)
+    force(max_times)
+    force(jitter)
+
+    new_object(rate(jitter = jitter, max_times = max_times),
+      pause_base = pause_base, pause_cap = pause_cap, pause_min = pause_min
+    )
+  }
+)
 
-  structure(
-    rate,
-    class = c(.subclass, "purrr_rate")
-  )
-}
 #' @rdname rate-helpers
 #' @param x An object to test.
 #' @export
 is_rate <- function(x) {
-  inherits(x, "purrr_rate")
+  S7_inherits(x, rate)
 }
 
+
+base_print <- new_external_generic("base", "print", "x")
+
 #' @export
-print.purrr_rate_delay <- function(x, ...) {
+method(base_print, rate_delay) <- function(x, ...) {
   cli::cli_text("<rate: delay>")
   cli::cli_bullets(c(
-    " " = "Attempts: {rate_count(x)}/{x$max_times}",
-    " " = "{.field pause}: {x$pause}"
+    " " = "Attempts: {rate_count(x)}/{x@max_times}",
+    " " = "{.field pause}: {x@pause}"
   ))
 
   invisible(x)
 }
+
 #' @export
-print.purrr_rate_backoff <- function(x, ...) {
+method(base_print, rate_backoff) <- function(x, ...) {
   cli::cli_text("<rate: backoff>")
-
   cli::cli_bullets(c(
-    " " = "Attempts: {rate_count(x)}/{x$max_times}",
-    " " = "{.field pause_base}: {x$pause_base}",
-    " " = "{.field pause_cap}: {x$pause_cap}",
-    " " = "{.field pause_min}: {x$pause_min}"
+    " " = "Attempts: {rate_count(x)}/{x@max_times}",
+    " " = "{.field pause_base}: {x@pause_base}",
+    " " = "{.field pause_cap}: {x@pause_cap}",
+    " " = "{.field pause_min}: {x@pause_min}"
   ))
 
   invisible(x)
@@ -127,15 +163,15 @@ print.purrr_rate_backoff <- function(x, ...) {
 #' @seealso [rate_backoff()], [insistently()]
 #' @keywords internal
 #' @export
-rate_sleep <- function(rate, quiet = TRUE) {
+rate_sleep <- new_generic("rate_sleep", "rate", function(rate, ..., quiet = TRUE) {
   stopifnot(is_rate(rate))
 
   i <- rate_count(rate)
 
-  if (i > rate$max_times) {
+  if (i > rate@max_times) {
     stop_rate_expired(rate)
   }
-  if (i == rate$max_times) {
+  if (i == rate@max_times) {
     stop_rate_excess(rate)
   }
 
@@ -146,24 +182,24 @@ rate_sleep <- function(rate, quiet = TRUE) {
   }
 
   on.exit(rate_bump_count(rate))
-  UseMethod("rate_sleep")
-}
+  S7_dispatch()
+})
 
 #' @export
-rate_sleep.purrr_rate_backoff <- function(rate, quiet = TRUE) {
+method(rate_sleep, rate_backoff) <- function(rate, quiet = TRUE) {
   i <- rate_count(rate)
 
-  pause_max <- min(rate$pause_cap, rate$pause_base * 2^i)
-  if (rate$jitter) {
+  pause_max <- min(rate@pause_cap, rate@pause_base * 2^i)
+  if (rate@jitter) {
     pause_max <- stats::runif(1, 0, pause_max)
   }
 
-  length <- max(rate$pause_min, pause_max)
+  length <- max(rate@pause_min, pause_max)
   rate_sleep_impl(rate, length, quiet)
 }
 #' @export
-rate_sleep.purrr_rate_delay <- function(rate, quiet = TRUE) {
-  rate_sleep_impl(rate, rate$pause, quiet)
+method(rate_sleep, rate_delay) <- function(rate, quiet = TRUE) {
+  rate_sleep_impl(rate, rate@pause, quiet)
 }
 
 rate_sleep_impl <- function(rate, length, quiet) {
@@ -178,16 +214,16 @@ rate_sleep_impl <- function(rate, length, quiet) {
 rate_reset <- function(rate) {
   stopifnot(is_rate(rate))
 
-  rate$state$i <- 0L
+  rate@state$i <- 0L
 
   invisible(rate)
 }
 
 rate_count <- function(rate) {
-  rate$state$i
+  rate@state$i
 }
 rate_bump_count <- function(rate, n = 1L) {
-  rate$state$i <- rate$state$i + n
+  rate@state$i <- rate@state$i + n
   invisible(rate)
 }
 
@@ -236,4 +272,3 @@ check_rate <- function(rate, error_call = caller_env()) {
     )
   }
 }
-

R/zzz.R

@@ -0,0 +1,3 @@
+.onLoad <- function(lib, pkg) {
+  S7::methods_register()
+}

tests/testthat/_snaps/rate.md

@@ -18,15 +18,15 @@
 # rate_delay() delays
 
     Code
-      rate_sleep(rate)
+      rate_sleep(rd)
     Condition
       Error in `rate_sleep()`:
       ! Request failed after 3 attempts.
 
 ---
 
     Code
-      rate_sleep(rate)
+      rate_sleep(rd)
     Condition
       Error in `rate_sleep()`:
       ! This `rate` object has already be run more than `max_times` allows.
@@ -35,15 +35,15 @@
 # rate_backoff() backs off
 
     Code
-      rate_sleep(rate)
+      rate_sleep(rb)
     Condition
       Error in `rate_sleep()`:
       ! Request failed after 3 attempts.
 
 ---
 
     Code
-      rate_sleep(rate)
+      rate_sleep(rb)
     Condition
       Error in `rate_sleep()`:
       ! This `rate` object has already be run more than `max_times` allows.
@@ -52,15 +52,15 @@
 # rate_sleep() checks that rate is still valid
 
     Code
-      rate_sleep(rate)
+      rate_sleep(rd)
     Condition
       Error in `rate_sleep()`:
       ! Request failed after 0 attempts.
 
 ---
 
     Code
-      rate_sleep(rate)
+      rate_sleep(rd)
     Condition
       Error in `rate_sleep()`:
       ! This `rate` object has already be run more than `max_times` allows.