descale()

NEWS.md

@@ -1,7 +1,7 @@
 # crew 0.9.2
 
 * Use `.args` rather than `...` in `mirai::mirai()` to make sure arguments continue to be passed as local variables in `mirai` >= 0.13.1.9012.
-* Add new controller methods `autoscale()` and `started()` to facilitate different kinds of Shiny apps.
+* Add new controller methods `autoscale()`, `descale()`, and `started()` to facilitate different kinds of Shiny apps.
 * Deprecate the `scale` and `throttle` methods of `controller$promise()`. `promise()` now always calls `autoscale()` to make sure one and only one auto-scaling loop is running asynchronously. Auto-scaling thus continues even after the promise resolves.
 * Add a second example vignette that simulates coin flips.
 

R/crew_controller.R

@@ -361,6 +361,8 @@ crew_class_controller <- R6::R6Class(
     },
     #' @description Run worker auto-scaling in a private `later` loop
     #'   every `controller$client$seconds_interval` seconds.
+    #' @details Call `controller$descale()` to terminate the
+    #'   auto-scaling loop.
     #' @param controllers Not used. Included to ensure the signature is
     #'   compatible with the analogous method of controller groups.
     #' @return `NULL` (invisibly).
@@ -382,6 +384,15 @@ crew_class_controller <- R6::R6Class(
       invisible()
       # nocov end
     },
+    #' @description Terminate the auto-scaling loop started by
+    #'   `controller$autoscale()`.
+    #' @param controllers Not used. Included to ensure the signature is
+    #'   compatible with the analogous method of controller groups.
+    #' @return `NULL` (invisibly).
+    descale = function(controllers = NULL) {
+      private$.autoscaling <- FALSE
+      invisible()
+    },
     #' @description Push a task to the head of the task list.
     #' @return Invisibly return the `mirai` object of the pushed task.
     #'   This allows you to interact with the task directly, e.g.

R/crew_controller_group.R

@@ -342,6 +342,15 @@ crew_class_controller_group <- R6::R6Class(
       walk(control, ~.x$autoscale())
       # nocov end
     },
+    #' @description Terminate the auto-scaling loop started by
+    #'   `controller$autoscale()`.
+    #' @param controllers Not used. Included to ensure the signature is
+    #'   compatible with the analogous method of controller groups.
+    #' @return `NULL` (invisibly).
+    descale = function(controllers = NULL) {
+      control <- private$.select_controllers(controllers)
+      walk(control, ~.x$descale())
+    },
     #' @description Push a task to the head of the task list.
     #' @return Invisibly return the `mirai` object of the pushed task.
     #'   This allows you to interact with the task directly, e.g.

tests/interactive/test-promises-groups.R

@@ -1,5 +1,5 @@
 # {later} async has a hard time inside functions that do not relinquish
-# the main event loop, so these tests need to run interactively.
+# the main event loop, so these tests need to run interactively line-by-line.
 crew_test("interactive: promise(mode = \"one\") on controller groups", {
   a <- crew_controller_local(
     name = "a",
@@ -104,5 +104,8 @@ crew_test("interactive: promise(mode = \"all\") on controller groups", {
   x$wait(mode = "all")
   expect_equal(envir$error, "error message")
   expect_null(envir$value)
+  expect_true(a$autoscaling)
+  x$descale()
+  expect_false(a$autoscaling)
   x$terminate()
 })

tests/interactive/test-promises.R

@@ -1,5 +1,5 @@
 # {later} async has a hard time inside functions that do not relinquish
-# the main event loop, so these tests need to run interactively.
+# the main event loop, so these tests need to run interactively line-by-line.
 crew_test("interactive: promise(mode = \"one\") on basic controllers", {
   x <- crew_controller_local(
     workers = 1L,
@@ -51,6 +51,7 @@ crew_test("interactive: promise(mode = \"all\") on basic controllers", {
   )
   x$start()
   x$push("done1")
+  Sys.sleep(0.1)
   x$push("done2")
   envir <- new.env(parent = emptyenv())
   # Test on good tasks.
@@ -87,5 +88,8 @@ crew_test("interactive: promise(mode = \"all\") on basic controllers", {
   x$wait(mode = "all")
   expect_equal(envir$error, "error message")
   expect_null(envir$value)
+  expect_true(x$autoscaling)
+  x$descale()
+  expect_false(x$autoscaling)
   x$terminate()
 })

tests/testthat/test-crew_controller.R

@@ -428,3 +428,10 @@ crew_test("backlog with saturation", {
     x$push(Sys.sleep(30), scale = FALSE)
   }
 })
+
+crew_test("descale", {
+  controller <- crew_controller_local()
+  expect_null(controller$autoscaling)
+  controller$descale()
+  expect_false(controller$autoscaling)
+})

tests/testthat/test-crew_controller_group.R

@@ -723,3 +723,11 @@ crew_test("group helper methods (non)empty, (un)resolved, unpopped", {
   expect_equal(x$unpopped(), 0L)
   x$terminate()
 })
+
+crew_test("descale", {
+  controller <- crew_controller_local()
+  x <- crew_controller_group(controller)
+  expect_null(controller$autoscaling)
+  x$descale()
+  expect_false(controller$autoscaling)
+})