Avoid busy wait in shinytest

[insights-engineering-bot]

We can avoid the busy waiting until the Shiny app has started with Sys.sleep. Otherwise, tests may be unnecessarily long.

Here is the code. The app is defined as follows. It needs 10 seconds to be ready:

# to put into some directory, name this file `app.R`
shinyApp(
  ui = function() {
    div(
      textOutput("mytext")
    )
  },
  server = function(input, output, session) {
    output$mytext <- renderText({
      Sys.sleep(10)
      print(
        paste0("Sleeping", Sys.time()),
        file = file.path("~/scratch/teal", paste0(Sys.time(), ".R"))
      )
      "Hello"
    })
  }
)

Here is the code to constantly check whether the app is ready or not:

#' Wait until the Shiny app is no longer busy
#' 
#' Note that if the app runs something on the server to set some inputs 
#' on the client, this may trigger the server `reactives` again, so the 
#' Shiny app may not be ready in the proper sense. Then, you may
#' still need a manual timeout or call this function twice or more.
#' 
#' @md
#' @param app `ShinyDriver` app created through `\link[shinytest]{ShinyDriver}`
#' @param checkInterval `integer` How often to check for the condition, 
#'   in milliseconds.
#' @param timeout `integer` Timeout for the condition, in milliseconds.
#' @param warn `logical` whether to warn when the timeout is exceeded
#' @return `logical` whether the condition was `TRUE` (if timeout was reached,
#'   it may not be TRUE), also displays a warning if `FALSE`
wait_until_app_started <- function(app, checkInterval = 100, timeout = 3000, warn = TRUE) {
  stopifnot(
    is(app, "ShinyDriver"),
    is_logical_single(warn)
  )
  # runs Javascript code and returns once it is TRUE
  # we wait until the shiny application is no longer busy
  # based on https://stackoverflow.com/questions/17325521/r-shiny-display-loading-message-while-function-is-running/22475216#22475216 #nolint
  res <- app$waitFor(
    "!(($('html').hasClass('shiny-busy')) && (document.getElementById('shiny-notification-panel') == null))",
    checkInterval = checkInterval, timeout = timeout
  )
  if (!res && warn) {
    warning("Timeout exceeded, app is still busy")
  }
  return(res)
}

library(shinytest)
app_path <- "~/scratch/dummy_wait_app" # must have file app.R
app <- ShinyDriver$new(app_path, loadTimeout = 100000, debug = "all")

# Shiny driver takes non-negligible time to start, so the app will already be busy at the first invocation
# of `wait_until_app_started`
while (!wait_until_app_started(app)) {
  print("Waiting for app to start")
}
print("App succeeded")

app$stop()

Provenance:

Creator: maximilianmordig