diff --git a/R/progress_aggregator.R b/R/progress_aggregator.R index 8e1fe12..d7bd24b 100644 --- a/R/progress_aggregator.R +++ b/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) +} diff --git a/R/progressor.R b/R/progressor.R index 173da4f..5311fbf 100644 --- a/R/progressor.R +++ b/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, diff --git a/incl/progress_aggregator.R b/incl/progress_aggregator.R index cc470b4..94de9df 100644 --- a/incl/progress_aggregator.R +++ b/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() }) diff --git a/man/progress_aggregator.Rd b/man/progress_aggregator.Rd index 52308ec..04e3bb7 100644 --- a/man/progress_aggregator.Rd +++ b/man/progress_aggregator.Rd @@ -21,11 +21,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() })