Cancellable tasks (without async)

gistfile1.txt

base_task_iterator <- function(should_continue, iter_body) {
  if (should_continue()) {
    iter_body()
    later::later(~base_task_iterator(should_continue, iter_body))
  }

  invisible()
}

while_task_iterator <- function(cancelExpr, whileExpr, func) {
  cancelFunc <- rlang::as_function(rlang::enquo(cancelExpr))
  whileFunc <- rlang::as_function(rlang::enquo(whileExpr))
  
  origCancelVal <- isolate(try(silent = TRUE, cancelFunc()))
  cancelled <- function() {
    !identical(origCancelVal, isolate(try(silent = TRUE, cancelFunc())))
  }
  
  base_task_iterator(
    function() {
      !cancelled() && whileFunc()
    },
    func
  )
}

list_task_iterator <- function(cancelExpr, x, func) {
  cancelExpr <- rlang::enquo(cancelExpr)

  origCancelVal <- isolate(try(silent = TRUE, cancelFunc()))
  pos <- 1

  while_task_iterator(!!cancelExpr, pos <= length(x), function() {
    i <- pos
    pos <<- pos + 1L
    func(x[[i]])
  })
}

gistfile2.txt

library(shiny)

ui <- fluidPage(
  actionButton("start_list", "Start 'list' iterator"),
  actionButton("start_while", "Start 'while' iterator"),
  actionButton("cancel", "Stop")
)

server <- function(input, output, session) {
  observeEvent(input$start_list, {
    list_task_iterator(input$cancel, 1:10, function(x) {
      message(x)
      Sys.sleep(1)
    })
  })
  
  observeEvent(input$start_while, {
    # Something's wrong with rlang::as_function, I can't use TRUE, only !FALSE
    while_task_iterator(input$cancel, !FALSE, function() {
      message(format(Sys.time()))
      Sys.sleep(1)
    })
  })
}

shinyApp(ui, server)