Merge branch 'release/0.13.0'

.Rbuildignore

@@ -32,7 +32,7 @@ revdep
 #----------------------------
 # R related
 #----------------------------
-^man/_cache/
+^man/_cache
 Rplots.pdf$
 ^cran-comments[.].*$
 ^vignettes/.*[.](pdf|PDF)$

.github/workflows/R-CMD-check.yaml

@@ -63,7 +63,7 @@ jobs:
 
       - name: Cache R packages
         if: runner.os != 'Windows'
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}

.github/workflows/covr.yaml

@@ -42,7 +42,7 @@ jobs:
         shell: Rscript {0}
 
       - name: Cache R packages
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}

.github/workflows/revdepcheck-top.yaml

@@ -49,7 +49,7 @@ jobs:
 
       - name: Cache R packages
         if: runner.os != 'Windows'
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: progressr
-Version: 0.12.0
+Version: 0.13.0
 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(
@@ -26,6 +26,7 @@ Suggests:
     future,
     future.apply,
     furrr,
+    RPushbullet,
     rstudioapi,
     shiny,
     commonmark,

NAMESPACE

@@ -14,6 +14,7 @@ export(handler_notifier)
 export(handler_pbcol)
 export(handler_pbmcapply)
 export(handler_progress)
+export(handler_rpushbullet)
 export(handler_rstudio)
 export(handler_shiny)
 export(handler_tkprogressbar)

NEWS.md

@@ -1,3 +1,48 @@
+# Version 0.13.0 [2023-01-09]
+
+## Significant Changes
+
+ * Now the 'shiny' and 'filesize' handlers are enabled by
+   default. Previously, they were only enabled in interactive mode,
+   but as these are frequently used also in non-interactive mode, it's
+   less confusing if they're always enabled, e.g. Shiny applications
+   are often run via a Shiny servers. These handlers can be disabled
+   by setting R option `progressr.enable` to FALSE.
+
+ * Option `progressr.intrusiveness.auditory` has been renamed to
+   `progressr.intrusiveness.audio`.
+
+## New Features
+
+ * Add `handler_rpushbullet()` for reporting on progress via the
+   Pushbullet Messaging Service using the **RPushbullet** package.
+
+ * Now also 'beepr', 'debug', 'filesize', 'notifier', 'rpushbullet',
+   'shiny', 'tkprogressbar', and 'winprogressbar' handlers report on
+   interrupts.
+
+ * Now progress updates of type "finish" supports also updating the
+   progress state, e.g. you can do `p(amount = 1.0, type = "finish")`
+   whereas previously you had to do `p(amount = 1.0)` and then `p(type
+   = "finish")` resulting in two progress conditions being signaled.
+
+## Bug Fixes
+
+ * When using multiple progression handlers, it would only be first one
+   that was updated as the progressor completed, whereas any following
+   ones would not receive that last update.
+
+ * The 'cli' handler would output a newline when completed.
+
+ * The 'cli' handler did not handle zero-length progressors resulting
+   in `Error in rep(chr_complete, complete_len) : invalid 'times'
+   argument` when the progressor completed.
+
+ * The 'cli' handler did not work when the **cli** package was
+   configured to report on progress via **progressr**, i.e. when
+   setting `options(cli.progress_handlers = "progressr")`.
+
+
 # Version 0.12.0 [2022-12-12]
 
 ## Significant Changes

R/global_progression_handler.R

@@ -261,6 +261,7 @@ global_progression_handler <- local({
 
   function(condition) {
     if (is.logical(condition)) {
+      stop_if_not(length(condition) == 1L, !is.na(condition))
       active <<- condition
       return()
     }

R/handler_ascii_alert.R

@@ -14,7 +14,7 @@
 #' @example incl/handler_ascii_alert.R
 #'
 #' @export
-handler_ascii_alert <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = c("terminal", "audio"), ...) {
+handler_ascii_alert <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.audio", 5.0), target = c("terminal", "audio"), ...) {
   reporter <- local({
     list(
       hide   = function(...) NULL,

R/handler_beepr.R

@@ -4,8 +4,9 @@
 #'
 #' @inheritParams make_progression_handler
 #'
-#' @param initiate,update,finish (integer) Indices of [beepr::beep()] sounds to
-#'  play when progress starts, is updated, and completes.  For silence, use `NA_integer_`.
+#' @param initiate,update,finish,interrupt (integer) Indices of [beepr::beep()]
+#' sounds to play when progress starts, is updated, completes, or is
+#' interrupted.  For silence, use `NA_integer_`.
 #'
 #' @param \ldots Additional arguments passed to [make_progression_handler()].
 #'
@@ -15,7 +16,7 @@
 #' This progression handler requires the \pkg{beepr} package.
 #'
 #' @export
-handler_beepr <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = "audio", ...) {
+handler_beepr <- function(initiate = 2L, update = 10L,  finish = 11L, interrupt = 9L, intrusiveness = getOption("progressr.intrusiveness.audio", 5.0), target = "audio", ...) {
   ## Used for package testing purposes only when we want to perform
   ## everything except the last part where the backend is called
   if (!is_fake("handler_beepr")) {
@@ -38,6 +39,10 @@ handler_beepr <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiven
 	beep(initiate)
       },
 
+      interrupt = function(config, state, progression, ...) {
+        beep(interrupt)
+      },
+
       update = function(config, state, progression, ...) {
         if (!state$enabled || progression$amount == 0 || config$times <= 2L) return()
         beep(update)

R/handler_cli.R

@@ -53,7 +53,7 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
     cli_progress_call <- function(fun, ...) {
       opts <- cli_freeze_color_options()
       on.exit(options(opts), add = TRUE)
-      
+
       withCallingHandlers({
         res <- fun(...)
       }, cliMessage = function(msg) {
@@ -67,20 +67,32 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
         cat(output, file = stderr())
         invokeRestart("muffleMessage")
       })
-      
+
       invisible(res)
     }
 
-    cli_progress_bar <- function(...) {
-      cli_progress_call(cli::cli_progress_bar, ...)
+    cli_progress_bar <- function(total, ...) {
+      ## WORKAROUND: Do no not involve 'cli' when total = 0
+      if (total == 0) return(NA_character_)
+
+      ## Make sure to always use the built-in 'cli' handler, no matter
+      ## what 'cli.progress_handlers*' options might be set
+      opts2 <- options(cli.progress_handlers_only = "cli")
+      on.exit(options(opts2), add = TRUE)
+
+      cli_progress_call(cli::cli_progress_bar, total = total, ...)
     }
 
-    cli_progress_update <- function(...) {
-      cli_progress_call(cli::cli_progress_update, ...)
+    cli_progress_update <- function(id, ..., force = TRUE, .envir) {
+      ## WORKAROUND: Do no not involve 'cli' when total = 0
+      if (.envir$total == 0) return(id)
+      cli_progress_call(cli::cli_progress_update, id = id, ..., force = force, .envir = .envir)
     }
 
-    cli_progress_done <- function(...) {
-      cli_progress_call(cli::cli_progress_done, ...)
+    cli_progress_done <- function(id, ..., .envir) {
+      ## WORKAROUND: Do no not involve 'cli' when total = 0
+      if (.envir$total == 0) return(id)
+      cli_progress_call(cli::cli_progress_done, id = id, ..., .envir = .envir)
     }
 
     erase_progress_bar <- function(pb) {
@@ -102,9 +114,9 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
       cli_progress_update(id = pb$id, inc = 0, .envir = pb$envir)
     }
   } else {
-    cli_progress_bar <- function(...) "id-dummy"
-    cli_progress_update <- function(...) "id-dummy"
-    cli_progress_done <- function(...) "id-dummy"
+    cli_progress_bar <- function(total, ...) "id-dummy"
+    cli_progress_update <- function(id, ..., force = TRUE, .envir) "id-dummy"
+    cli_progress_done <- function(id, ..., .envir) "id-dummy"
     erase_progress_bar <- function(pb) NULL
     redraw_progress_bar <- function(pb) NULL
   }
@@ -118,6 +130,7 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
         is.numeric(total), length(total) == 1L, is.finite(total)
       )
       envir <- new.env()
+      envir$total <- total
       args <- c(list(total = total, ..., .envir = envir), backend_args)
       args$clear <- FALSE
       args$auto_terminate <- FALSE
@@ -136,7 +149,7 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
     pb_tick <- function(pb, delta = 0, message = NULL, ...) {
       if (is.null(pb)) return()
       stopifnot(
-        is.character(pb$id), length(pb$id) == 1L, !is.na(pb$id),
+        is.character(pb$id), length(pb$id) == 1L,
         is.numeric(delta), length(delta) == 1L, is.finite(delta),
         is.environment(pb$envir)
       )
@@ -160,7 +173,6 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
       if (ratio >= 1.0) {
         cli_progress_done(id = pb$id, .envir = pb$envir)
         erase_progress_bar(pb)
-        cat("\n", file = stderr())
       } else {
         set <- ratio * pb$total
         stopifnot(length(set) == 1L, is.numeric(set), is.finite(set),
@@ -226,8 +238,8 @@ handler_cli <- function(show_after = 0.0, intrusiveness = getOption("progressr.i
         if (config$clear) {
           pb_update(pb, ratio = 1.0)
         } else {
-          cat("\n", file = stderr())
-        }      
+          cat(file = stderr(), "\n")
+        }
 
         pb <<- NULL
       }

R/handler_debug.R

@@ -50,7 +50,9 @@ handler_debug <- function(interval = getOption("progressr.interval", 0), intrusi
 
       unhide = function(...) NULL,
 
-      interrupt = function(...) NULL,
+      interrupt = function(...) {
+        add_to_log("interrupt", ...)
+      },
 
       initiate = function(...) {
         add_to_log("initiate", ...)

R/handler_filesize.R

@@ -24,9 +24,9 @@
 #'
 #' @importFrom utils file_test
 #' @export
-handler_filesize <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", ...) {
+handler_filesize <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", enable = getOption("progressr.enable", TRUE), ...) {
   reporter <- local({
-    set_file_size <- function(config, state, progression) {
+    set_file_size <- function(config, state, progression, message = state$message) {
       ratio <- if (config$max_steps == 0) 1 else state$step / config$max_steps
       size <- round(100 * ratio)
       current_size <- file.size(file)
@@ -38,7 +38,7 @@ handler_filesize <- function(file = "default.progress", intrusiveness = getOptio
       nhead <- nchar(head)
       tail <- sprintf(" [%d%%]", round(100 * ratio))
       ntail <- nchar(tail)
-      mid <- paste0(state$message, "")
+      mid <- paste0(message, "")
       nmid <- nchar(mid)
       padding <- size - (nhead + nmid + ntail)
       if (padding <= 0) {
@@ -57,6 +57,11 @@ handler_filesize <- function(file = "default.progress", intrusiveness = getOptio
         set_file_size(config = config, state = state, progression = progression)
       },
 
+      interrupt = function(config, state, progression, ...) {
+        msg <- getOption("progressr.interrupt.message", "interrupt detected")
+        set_file_size(config = config, state = state, progression = progression, message = msg)
+      },
+
       update = function(config, state, progression, ...) {
         set_file_size(config = config, state = state, progression = progression)
       },
@@ -71,5 +76,5 @@ handler_filesize <- function(file = "default.progress", intrusiveness = getOptio
     )
   })
 
-  make_progression_handler("filesize", reporter, intrusiveness = intrusiveness, target = target, ...)
+  make_progression_handler("filesize", reporter, intrusiveness = intrusiveness, target = target, enable = enable, ...)
 }

R/handler_notifier.R

@@ -32,7 +32,8 @@ handler_notifier <- function(intrusiveness = getOption("progressr.intrusiveness.
     ratio <- if (max_steps == 0) 1 else step / max_steps
     ratio <- sprintf("%.0f%%", 100*ratio)
     msg <- paste(c("", message), collapse = "")
-    notifier_notify(sprintf("[%s] %s", ratio, msg))
+    msg <- sprintf("[%s] %s", ratio, msg)
+    notifier_notify(msg)
   }
 
   reporter <- local({
@@ -43,6 +44,11 @@ handler_notifier <- function(intrusiveness = getOption("progressr.intrusiveness.
         finished <<- FALSE
       },
 
+      interrupt = function(config, state, progression, ...) {
+        msg <- getOption("progressr.interrupt.message", "interrupt detected")
+        notify(step = state$step, max_steps = config$max_steps, message = msg)
+      },
+
       initiate = function(config, state, progression, ...) {
         if (!state$enabled || config$times == 1L) return()
         notify(step = state$step, max_steps = config$max_steps, message = state$message)

R/handler_pbmcapply.R

@@ -80,13 +80,15 @@ handler_pbmcapply <- function(char = "=", substyle = 3L, style = "ETA", file = s
       if (!is.null(pb)) return(pb)
 
       ## SPECIAL CASE: pbmcapply::progressBar() does not support max == min
+      ## (its 'min' argument defaults to 0)
       if (max == 0) {
-        pb <- txtProgressBar()
-        class(pb) <- c("voidProgressBar", class(pb))
+        pb_tmp <- txtProgressBar()
+        class(pb_tmp) <- c("voidProgressBar", class(pb_tmp))
       } else {
         args <- c(list(max = max, ...), backend_args)
-        pb <<- do.call(progressBar, args = args)
+        pb_tmp <- do.call(progressBar, args = args)
       }
+      pb <<- pb_tmp
 
       pb
     }
@@ -121,6 +123,7 @@ handler_pbmcapply <- function(char = "=", substyle = 3L, style = "ETA", file = s
       update = function(config, state, progression, ...) {
         if (!state$enabled || config$times <= 2L) return()
         make_pb(max = config$max_steps, file = file)
+        stop_if_not(!is.null(pb))
         if (inherits(progression, "sticky")) {
           eraseTxtProgressBar(pb)
           message(paste0(state$message, ""))