Experimental support for progressor(..., finalize = TRUE)

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: progressr
-Version: 0.17.0-9003
+Version: 0.17.0-9004
 Title: An Inclusive, Unifying API for Progress Updates
 Description: A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing.  The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it.  The end user has full control of how, where, and when to render these progress updates, e.g. in the terminal using utils::txtProgressBar(), cli::cli_progress_bar(), in a graphical user interface using utils::winProgressBar(), tcltk::tkProgressBar() or shiny::withProgress(), via the speakers using beepr::beep(), or on a file system via the size of a file. Anyone can add additional, customized, progression handlers. The 'progressr' package uses R's condition framework for signaling progress updated. Because of this, progress can be reported from almost anywhere in R, e.g. from classical for and while loops, from map-reduce API:s like the lapply() family of functions, 'purrr', 'plyr', and 'foreach'. It will also work with parallel processing via the 'future' framework, e.g. future.apply::future_lapply(), furrr::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications.
 Authors@R: c(person("Henrik", "Bengtsson",

NEWS.md

@@ -5,6 +5,15 @@
  * Add `length()` for `progressor` objects, which enables using
    `seq_along()` and `seq()` on progressors.
 
+## Beta Features
+
+ * Add experimental support for `progressor(..., finalize = TRUE)`,
+   which will cause the progressor to signal a progression 'shutdown'
+   condition when the progressor is garbage collected. This can serve
+   as a backstop in yet-to-be-observed cases where a progressor did
+   not shutdown properly leaving for instance active sinks behind.
+   For now, `finalize = FALSE` is the default.
+
 ## Bug Fixes
 
  * It was not possible to create more than one progressor in a

R/progressor.R

@@ -22,6 +22,9 @@
 #' @param initiate (logical) If TRUE, the progressor will signal a
 #' [progression] 'initiate' condition when created.
 #'
+#' @param finalize (logical) If TRUE, the progressor signals a [progression]
+#' 'shutdown' condition when finalized by the garbage collector.
+#'
 #' @param auto_finish (logical) If TRUE, then the progressor will signal a
 #' [progression] 'finish' condition as soon as the last step has been reached.
 #'
@@ -60,7 +63,7 @@ progressor <- local({
   environment(void_progressor)$enable <- FALSE
   class(void_progressor) <- c("progressor", class(void_progressor))
 
-  function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, trace = FALSE, initiate = TRUE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), enable = getOption("progressr.enable", TRUE), envir = parent.frame()) {
+  function(steps = length(along), along = NULL, offset = 0L, scale = 1L, transform = function(steps) scale * steps + offset, message = character(0L), label = NA_character_, trace = FALSE, initiate = TRUE, finalize = FALSE, auto_finish = TRUE, on_exit = !identical(envir, globalenv()), enable = getOption("progressr.enable", TRUE), envir = parent.frame()) {
     stop_if_not(is.logical(enable), length(enable) == 1L, !is.na(enable))
 
     ## Quickly return a moot progressor function?
@@ -113,7 +116,7 @@ progressor <- local({
         muffleProgression = function(p) NULL
       )
       invisible(cond)
-    }
+    } ## fcn()
     formals(fcn)$message <- message
     class(fcn) <- c("progressor", class(fcn))
 
@@ -163,6 +166,18 @@ progressor <- local({
       do.call(base::on.exit, args = list(call, add = TRUE), envir = envir)
     }
 
+    if (finalize) {
+      ## Self-reference progressor function needed by the finalizer function
+      progressor_envir$self <- fcn
+      reg.finalizer(progressor_envir, function(e) {
+        print(utils::ls.str(e))
+        if (is.function(e$self)) {
+          e$self(type = "shutdown")
+          e$self <- NULL
+        }
+      })
+    }
+
     fcn
   }
 })