Idea on how shiny::ExtendedTask might be subclassed to support cancel/early stop of tasks which are mirai backed

MiraiExtendedTask.R

# credit Joe Cheng / jcheng5 / https://gist.github.com/jcheng5/1283baec96c05a65778d931a8b7c7314
# for mirai cancel concept
library(shiny)
library(mirai)
library(promises)
library(bslib)
library(R6)
# SETUP ####
# Define a subclass that inherits from ExtendedTask
MiraiExtendedTask <- R6::R6Class(
  "MiraiExtendedTask",
  inherit = ExtendedTask,
  public = list(
    stop_m = function() {
      stop_mirai(private$mirai_obj)
    }
  ),
  private = list(
    mirai_obj = NULL,
    do_invoke = function(args) {
      private$rv_status("running")
      private$rv_value(NULL)
      private$rv_error(NULL)

      p <- NULL
      tryCatch(
        {
          maskReactiveContext({
            # TODO: Bounce the do.call off of a promise_resolve(), so that the
            # call to invoke() always returns immediately?
            result <- do.call(private$func, args)
            private$mirai_obj <- result # <- here assign out to private mirai_obj for possible stop_m
            p <- promises::as.promise(result)
          })
        },
        error = function(e) {
          private$on_error(e)
        }
      )

      promises::finally(
        promises::then(p,
          onFulfilled = function(value, .visible) {
            private$on_success(list(value = value, visible = .visible))
          },
          onRejected = function(error) {
            private$on_error(error)
          }
        ),
        onFinally = function() {
          if (private$invocation_queue$size() > 0) {
            private$do_invoke(private$invocation_queue$remove())
          }
        }
      )

      invisible(NULL)
    }
  )
)

# USER EXAMPLE ####

ui <- page_fluid(
  input_task_button("go", "Go"),
  actionButton("stop", "Stop"),
  textOutput("out")
)

server <- function(input, output, session) {
  
  task <- MiraiExtendedTask$new(function() {
    mirai({
      Sys.sleep(5)
      "hello, world"
    })
  }) |> bind_task_button("go")

  observeEvent(input$go, {
    task$invoke()
  })

  observeEvent(input$stop, {
    task$stop_m()
  })

  output$out <- renderText({
    task$result()
  })

  observe({
    updateActionButton(session, "stop", disabled = !identical(task$status(), "running"))
  })
}

# shinyApp(ui, server)
app <- shinyApp(ui = ui, server = server)
with(daemons(2), runApp(app))