inst/shiny/helpers.R

In mmkhan19/singleCellTK: Interactive Analysis of Single Cell RNA-Seq Data

# All the code in this file needs to be copied to your Shiny app, and you need
# to call `withBusyIndicatorUI()` and `withBusyIndicatorServer()` in your app.
# You can also include the `appCSS` in your UI, as the example app shows.

# =============================================

# Set up a button to have an animated loading indicator and a checkmark
# for better user experience
# Need to use with the corresponding `withBusyIndicator` server function
withBusyIndicatorUI <- function(button) {
  id <- button[["attribs"]][["id"]]
  div(
    `data-for-btn` = id,
    button,
    span(
      class = "btn-loading-container",
      hidden(
        img(src = "ajax-loader-bar.gif", class = "btn-loading-indicator"),
        icon("check", class = "btn-done-indicator")
      )
    ),
    hidden(
      div(class = "btn-err",
          div(icon("exclamation-circle"),
              tags$b("Error: "),
              span(class = "btn-err-msg")
          )
      )
    )
  )
}

# does the same thing as above, but put the animation inside the button label
actionButtonBusy <- function(buttonId, buttonTitle) {
  tags$div(
    `data-for-btn` = buttonId,
    actionButton(
      buttonId,
      tags$div(
        buttonTitle,
        tags$span( class = "btn-loading-container", style = "float:right",
          hidden(
            img(src = "ajax-loader-bar.gif", class = "btn-loading-indicator"),
            icon("check", class = "btn-done-indicator")
          )
        )
      )
    ),
    hidden(
      div(class = "btn-err",
          div(icon("exclamation-circle"),
              tags$b("Error: "),
              span(class = "btn-err-msg")
          )
      )
    )
  )
}

# Call this function from the server with the button id that is clicked and the
# expression to run when the button is clicked
withBusyIndicatorServer <- function(buttonId, expr) {
  # UX stuff: show the "busy" message, hide the other messages, disable the button
  loadingEl <- sprintf("[data-for-btn=%s] .btn-loading-indicator", buttonId)
  doneEl <- sprintf("[data-for-btn=%s] .btn-done-indicator", buttonId)
  errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
  shinyjs::disable(buttonId)
  shinyjs::show(selector = loadingEl)
  shinyjs::hide(selector = doneEl)
  shinyjs::hide(selector = errEl)
  on.exit({
    shinyjs::enable(buttonId)
    shinyjs::hide(selector = loadingEl)
  })

  # Try to run the code when the button is clicked and show an error message if
  # an error occurs or a success message if it completes
  tryCatch({
    value <- expr
    shinyjs::show(selector = doneEl)
    shinyjs::delay(2000, shinyjs::hide(selector = doneEl, anim = TRUE, animType = "fade",
                                       time = 0.5))
    value
  }, error = function(err){
    errorFunc(err, buttonId)
  })
}

# When an error happens after a button click, show the error
errorFunc <- function(err, buttonId) {
  errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
  errElMsg <- sprintf("[data-for-btn=%s] .btn-err-msg", buttonId)
  errMessage <- gsub("^ddpcr: (.*)", "\\1", err$message)
  shinyjs::html(html = errMessage, selector = errElMsg)
  shinyjs::show(selector = errEl, anim = TRUE, animType = "fade")
}

appCSS <- "
.btn-loading-container {
  margin-left: 10px;
  font-size: 1.2em;
}
.btn-done-indicator {
  color: green;
}
.btn-err {
  margin-top: 10px;
  color: red;
}
"

# Accordion - formatting for collapsible section in an accordion
# Use example:
#     HTML('<div class="accordion" id="myAccordion">
#       <div class="panel">'),

#         HTML(accordionSection("1","2","myAccordion")),
#           # panel content code,
#         HTML('</div>'),

#       HTML('</div>
#     </div>')
accordionSection <- function(collapseId, panelTitle, accordionId) {
  return(
    paste(
      '<button type="button" class="btn btn-default btn-block" ',
        'data-toggle="collapse" data-target="#', collapseId, '" data-parent="#', accordionId, '">',
        panelTitle,
      '</button>
      <div id="', collapseId, '" class="collapse">',
      sep = ""
    )
  )
}

# show or hide all collapses in a list
allSections <- function(action, collapseList) {
  if (action == "hide"){
    for (i in collapseList){
      shinyjs::hide(i, anim = TRUE)
    }
  }
  else if (action == "show"){
    for (i in collapseList){
      shinyjs::show(i, anim = TRUE)
    }
  }
}