Merge pull request #942 from rstudio/task-button

Add input_task_button, an actionButton with busy state

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: bslib
 Title: Custom 'Bootstrap' 'Sass' Themes for 'shiny' and 'rmarkdown'
-Version: 0.6.1.9000
+Version: 0.6.1.9001
 Authors@R: c(
     person("Carson", "Sievert", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-4958-2844")),
@@ -28,9 +28,12 @@ URL: https://rstudio.github.io/bslib/, https://github.com/rstudio/bslib
 BugReports: https://github.com/rstudio/bslib/issues
 Depends:
     R (>= 2.10)
+Remotes:
+    rstudio/shiny
 Imports:
     base64enc,
     cachem,
+    fastmap (>= 1.1.1),
     grDevices,
     htmltools (>= 0.5.7),
     jquerylib (>= 0.1.3),
@@ -44,6 +47,7 @@ Suggests:
     bsicons,
     curl,
     fontawesome,
+    future,
     ggplot2,
     knitr,
     magrittr,
@@ -124,6 +128,7 @@ Collate:
     'bs-theme-update.R'
     'bs-theme.R'
     'bslib-package.R'
+    'buttons.R'
     'card.R'
     'deprecated.R'
     'files.R'

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as.tags,bslib_sidebar)
+S3method(bind_task_button,ExtendedTask)
+S3method(bind_task_button,default)
 S3method(is_fill_item,default)
 S3method(is_fill_item,htmlwidget)
 S3method(is_fillable_container,default)
@@ -24,6 +26,7 @@ export(as.card_item)
 export(as_fill_carrier)
 export(as_fill_item)
 export(as_fillable_container)
+export(bind_task_button)
 export(bootstrap)
 export(bootstrap_sass)
 export(bootswatch_themes)
@@ -78,6 +81,7 @@ export(font_google)
 export(font_link)
 export(input_dark_mode)
 export(input_switch)
+export(input_task_button)
 export(is.card_item)
 export(is_bs_theme)
 export(is_fill_carrier)
@@ -142,6 +146,7 @@ export(toggle_tooltip)
 export(tooltip)
 export(update_popover)
 export(update_switch)
+export(update_task_button)
 export(update_tooltip)
 export(value_box)
 export(value_box_theme)

NEWS.md

@@ -6,6 +6,10 @@
 
 * A `sidebar()` passed to `page_sidebar()`/`page_navbar()` is now always open (and not collapsible) by default on mobile screens. To revert to the old behavior, set `open = "desktop"` in the `sidebar`. (#943)
 
+## New features
+
+* Added `input_task_button()`, a replacement for `shiny::actionButton()` that automatically prevents an operation from being submitted multiple times. It does this by, upon click, immediately transitioning to a "Processing..." visual state that does not let the button be clicked again. The button resets to its clickable state automatically after the reactive flush it causes is complete; or, for advanced scenarios, `update_task_button()` can be used to manually control when the button resets.
+
 ## Improvements
 
 * `layout_columns()` was rewritten in Typescript as a custom element to improve the portability of the component. (#931)

R/buttons.R

@@ -0,0 +1,301 @@
+#' Button for launching longer-running operations
+#'
+#' @description
+#' `input_task_button` is a button that can be used in conjuction with
+#' [shiny::bindEvent()] (or the older [shiny::eventReactive()] and
+#' [shiny::observeEvent()] functions) to trigger actions or recomputation.
+#'
+#' It is similar to [shiny::actionButton()], except it prevents the user from
+#' clicking when its operation is already in progress.
+#'
+#' Upon click, it automatically displays a customizable progress message and
+#' disables itself; and after the server has dealt with whatever reactivity is
+#' triggered from the click, the button automatically reverts to its original
+#' appearance and re-enables itself.
+#'
+#' @section Manual button reset:
+#' In some advanced use cases, it may be necessary to keep a task button in its
+#' busy state even after the normal reactive processing has completed. Calling
+#' `update_task_button(id, state = "busy")` from the server will opt out of any
+#' currently pending reset for a specific task button. After doing so, the
+#' button can be re-enabled by calling `update_task_button(id, state = "ready")`
+#' after each click's work is complete.
+#'
+#' You can also pass an explicit `auto_reset = FALSE` to `input_task_button()`,
+#' which means that button will _never_ be automatically re-enabled and will
+#' require `update_task_button(id, state = "ready")` to be called each time.
+#'
+#' Note that, as a general rule, Shiny's `update` family of functions do not
+#' take effect at the instant that they are called, but are held until the end
+#' of the current reactive cycle. So if you have many different reactive
+#' calculations and outputs, you don't have to be too careful about when you
+#' call `update_task_button(id, state = "ready")`, as the button on the client
+#' will not actually re-enable until the same moment that all of the updated
+#' outputs simultaneously sent to the client.
+#'
+#' @param id The `input` slot that will be used to access the value.
+#' @param label The label of the button while it is in ready (clickable) state;
+#'   usually a string.
+#' @param icon An optional icon to display next to the label while the button is
+#'   in ready state. See [fontawesome::fa_i()].
+#' @param label_busy The label of the button while it is busy.
+#' @param icon_busy The icon to display while the button is busy. By default,
+#'   `fontawesome::fa_i("refresh", class = "fa-spin", "aria-hidden" = "true")`
+#'   is used, which displays a spinning "chasing arrows" icon. You can create
+#'   spinning icons out of other Font Awesome icons by using the same
+#'   expression, but replacing `"refresh"` with a different icon name. See
+#'   [fontawesome::fa_i()].
+#' @param type One of the Bootstrap theme colors (`"primary"`, `"default"`,
+#'   `"secondary"`, `"success"`, `"danger"`, `"warning"`, `"info"`, `"light"`,
+#'   `"dark"`), or `NULL` to leave off the Bootstrap-specific button CSS classes
+#'   altogether.
+#' @param ... Named arguments become attributes to include on the `<button>`
+#'   element.
+#' @param auto_reset If `TRUE` (the default), automatically put the button back
+#'   in "ready" state after its click is handled by the server.
+#'
+#' @section Server value:
+#' An integer of class `"shinyActionButtonValue"`. This class differs from
+#' ordinary integers in that a value of 0 is considered "falsy".
+#' This implies two things:
+#'   * Event handlers (e.g., [shiny::observeEvent()], [shiny::eventReactive()]) won't execute on initial load.
+#'   * Input validation (e.g., [shiny::req()], [shiny::need()]) will fail on initial load.
+#'
+#' @seealso [bind_task_button()]
+#'
+#' @examplesIf interactive()
+#' library(shiny)
+#' library(bslib)
+#'
+#' ui <- page_sidebar(
+#'   sidebar = sidebar(
+#'     open = "always",
+#'     input_task_button("resample", "Resample"),
+#'   ),
+#'   verbatimTextOutput("summary")
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   sample <- eventReactive(input$resample, ignoreNULL=FALSE, {
+#'     Sys.sleep(2)  # Make this artificially slow
+#'     rnorm(100)
+#'   })
+#'
+#'   output$summary <- renderPrint({
+#'     summary(sample())
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
+#'
+#' @export
+input_task_button <- function(id, label, ..., icon = NULL,
+  label_busy = "Processing...", icon_busy = rlang::missing_arg(),
+  type = "primary", auto_reset = TRUE) {
+
+  dots <- separate_arguments(...)
+  attribs <- dots$attribs
+  children <- dots$children
+
+  icon_busy <- rlang::maybe_missing(
+    icon_busy,
+    fontawesome::fa_i("refresh", class = "fa-spin", "aria-hidden" = "true")
+  )
+
+  tags$button(
+    id = id,
+    class = if (!is.null(type)) paste0("btn btn-", type),
+    class = "bslib-task-button",
+    type = "button",
+    "data-auto-reset" = if (isTRUE(auto_reset)) NA else NULL,
+    !!!attribs,
+
+    component_dependencies(),
+
+    htmltools::tag("bslib-switch-inline",
+      rlang::list2(
+        case = "ready",
+        span(slot = "ready",
+          icon, label
+        ),
+        span(slot = "busy",
+          icon_busy, label_busy
+        ),
+        !!!children
+      )
+    )
+  )
+}
+
+#' @param state If `"busy"`, put the button into busy/disabled state. If
+#'   `"ready"`, put the button into ready/enabled state.
+#' @param session The `session` object; using the default is recommended.
+#' @rdname input_task_button
+#' @export
+update_task_button <- function(id, ..., state = NULL, session = get_current_session()) {
+  force(id)
+  force(state)
+
+  rlang::check_dots_empty()
+
+  if (!is.null(state)) {
+    if (!rlang::is_string(state)) {
+      abort("`state` must be a single character value.")
+    }
+    set_task_button_manual_reset(session, id, manual = !identical(state, "ready"))
+  }
+
+  session$sendInputMessage(id, dropNulls(list(state = state)))
+}
+
+
+task_button_manual_reset_map <- function(session) {
+  key <- "manual_task_button_reset"
+  map <- session$userData[[key]]
+  if (is.null(map)) {
+    map <- fastmap::fastmap()
+    session$userData[[key]] <- map
+  }
+  map
+}
+
+# Prevent automatic resetting of the task button when this reactive flush is
+# complete
+set_task_button_manual_reset <- function(session, id, manual = TRUE) {
+  ns_id <- session$ns(id)
+  map <- task_button_manual_reset_map(session)
+  if (isTRUE(manual)) {
+    map$set(ns_id, TRUE)
+  } else {
+    map$remove(ns_id)
+  }
+}
+
+is_task_button_manual_reset <- function(session, id) {
+  ns_id <- session$ns(id)
+  map <- task_button_manual_reset_map(session)
+  map$get(ns_id, FALSE)
+}
+
+
+input_task_button_input_handler <- function(val, shinysession, name) {
+  value <- val[["value"]]
+
+  if (isTRUE(val[["autoReset"]])) {
+    shinysession$onFlush(once = TRUE, function() {
+      # This is input_task_button's auto-reset feature: unless the button has
+      # opted out using set_task_button_manual_reset(), we should reset after
+      # a flush cycle where a bslib.taskbutton value is seen.
+      if (!is_task_button_manual_reset(shinysession, name)) {
+        update_task_button(name, state = "ready", session = shinysession)
+      }
+    })
+  }
+
+  # mark up the action button value with a special class so we can recognize it later
+  class(value) <- c("shinyActionButtonValue", class(value))
+  value
+}
+
+#' Bind `input_task_button` to `ExtendedTask`
+#'
+#' @description
+#' Sets up a [shiny::ExtendedTask] to relay its state to an existing
+#' [input_task_button()], so the task button stays in its "busy" state for as
+#' long as the extended task is running.
+#'
+#' Note that `bind_task_button` does _not_ automatically cause button presses to
+#' invoke the extended task; you still need to use [shiny::bindEvent()] (or
+#' [shiny::observeEvent()]) to cause the button press to trigger an invocation,
+#' as in the example below.
+#'
+#' `bind_task_button` cannot be used to bind one task button to multiple
+#' `ExtendedTask` objects; if you attempt to do so, any bound `ExtendedTask`
+#' that completes will cause the button to return to "ready" state.
+#'
+#' @param target The target object (i.e. `ExtendedTask`).
+#' @param task_button_id A string matching the `id` argument passed to the
+#'   corresponding [input_task_button()] call.
+#' @param session A Shiny session object (the default should almost always be
+#'   used).
+#' @param ... Further arguments passed to other methods.
+#'
+#' @returns The `target` object that was passed in.
+#'
+#' @examplesIf rlang::is_interactive()
+#'
+#' library(shiny)
+#' library(bslib)
+#' library(future)
+#' plan(multisession)
+#'
+#' ui <- page_sidebar(
+#'   sidebar = sidebar(
+#'     input_task_button("recalc", "Recalculate")
+#'   ),
+#'   textOutput("outval")
+#' )
+#'
+#' server <- function(input, output) {
+#'   rand_task <- ExtendedTask$new(function() {
+#'     future({
+#'       # Slow operation goes here
+#'       Sys.sleep(2)
+#'       runif(1)
+#'     }, seed = TRUE)
+#'   })
+#'
+#'   # Make button state reflect task.
+#'   # If using R >=4.1, you can do this instead:
+#'   # rand_task <- ExtendedTask$new(...) |> bind_task_button("recalc")
+#'   bind_task_button(rand_task, "recalc")
+#'
+#'   observeEvent(input$recalc, {
+#'     rand_task$invoke()
+#'   })
+#'
+#'   output$outval <- renderText({
+#'     rand_task$result()
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
+#'
+#' @export
+bind_task_button <- function(target, task_button_id, ...) {
+  UseMethod("bind_task_button")
+}
+
+#' @rdname bind_task_button
+#' @export
+bind_task_button.default <- function(target, task_button_id, ...) {
+  abort(
+    "Don't know how to bind a task button to an object of class '",
+    class(target)[[0]],
+    "'"
+  )
+}
+
+#' @rdname bind_task_button
+#' @export
+bind_task_button.ExtendedTask <- function(target, task_button_id,
+  ..., session = get_current_session()) {
+
+  force(target)
+  force(task_button_id)
+  force(session)
+
+  was_running <- FALSE
+  shiny::observe({
+    running <- target$status() == "running"
+    if (running != was_running) {
+      was_running <<- running
+      if (running) {
+        update_task_button(task_button_id, state = "busy", session = session)
+      } else {
+        update_task_button(task_button_id, state = "ready", session = session)
+      }
+    }
+  }, priority = 1000)
+  return(target)
+}