Mwavu - Add downLoading spinners

Demo

Introduction

I hope nobody is reading. But if you are, then keep this to yourself.

Mwavu

Oftentimes you have a large dataset that takes a while to download. To give your users a visual cue that the download is in progress, you can (and should) add spinners to your download buttons.

The module

Let’s first create a basic download button module that we can build upon.

We’ll create an action button that will trigger the download (Yes, you read that right, an action button).

We’ll then add the real download button but it will be hidden.

R/mod_dnld_ui.R

#' Download button module UI
#' @param id Module ID
#' @return [shiny::tagList()]
mod_dnld_ui <- function(id) {
  ns <- shiny::NS(id)

  shiny::tagList(
    # Trigger button:
    shiny::actionButton(
      inputId = ns("actbtn"),
      label = htmltools::doRenderTags(
        shiny::tags$span(
          shiny::icon("download"),
          "Download"
        )
      )
    ),

    # Real download button:
    shiny::downloadButton(
      outputId = ns("dnld"),
      label = NULL,
      style = "visibility: hidden;"
    )
  )
}

The basic server piece is also as simple:

R/mod_dnld_server.R

#' Download button module server
#' @param id Module ID
#' @param given_data Data to download, as a reactive.
#' @param filename Filename to use for download.
#' @return NULL
mod_dnld_server <- function(
  id,
  given_data = reactive({iris}),
  filename = "iris.csv"
) {
  stopifnot(
    "`given_data` must be a reactive" = is.reactive(given_data)
  )

  shiny::moduleServer(
    id = id,
    module = function(input, output, session) {
      output$dnld <- downloadHandler(
        filename = filename,
        content = function(file) {
          write.csv(given_data(), file)
        }
      )
    }
  )
}

It takes in a reactive data object (given_data) and a filename. The rest is normal stuff.

We can now move on to adding the download button spinner.

Adding a spinner to the download button

Spoiler alert: mod_dnld_ui is done. We’ll work on mod_dnld_server from now on.

In the server module, we’ll use shiny::observeEvent to listen for clicks on the action button.

When the button is clicked, we update its label to show a spinner and a message indicating that the download is in progress.

We then trigger a click on the real download button using shinyjs::click:

R/mod_dnld_server.R

shiny::observeEvent(input$actbtn, {
  # update label of 'actbtn':
  shiny::updateActionButton(
    session = session,
    inputId = "actbtn",
    label = htmltools::doRenderTags(
      shiny::tags$span(
        class = "d-flex align-items-center",
        shiny::tags$span(
          class = "spinner-border spinner-border-sm",
          role = "status",
          `aria-hidden` = "true"
        ),
        shiny::tags$span(
          class = "mx-1",
          "Downloading..."
        )
      )
    )
  )

  # simulate click on 'dnld' btn:
  shinyjs::delay(
    ms = 2 * 1e3,
    expr = shinyjs::click(id = "dnld")
  )
})

Two things to note here:

I use Bootstrap 5 classes.
I use shinyjs::delay to, well, delay the click for 2 seconds. Wanna know why?

Next, after the download is complete, we need to update the label of the action button back to its original value.

R/mod_dnld_server.R

output$dnld <- downloadHandler(
  filename = filename,
  content = function(file) {
    # on exit, update 'actbtn' label:
    on.exit({
      shiny::updateActionButton(
        session = session,
        inputId = "actbtn",
        label = htmltools::doRenderTags(
          shiny::tags$span(
            shiny::icon("download"),
            "Download"
          )
        )
      )
    })

    # write data to file:
    write.csv(given_data(), file)
  }
)

?on.exit:

on.exit records the expression given as its argument as needing to be executed when the current function exits (either naturally or as the result of an error). This is useful for resetting graphical parameters or performing other cleanup actions.

In our case, we’re performing a cleanup action: updating the label of the action button back to its original state.

The complete module server function is as follows:

R/mod_dnld_server.R

#' Download button module server
#' @param id Module id
#' @param given_data Data to download, as a reactive.
#' @param filename Filename to use for download.
#' @return NULL
mod_dnld_server <- function(
    id,
    given_data = reactive({
      iris
    }),
    filename = "iris.csv") {
  stopifnot(
    "`given_data` must be a reactive" = is.reactive(given_data)
  )

  shiny::moduleServer(
    id = id,
    module = function(input, output, session) {
      shiny::observeEvent(input$actbtn, {
        # update label of 'actbtn':
        shiny::updateActionButton(
          session = session,
          inputId = "actbtn",
          label = htmltools::doRenderTags(
            shiny::tags$span(
              class = "d-flex align-items-center",
              shiny::tags$span(
                class = "spinner-border spinner-border-sm",
                role = "status",
                `aria-hidden` = "true"
              ),
              shiny::tags$span(
                class = "mx-1",
                "Downloading..."
              )
            )
          )
        )

        # simulate click on 'dnld' btn:
        shinyjs::delay(
          ms = 2 * 1e3,
          expr = shinyjs::click(id = "dnld")
        )
      })

      output$dnld <- downloadHandler(
        filename = filename,
        content = function(file) {
          # on exit, update 'actbtn' label:
          on.exit({
            shiny::updateActionButton(
              session = session,
              inputId = "actbtn",
              label = htmltools::doRenderTags(
                shiny::tags$span(
                  shiny::icon("download"),
                  "Download"
                )
              )
            )
          })

          # write data to file:
          write.csv(given_data(), file)
        }
      )
    }
  )
}

Putting it all together

Now that we have the module UI and server parts, we can put them together in a shiny app.

The app is as simple as it can get:

ui <- bslib::page(
  theme = bslib::bs_theme(version = 5),
  shinyjs::useShinyjs(),

  shiny::tags$div(
    class = "bg-light",

    shiny::tags$div(
    class = paste(
      "container min-vh-100",
      "d-flex justify-content-center align-items-center bg-white"
    ),

    # module UI:
    shiny::tags$div(
      mod_dnld_ui("this")
    )
  )
  )
)

server <- function(input, output, session) {
  # module server:
  mod_dnld_server("this")
}

shiny::shinyApp(ui, server)

The full code is available on this GitHub Gist.