From f76c04ff2e91a18d3386033cf013a8641f910ad9 Mon Sep 17 00:00:00 2001
From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com>
Date: Mon, 10 Mar 2025 21:27:45 +0000
Subject: [PATCH 1/2] Implements `$cancel()` method for ExtendedTask
---
DESCRIPTION | 1 +
R/extended-task.R | 19 +++++++++++++++++++
man/ExtendedTask.Rd | 20 ++++++++++++++++++++
3 files changed, 40 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
index 122fa6770..87729acc9 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -108,6 +108,7 @@ Suggests:
magrittr,
yaml,
future,
+ mirai,
dygraphs,
ragg,
showtext,
diff --git a/R/extended-task.R b/R/extended-task.R
index e29e78daf..5763def4b 100644
--- a/R/extended-task.R
+++ b/R/extended-task.R
@@ -194,6 +194,23 @@ ExtendedTask <- R6Class("ExtendedTask", portable = TRUE, cloneable = FALSE,
# default case (initial, cancelled)
req(FALSE)
)
+ },
+ #' @description
+ #' Attempts to cancel the current `ExtendedTask` invocation. Only supported
+ #' for tasks created using \CRANpkg{mirai}.
+ #'
+ #' Returns one of the following values:
+ #'
+ #' * `TRUE`: A cancellation request was successfully sent for this
+ #' `ExtendedTask`.
+ #' * `FALSE`: The `ExtendedTask` has already completed or was previously
+ #' cancelled.
+ cancel = function() {
+ if (inherits(private$task, c("mirai", "mirai_map"))) {
+ mirai::stop_mirai(private$task)
+ } else {
+ warning("Only mirai ExtendedTasks support cancellation", immediate. = TRUE)
+ }
}
),
private = list(
@@ -203,6 +220,7 @@ ExtendedTask <- R6Class("ExtendedTask", portable = TRUE, cloneable = FALSE,
rv_value = NULL,
rv_error = NULL,
invocation_queue = NULL,
+ task = NULL,
do_invoke = function(args) {
private$rv_status("running")
@@ -216,6 +234,7 @@ ExtendedTask <- R6Class("ExtendedTask", portable = TRUE, cloneable = FALSE,
# call to invoke() always returns immediately?
result <- do.call(private$func, args)
p <- promises::as.promise(result)
+ private$task <- result
})
}, error = function(e) {
private$on_error(e)
diff --git a/man/ExtendedTask.Rd b/man/ExtendedTask.Rd
index ade5334bd..570569624 100644
--- a/man/ExtendedTask.Rd
+++ b/man/ExtendedTask.Rd
@@ -102,6 +102,7 @@ shinyApp(ui, server)
\item \href{#method-ExtendedTask-invoke}{\code{ExtendedTask$invoke()}}
\item \href{#method-ExtendedTask-status}{\code{ExtendedTask$status()}}
\item \href{#method-ExtendedTask-result}{\code{ExtendedTask$result()}}
+\item \href{#method-ExtendedTask-cancel}{\code{ExtendedTask$cancel()}}
}
}
\if{html}{\out{
}}
@@ -214,5 +215,24 @@ invalidation will be ignored.
\if{html}{\out{}}\preformatted{ExtendedTask$result()}\if{html}{\out{
}}
}
+}
+\if{html}{\out{
}}
+\if{html}{\out{}}
+\if{latex}{\out{\hypertarget{method-ExtendedTask-cancel}{}}}
+\subsection{Method \code{cancel()}}{
+Attempts to cancel the current \code{ExtendedTask} invocation. Only supported
+for tasks created using \CRANpkg{mirai}.
+
+Returns one of the following values:
+\itemize{
+\item \code{TRUE}: A cancellation request was successfully sent for this
+\code{ExtendedTask}.
+\item \code{FALSE}: The \code{ExtendedTask} has already completed or was previously
+cancelled.
+}
+\subsection{Usage}{
+\if{html}{\out{}}\preformatted{ExtendedTask$cancel()}\if{html}{\out{
}}
+}
+
}
}
From 73e84884d48f8fb4bae40f5564abacecfb1fb4e0 Mon Sep 17 00:00:00 2001
From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com>
Date: Wed, 12 Mar 2025 16:09:35 +0000
Subject: [PATCH 2/2] Updates ExtendedTask example with cancellation
---
R/extended-task.R | 30 ++++++++++++++++++++++--------
man/ExtendedTask.Rd | 30 ++++++++++++++++++++++--------
2 files changed, 44 insertions(+), 16 deletions(-)
diff --git a/R/extended-task.R b/R/extended-task.R
index 5763def4b..80e2437e3 100644
--- a/R/extended-task.R
+++ b/R/extended-task.R
@@ -41,12 +41,13 @@
#' is, a function that quickly returns a promise) and allows even that very
#' session to immediately unblock and carry on with other user interactions.
#'
-#' @examplesIf rlang::is_interactive() && rlang::is_installed("future")
-#'
+#' @examplesIf rlang::is_interactive() && rlang::is_installed("mirai")
#' library(shiny)
#' library(bslib)
-#' library(future)
-#' plan(multisession)
+#' library(mirai)
+#'
+#' daemons(1)
+#' onStop(function() daemons(0))
#'
#' ui <- page_fluid(
#' titlePanel("Extended Task Demo"),
@@ -55,18 +56,18 @@
#' "that takes a while to perform."
#' ),
#' input_task_button("recalculate", "Recalculate"),
+#' actionButton("cancel", "Cancel"),
#' p(textOutput("result"))
#' )
#'
#' server <- function(input, output) {
#' rand_task <- ExtendedTask$new(function() {
-#' future(
+#' mirai(
#' {
#' # Slow operation goes here
#' Sys.sleep(2)
#' sample(1:100, 1)
-#' },
-#' seed = TRUE
+#' }
#' )
#' })
#'
@@ -76,10 +77,23 @@
#' bind_task_button(rand_task, "recalculate")
#'
#' observeEvent(input$recalculate, {
-#' # Invoke the extended in an observer
+#' # Invoke the task in an observer.
#' rand_task$invoke()
#' })
#'
+#' observeEvent(input$cancel, {
+#' # For cancelling the task if required.
+#' rand_task$cancel()
+#' })
+#'
+#' observe({
+#' # Disable cancel button when task is not running.
+#' updateActionButton(
+#' inputId = "cancel",
+#' disabled = rand_task$status() != "running"
+#' )
+#' })
+#'
#' output$result <- renderText({
#' # React to updated results when the task completes
#' number <- rand_task$result()
diff --git a/man/ExtendedTask.Rd b/man/ExtendedTask.Rd
index 570569624..b3d866f0f 100644
--- a/man/ExtendedTask.Rd
+++ b/man/ExtendedTask.Rd
@@ -46,12 +46,13 @@ session to immediately unblock and carry on with other user interactions.
}
\examples{
-\dontshow{if (rlang::is_interactive() && rlang::is_installed("future")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
-
+\dontshow{if (rlang::is_interactive() && rlang::is_installed("mirai")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
library(shiny)
library(bslib)
-library(future)
-plan(multisession)
+library(mirai)
+
+daemons(1)
+onStop(function() daemons(0))
ui <- page_fluid(
titlePanel("Extended Task Demo"),
@@ -60,18 +61,18 @@ ui <- page_fluid(
"that takes a while to perform."
),
input_task_button("recalculate", "Recalculate"),
+ actionButton("cancel", "Cancel"),
p(textOutput("result"))
)
server <- function(input, output) {
rand_task <- ExtendedTask$new(function() {
- future(
+ mirai(
{
# Slow operation goes here
Sys.sleep(2)
sample(1:100, 1)
- },
- seed = TRUE
+ }
)
})
@@ -81,10 +82,23 @@ server <- function(input, output) {
bind_task_button(rand_task, "recalculate")
observeEvent(input$recalculate, {
- # Invoke the extended in an observer
+ # Invoke the task in an observer.
rand_task$invoke()
})
+ observeEvent(input$cancel, {
+ # For cancelling the task if required.
+ rand_task$cancel()
+ })
+
+ observe({
+ # Disable cancel button when task is not running.
+ updateActionButton(
+ inputId = "cancel",
+ disabled = rand_task$status() != "running"
+ )
+ })
+
output$result <- renderText({
# React to updated results when the task completes
number <- rand_task$result()