Relay properties of progressions as well

R/progress_aggregator.R

@@ -31,7 +31,7 @@ progress_aggregator <- function(progress) {
     } else if (type == "reset") {
     } else if (type == "shutdown") {
     } else if (type == "update") {
-      progress(child = p)
+      call_progressor_with_progression(progress, p)
     } else {
       ## Was this meant to be a 'control_progression' condition?
       if (type %in% c("reset", "shutdown", "hide", "unhide", "interrupt")) {
@@ -54,3 +54,24 @@ progress_aggregator <- function(progress) {
 
   fcn
 }
+
+#' Rewrite a progression condition and emit using another progressor
+#' 
+#' The progression condition `prog_cnd` is disassembled, the properties that are
+#' set by the original progressor are removed and the progression is re-created
+#' using the progressor `progr`.
+#' 
+call_progressor_with_progression <- function(progr, prog_cond){
+  c <- setdiff(class(prog_cond), c("progression", "immediateCondition", "condition"))
+  arg_list <- unclass(prog_cond)
+  # Remove all arguments from the list that are not included by the progressor
+  # (the function generated by a call to the progressor() function) into the 
+  # resulting condition object but are set by the progressor itself. See
+  # the function that is the return value of progressor() for those arguments.
+  arg_list$owner_session_uuid <- NULL
+  arg_list$progressor_uuid    <- NULL
+  arg_list$progression_index  <- NULL
+  arg_list$call               <- NULL
+  arg_list$calls              <- NULL
+  do.call(progr, arg_list)
+}

R/progressor.R

@@ -102,6 +102,9 @@ progressor <- local({
         type = type,
         message = message,
         ...,
+        # If adding values here that do not come from the parameters of this
+        # inner function, include them in call_progressor_with_progress() as 
+        # well
         progressor_uuid = progressor_uuid,
         progression_index = progression_index,
         owner_session_uuid = owner_session_uuid,

incl/progress_aggregator.R

@@ -3,11 +3,11 @@ library(progressr)
 message("progress_aggregator() ...")
 
 with_progress({
-  progress <- progressor(steps = 4L)
+  progress <- progressor(steps = 8L)
   relay_progress <- progress_aggregator(progress)
   progress()
-  relay_progress(slow_sum(1:3))
-  relay_progress(slow_sum(1:10))
+  relay_progress(slow_sum(1:2))
+  relay_progress(slow_sum(1:4))
   progress()
 })