R/runapp.R

In shiny: Web Application Framework for R

#' Run Shiny Application
#'
#' Runs a Shiny application. This function normally does not return; interrupt R
#' to stop the application (usually by pressing Ctrl+C or Esc).
#'
#' The host parameter was introduced in Shiny 0.9.0. Its default value of
#' `"127.0.0.1"` means that, contrary to previous versions of Shiny, only
#' the current machine can access locally hosted Shiny apps. To allow other
#' clients to connect, use the value `"0.0.0.0"` instead (which was the
#' value that was hard-coded into Shiny in 0.8.0 and earlier).
#'
#' @param appDir The application to run. Should be one of the following:
#'   \itemize{
#'   \item A directory containing `server.R`, plus, either `ui.R` or
#'    a `www` directory that contains the file `index.html`.
#'   \item A directory containing `app.R`.
#'   \item An `.R` file containing a Shiny application, ending with an
#'    expression that produces a Shiny app object.
#'   \item A list with `ui` and `server` components.
#'   \item A Shiny app object created by [shinyApp()].
#'   }
#' @param port The TCP port that the application should listen on. If the
#'   `port` is not specified, and the `shiny.port` option is set (with
#'   `options(shiny.port = XX)`), then that port will be used. Otherwise,
#'   use a random port between 3000:8000, excluding ports that are blocked
#'   by Google Chrome for being considered unsafe: 3659, 4045, 5060,
#'   5061, 6000, 6566, 6665:6669 and 6697. Up to twenty random
#'   ports will be tried.
#' @param launch.browser If true, the system's default web browser will be
#'   launched automatically after the app is started. Defaults to true in
#'   interactive sessions only. The value of this parameter can also be a
#'   function to call with the application's URL.
#' @param host The IPv4 address that the application should listen on. Defaults
#'   to the `shiny.host` option, if set, or `"127.0.0.1"` if not. See
#'   Details.
#' @param workerId Can generally be ignored. Exists to help some editions of
#'   Shiny Server Pro route requests to the correct process.
#' @param quiet Should Shiny status messages be shown? Defaults to FALSE.
#' @param display.mode The mode in which to display the application. If set to
#'   the value `"showcase"`, shows application code and metadata from a
#'   `DESCRIPTION` file in the application directory alongside the
#'   application. If set to `"normal"`, displays the application normally.
#'   Defaults to `"auto"`, which displays the application in the mode given
#'   in its `DESCRIPTION` file, if any.
#' @param test.mode Should the application be launched in test mode? This is
#'   only used for recording or running automated tests. Defaults to the
#'   `shiny.testmode` option, or FALSE if the option is not set.
#'
#' @return The value passed to [stopApp()], or throws an error if the app was
#'   stopped with an error.
#'
#' @seealso [startApp()] for non-blocking mode, [stopApp()] to stop a running
#'   app.
#'
#' @examples
#' \dontrun{
#' # Start app in the current working directory
#' runApp()
#'
#' # Start app in a subdirectory called myapp
#' runApp("myapp")
#' }
#'
#' ## Only run this example in interactive R sessions
#' if (interactive()) {
#'   options(device.ask.default = FALSE)
#'
#'   # Apps can be run without a server.r and ui.r file
#'   runApp(list(
#'     ui = bootstrapPage(
#'       numericInput('n', 'Number of obs', 100),
#'       plotOutput('plot')
#'     ),
#'     server = function(input, output) {
#'       output$plot <- renderPlot({ hist(runif(input$n)) })
#'     }
#'   ))
#'
#'
#'   # Running a Shiny app object
#'   app <- shinyApp(
#'     ui = bootstrapPage(
#'       numericInput('n', 'Number of obs', 100),
#'       plotOutput('plot')
#'     ),
#'     server = function(input, output) {
#'       output$plot <- renderPlot({ hist(runif(input$n)) })
#'     }
#'   )
#'   runApp(app)
#' }
#' @export
runApp <- function(
  appDir=getwd(),
  port=getOption('shiny.port'),
  launch.browser = getOption('shiny.launch.browser', interactive()),
  host=getOption('shiny.host', '127.0.0.1'),
  workerId="", quiet=FALSE,
  display.mode=c("auto", "normal", "showcase"),
  test.mode=getOption('shiny.testmode', FALSE)
) {
  # * Wrap **all** execution of the app inside the otel promise domain
  # * While this could be done at a lower level, it allows for _anything_ within
  #   shiny's control to allow for the opportunity to have otel active spans be
  #   reactivated upon promise domain restoration
  promises::local_otel_promise_domain()

  # Check for nested blocking runApp() before sourcing app code
  if (isRunning() && is.null(.globals$runningHandle)) {
    stop("Can't call `runApp()` from within `runApp()`. If your ",
         "application code contains `runApp()`, please remove it.")
  }

  # Make warnings print immediately
  # Set pool.scheduler to support pool package
  ops <- options(
    # Raise warn level to 1, but don't lower it
    warn = max(1, getOption("warn", default = 1)),
    pool.scheduler = scheduleTask
  )

  # Ensure options are restored and onStop callbacks fire even if
  # as.shiny.appobj() errors. Once .setupShinyApp() succeeds, the returned
  # cleanup function takes over and this guard becomes a no-op.
  setupComplete <- FALSE
  on.exit(if (!setupComplete) {
    options(ops)
    .globals$onStopCallbacks$invoke()
    .globals$onStopCallbacks <- Callbacks$new()
  }, add = TRUE)

  require(shiny)

  # ============================================================================
  # Convert to Shiny app object
  # ============================================================================
  appParts <- as.shiny.appobj(appDir)

  result <- .setupShinyApp(
    appDir, appParts, port, launch.browser, host,
    workerId, quiet, display.mode, test.mode, ops = ops
  )
  setupComplete <- TRUE
  on.exit(result$cleanup(), add = TRUE)

  # ============================================================================
  # Run event loop via httpuv
  # ============================================================================
  # Top-level ..stacktraceoff..; matches with ..stacktraceon in observe(),
  # reactive(), Callbacks$invoke(), and others
  ..stacktraceoff..(
    captureStackTraces({
      while (!.globals$stopped) {
        ..stacktracefloor..(serviceApp())
      }
    })
  )

  if (isTRUE(.globals$reterror)) {
    stop(.globals$retval)
  } else if (.globals$retval$visible) {
    .globals$retval$value
  } else {
    invisible(.globals$retval$value)
  }
}

#' Start Shiny Application (Non-Blocking)
#'
#' Starts a Shiny application in non-blocking mode, returning a
#' `ShinyAppHandle` immediately while the app runs in the background.
#' The `later` event loop services the app, so the R console remains
#' available for interaction.
#'
#' To stop a non-blocking app from the R console, call `handle$stop()`
#' on the returned `ShinyAppHandle`. Despite the similar name, [stopApp()]
#' is not the counterpart of `startApp()` — it is for use from *inside*
#' app code (e.g. server functions, observers, or the `onStart` hook),
#' where it sets a return value that is later surfaced via
#' `handle$result()`.
#'
#' @section Auto-replacement:
#' If another Shiny app is already running in this session when `startApp()`
#' is called, the running app is stopped before the new one starts.
#' Stopping happens up front, so if the new app then fails to start, no app
#' will be running. You can always call `handle$stop()` on the existing
#' handle first if you would rather manage the transition yourself.
#'
#' @inheritParams runApp
#'
#' @return A `ShinyAppHandle` object with methods `stop()`, `status()`,
#'   `url()`, and `result()`. The `status()` method returns `"running"`,
#'   `"success"`, or `"error"`. The `result()` method throws an error if called
#'   while running, or re-throws the error if the app stopped with an error.
#'
#' @examples
#' \dontrun{
#' # Start app in the background
#' handle <- startApp("myapp")
#'
#' # Check status
#' handle$status()
#' handle$url()
#'
#' # Stop the app
#' handle$stop()
#' }
#'
#' @seealso [runApp()] for blocking mode.
#' @export
startApp <- function(
  appDir = getwd(),
  port = getOption("shiny.port"),
  launch.browser = getOption("shiny.launch.browser", interactive()),
  host = getOption("shiny.host", "127.0.0.1"),
  workerId = "",
  quiet = FALSE,
  display.mode = c("auto", "normal", "showcase"),
  test.mode = getOption("shiny.testmode", FALSE)
) {
  # OTEL: `local_otel_promise_domain()` ties its lifetime to this frame,
  # which exits as soon as the handle is returned — before any request is
  # served. A persistent global install would instead leak into unrelated
  # user promises between ticks. Wrap the synchronous setup below (covers
  # onStart) and each service iteration in `serviceNonBlocking()` (covers
  # handlers and observers). The domain is dormant between ticks, so it
  # stays out of user promises created at the console.

  # Make warnings print immediately
  # Set pool.scheduler to support pool package
  ops <- options(
    # Raise warn level to 1, but don't lower it
    warn = max(1, getOption("warn", default = 1)),
    pool.scheduler = scheduleTask
  )

  # Ensure options are restored and onStop callbacks fire even if
  # as.shiny.appobj() errors. See matching guard in runApp().
  setupComplete <- FALSE
  on.exit(if (!setupComplete) {
    options(ops)
    .globals$onStopCallbacks$invoke()
    .globals$onStopCallbacks <- Callbacks$new()
  }, add = TRUE)

  require(shiny)

  result <- promises::with_otel_promise_domain({
    appParts <- as.shiny.appobj(appDir)
    .setupShinyApp(
      appDir, appParts, port, launch.browser, host,
      workerId, quiet, display.mode, test.mode, ops = ops
    )
  })
  setupComplete <- TRUE

  handle <- ShinyAppHandle$new(result$appUrl, result$cleanup)
  .globals$runningHandle <- handle
  if (.globals$stopped) {
    # Setup-time stopApp() (e.g. from onStart). Skip the service loop
    # so the returned handle is already in its terminal state.
    handle$stop()
  } else {
    serviceNonBlocking(handle, .globals$serviceGeneration)
  }
  handle
}

# Shared initialization for runApp() and startApp().
# Handles all app setup: options, state, httpuv server, browser launch, etc.
# Returns list(appUrl, cleanup) where cleanup() tears down the app.
# On setup failure, internal on.exit handlers clean up partial state.
.setupShinyApp <- function(appDir, appParts, port, launch.browser, host,
                           workerId, quiet, display.mode, test.mode, ops,
                           caller = parent.frame()) {
  # Guard on.exit handlers with this flag so they only fire on setup failure.
  # On success, cleanup responsibility is handed to the caller via the
  # returned cleanup function.
  cleanupOnExit <- TRUE

  on.exit(if (cleanupOnExit) handlerManager$clear(), add = TRUE)

  if (isRunning()) {
    # Auto-replace only at top level; a nested launch from inside a tick
    # (server, observer, promise callback) must error, not tear down its host.
    if (is.null(.globals$runningHandle) || .isInAppTick()) {
      stop("Can't start a new app while another is running. ",
           "If your application code contains `runApp()` or `startApp()`, remove it. ",
           "Otherwise, stop the current app first with stopApp().")
    }
    message("Stopping running Shiny app.")
    .globals$runningHandle$stop()
  }

  # Initialize globals for this run before any user code (onStart,
  # onAppStart hooks, etc.) executes. Setting these afterwards would
  # clobber a stopApp() called from inside setup.
  .globals$reterror <- NULL
  .globals$retval <- NULL
  .globals$stopped <- FALSE
  # Each app launch gets a fresh generation so any stale non-blocking
  # service callback from a previous app becomes a no-op.
  .globals$serviceGeneration <- (.globals$serviceGeneration %||% 0L) + 1L

  # ============================================================================
  # runApp options set via shinyApp(options = list(...))
  # ============================================================================
  # The lines below set some of the app's running options, which
  # can be:
  #   - left unspecified (in which case the arguments' default
  #     values from `runApp` kick in);
  #   - passed through `shinyApp`
  #   - passed through `runApp` (this function)
  #   - passed through both `shinyApp` and `runApp` (the latter
  #     takes precedence)
  #
  # Matrix of possibilities:
  # | IN shinyApp | IN runApp | result       | check                                                                                                                                  |
  # |-------------|-----------|--------------|----------------------------------------------------------------------------------------------------------------------------------------|
  # | no          | no        | use defaults | exhaust all possibilities: if it's missing (runApp does not specify); THEN if it's not in shinyApp appParts$options; THEN use defaults |
  # | yes         | no        | use shinyApp | if it's missing (runApp does not specify); THEN if it's in shinyApp appParts$options; THEN use shinyApp                                |
  # | no          | yes       | use runApp   | if it's not missing (runApp specifies), use those                                                                                      |
  # | yes         | yes       | use runApp   | if it's not missing (runApp specifies), use those                                                                                      |
  #
  # `missing()` runs in the caller's frame: with defaults on the outer
  # formals, arguments are no longer missing by the time they reach here.
  appOps <- appParts$options
  findVal <- function(arg, default) {
    if (arg %in% names(appOps)) appOps[[arg]] else default
  }
  if (evalq(missing(port), caller))           port <- findVal("port", port)
  if (evalq(missing(launch.browser), caller)) launch.browser <- findVal("launch.browser", launch.browser)
  if (evalq(missing(host), caller))           host <- findVal("host", host)
  if (evalq(missing(quiet), caller))          quiet <- findVal("quiet", quiet)
  if (evalq(missing(display.mode), caller))   display.mode <- findVal("display.mode", display.mode)
  if (evalq(missing(test.mode), caller))      test.mode <- findVal("test.mode", test.mode)

  on.exit(if (cleanupOnExit) options(ops), add = TRUE)

  # ============================================================================
  # Global onStart/onStop callbacks
  # ============================================================================
  on.exit(if (cleanupOnExit) {
    .globals$onStopCallbacks$invoke()
    .globals$onStopCallbacks <- Callbacks$new()
  }, add = TRUE)

  # ============================================================================
  # Initialize app state object
  # ============================================================================
  # This is so calls to getCurrentAppState() can be used to find (A) whether an
  # app is running and (B), get options and data associated with the app.
  initCurrentAppState(appParts)
  on.exit(if (cleanupOnExit) clearCurrentAppState(), add = TRUE)
  # Any shinyOptions set after this point will apply to the current app only
  # (and will not persist after the app stops).

  # ============================================================================
  # shinyOptions
  # ============================================================================
  # A unique identifier associated with this run of this application. It is
  # shared across sessions.
  shinyOptions(appToken = createUniqueId(8))

  # Set up default cache for app.
  if (is.null(getShinyOption("cache", default = NULL))) {
    shinyOptions(cache = cachem::cache_mem(max_size = 200 * 1024^2))
  }

  # Extract appOptions (which is a list) and store them as shinyOptions, for
  # this app. (This is the only place we have to store settings that are
  # accessible both the UI and server portion of the app.)
  applyCapturedAppOptions(appParts$appOptions)

  if (is.null(host) || is.na(host)) host <- '0.0.0.0'

  # ============================================================================
  # Hosted environment
  # ============================================================================
  workerId(workerId)

  if (inShinyServer()) {
    # If SHINY_PORT is set, we're running under Shiny Server. Check the version
    # to make sure it is compatible. Older versions of Shiny Server don't set
    # SHINY_SERVER_VERSION, those will return "" which is considered less than
    # any valid version.
    ver <- Sys.getenv('SHINY_SERVER_VERSION')
    if (utils::compareVersion(ver, .shinyServerMinVersion) < 0) {
      rlang::warn(c(
        sprintf(
          "Shiny Server v%s or later is required; please upgrade.",
          .shinyServerMinVersion
        ),
        "i" = "If you are not using Shiny Server, you are likely seeing this message because the `SHINY_PORT` environment variable is set in your environment.",
        "i" = "Avoid using `SHINY_PORT` to prevent this warning."
      ))
    }
  }

  # ============================================================================
  # Shinytest
  # ============================================================================
  # Set the testmode shinyoption so that this can be read by both the
  # ShinySession and the UI code (which executes separately from the
  # ShinySession code).
  shinyOptions(testmode = test.mode)
  if (test.mode) {
    message("Running application in test mode.")
  }

  # ============================================================================
  # Showcase mode
  # ============================================================================
  # Showcase mode is disabled by default; it must be explicitly enabled in
  # either the DESCRIPTION file for directory-based apps, or via
  # the display.mode parameter. The latter takes precedence.
  setShowcaseDefault(0)

  # If appDir specifies a path, and display mode is specified in the
  # DESCRIPTION file at that path, apply it here.
  if (is.character(appDir)) {
    # if appDir specifies a .R file (single-file Shiny app), look for the
    # DESCRIPTION in the parent directory
    desc <- file.path.ci(
      if (tolower(tools::file_ext(appDir)) == "r")
        dirname(appDir)
      else
        appDir, "DESCRIPTION")
    if (file.exists(desc)) {
      con <- file(desc, encoding = checkEncoding(desc))
      on.exit(close(con), add = TRUE)
      settings <- read.dcf(con)
      if ("DisplayMode" %in% colnames(settings)) {
        mode <- settings[1, "DisplayMode"]
        if (mode == "Showcase") {
          setShowcaseDefault(1)
          if ("IncludeWWW" %in% colnames(settings)) {
            .globals$IncludeWWW <- as.logical(settings[1, "IncludeWWW"])
            if (is.na(.globals$IncludeWWW)) {
              stop("In your Description file, `IncludeWWW` ",
                   "must be set to `True` (default) or `False`")
            }
          } else {
            .globals$IncludeWWW <- TRUE
          }
        }
      }
    }
  }

  ## default is to show the .js, .css and .html files in the www directory
  ## (if not in showcase mode, this variable will simply be ignored)
  if (is.null(.globals$IncludeWWW) || is.na(.globals$IncludeWWW)) {
    .globals$IncludeWWW <- TRUE
  }

  # If display mode is specified as an argument, apply it (overriding the
  # value specified in DESCRIPTION, if any).
  display.mode <- match.arg(display.mode, c("auto", "normal", "showcase"))
  if (display.mode == "normal") {
    setShowcaseDefault(0)
  }
  else if (display.mode == "showcase") {
    setShowcaseDefault(1)
  }

  # ============================================================================
  # Server port
  # ============================================================================
  # determine port if we need to
  if (is.null(port)) {

    # Try up to 20 random ports. If we don't succeed just plow ahead
    # with the final value we tried, and let the "real" startServer
    # somewhere down the line fail and throw the error to the user.
    #
    # If we (think we) succeed, save the value as .globals$lastPort,
    # and try that first next time the user wants a random port.

    for (i in 1:20) {
      if (!is.null(.globals$lastPort)) {
        port <- .globals$lastPort
        .globals$lastPort <- NULL
      }
      else {
        # Try up to 20 random ports
        while (TRUE) {
          port <- p_randomInt(3000, 8000)
          # Reject ports in this range that are considered unsafe by Chrome
          # http://superuser.com/questions/188058/which-ports-are-considered-unsafe-on-chrome
          # https://github.com/rstudio/shiny/issues/1784
          # https://chromium.googlesource.com/chromium/src.git/+/refs/heads/main/net/base/port_util.cc
          if (!port %in% c(3659, 4045, 5060, 5061, 6000, 6566, 6665:6669, 6697)) {
            break
          }
        }
      }

      # Test port to see if we can use it
      tmp <- try(startServer(host, port, list()), silent=TRUE)
      if (!inherits(tmp, 'try-error')) {
        stopServer(tmp)
        .globals$lastPort <- port
        break
      }
    }
  }

  # ============================================================================
  # onStart/onStop callbacks
  # ============================================================================
  # Set up the onStop before we call onStart, so that it gets called even if an
  # error happens in onStart or later during startup.
  if (!is.null(appParts$onStop))
    on.exit(if (cleanupOnExit) appParts$onStop(), add = TRUE)
  if (!is.null(appParts$onStart))
    appParts$onStart()

  # ============================================================================
  # Start httpuv app
  # ============================================================================
  server <- startHttpuvApp(appParts, port, host, quiet)

  # Make the httpuv server object accessible. Needed for calling
  # addResourcePath while app is running.
  shinyOptions(server = server)
  on.exit(if (cleanupOnExit) stopServer(server), add = TRUE)

  # ============================================================================
  # Launch web browser
  # ============================================================================
  if (!is.character(port)) {
    browseHost <- host
    if (identical(host, "0.0.0.0")) {
      # http://0.0.0.0/ doesn't work on QtWebKit (i.e. RStudio viewer)
      browseHost <- "127.0.0.1"
    } else if (identical(host, "::")) {
      browseHost <- "::1"
    }

    if (httpuv::ipFamily(browseHost) == 6L) {
      browseHost <- paste0("[", browseHost, "]")
    }

    appUrl <- paste("http://", browseHost, ":", port, sep="")
    if (is.function(launch.browser))
      launch.browser(appUrl)
    else if (launch.browser)
      utils::browseURL(appUrl)
  } else {
    appUrl <- NULL
  }

  # ============================================================================
  # Application hooks
  # ============================================================================
  callAppHook("onAppStart", appUrl)
  on.exit(if (cleanupOnExit) callAppHook("onAppStop", appUrl), add = TRUE)

  # Setup complete - disable on.exit cleanup, hand off to caller
  cleanupOnExit <- FALSE

  list(
    appUrl = appUrl,
    cleanup = .createCleanup(server, appParts, appUrl, ops)
  )
}

# Consolidated cleanup function for app teardown
.createCleanup <- function(server, appParts, appUrl, ops) {
  cleanedUp <- FALSE
  function() {
    if (cleanedUp) return()
    cleanedUp <<- TRUE

    .globals$stopped <- TRUE
    .globals$runningHandle <- NULL
    handlerManager$clear()
    options(ops)
    .globals$onStopCallbacks$invoke()
    .globals$onStopCallbacks <- Callbacks$new()
    clearCurrentAppState()
    if (!is.null(appParts$onStop)) appParts$onStop()
    stopServer(server)
    callAppHook("onAppStop", appUrl)
  }
}

#' Stop the currently running Shiny app
#'
#' Stops the currently running Shiny app, returning control to the caller of
#' [runApp()]. Despite the similar names, `stopApp()` is not the
#' counterpart of [startApp()] — it is the counterpart of [runApp()],
#' controlling its return value via `returnValue`.
#'
#' @param returnValue The value that should be returned from
#'   [runApp()].
#' @export
stopApp <- function(returnValue = invisible()) {
  # reterror will indicate whether retval is an error (i.e. it should be passed
  # to stop() when the serviceApp loop stops) or a regular value (in which case
  # it should simply be returned with the appropriate visibility).
  .globals$reterror <- FALSE
  ..stacktraceoff..(
    tryCatch(
      {
        captureStackTraces(
          .globals$retval <- withVisible(..stacktraceon..(force(returnValue)))
        )
      },
      error = function(e) {
        .globals$retval <- e
        .globals$reterror <- TRUE
      }
    )
  )

  .globals$stopped <- TRUE
  httpuv::interrupt()
}

#' Run Shiny Example Applications
#'
#' Launch Shiny example applications, and optionally, your system's web browser.
#'
#' @param example The name of the example to run, or `NA` (the default) to
#'   list the available examples.
#' @param launch.browser If true, the system's default web browser will be
#'   launched automatically after the app is started. Defaults to true in
#'   interactive sessions only.
#' @param host The IPv4 address that the application should listen on. Defaults
#'   to the `shiny.host` option, if set, or `"127.0.0.1"` if not.
#' @param display.mode The mode in which to display the example. Defaults to
#'   `"auto"`, which uses the value of `DisplayMode` in the example's
#'   `DESCRIPTION` file. Set to `"showcase"` to show the app code and
#'   description with the running app, or `"normal"` to see the example without
#'   code or commentary.
#' @param package The package in which to find the example (defaults to
#'   `"shiny"`).
#'
#'   To provide examples in your package, store examples in the
#'   `inst/examples-shiny` directory of your package. Each example should be
#'   in its own subdirectory and should be runnable when [runApp()] is called
#'   on the subdirectory. Example apps can include a `DESCRIPTION` file and a
#'   `README.md` file to provide metadata and commentary about the example. See
#'   the article on [Display Modes](https://shiny.posit.co/r/articles/build/display-modes/)
#'   on the Shiny website for more information.
#' @inheritParams runApp
#'
#' @examples
#' ## Only run this example in interactive R sessions
#' if (interactive()) {
#'   # List all available examples
#'   runExample()
#'
#'   # Run one of the examples
#'   runExample("01_hello")
#'
#'   # Print the directory containing the code for all examples
#'   system.file("examples", package="shiny")
#' }
#' @export
runExample <- function(
  example = NA,
  port = getOption("shiny.port"),
  launch.browser = getOption("shiny.launch.browser", interactive()),
  host = getOption("shiny.host", "127.0.0.1"),
  display.mode = c("auto", "normal", "showcase"),
  package = "shiny"
) {
  if (!identical(package, "shiny") && !is_installed(package)) {
    rlang::check_installed(package)
  }

  use_legacy_shiny_examples <-
    identical(package, "shiny") &&
    isTRUE(getOption('shiny.legacy.examples', FALSE))

  examplesDir <- system_file(
    if (use_legacy_shiny_examples) "examples" else "examples-shiny",
    package = package
  )

  dir <- resolve(examplesDir, example)

  if (is.null(dir)) {
    valid_examples <- sprintf(
      'Valid examples in {%s}: "%s"',
      package,
      paste(list.files(examplesDir), collapse = '", "')
    )

    if (is.na(example)) {
      message(valid_examples)
      return(invisible())
    }

    stop("Example '", example, "' does not exist. ", valid_examples)
  }

  runApp(dir, port = port, host = host, launch.browser = launch.browser,
         display.mode = display.mode)
}

#' Run a gadget
#'
#' Similar to `runApp`, but handles `input$cancel` automatically, and
#' if running in RStudio, defaults to viewing the app in the Viewer pane.
#'
#' @param app Either a Shiny app object as created by
#'   [`shinyApp()`][shiny] et al, or, a UI object.
#' @param server Ignored if `app` is a Shiny app object; otherwise, passed
#'   along to `shinyApp` (i.e. `shinyApp(ui = app, server = server)`).
#' @param port See [`runApp()`][shiny].
#' @param viewer Specify where the gadget should be displayed--viewer pane,
#'   dialog window, or external browser--by passing in a call to one of the
#'   [viewer()] functions.
#' @param stopOnCancel If `TRUE` (the default), then an `observeEvent`
#'   is automatically created that handles `input$cancel` by calling
#'   `stopApp()` with an error. Pass `FALSE` if you want to handle
#'   `input$cancel` yourself.
#' @return The value returned by the gadget.
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' ui <- fillPage(...)
#'
#' server <- function(input, output, session) {
#'   ...
#' }
#'
#' # Either pass ui/server as separate arguments...
#' runGadget(ui, server)
#'
#' # ...or as a single app object
#' runGadget(shinyApp(ui, server))
#' }
#' @export
runGadget <- function(app, server = NULL, port = getOption("shiny.port"),
  viewer = paneViewer(), stopOnCancel = TRUE) {

  if (!is.shiny.appobj(app)) {
    app <- shinyApp(app, server)
  }

  if (isTRUE(stopOnCancel)) {
    app <- decorateServerFunc(app, function(input, output, session) {
      observeEvent(input$cancel, {
        stopApp(stop("User cancel", call. = FALSE))
      })
    })
  }

  if (is.null(viewer)) {
    viewer <- utils::browseURL
  }

  shiny::runApp(app, port = port, launch.browser = viewer)
}

# Add custom functionality to a Shiny app object's server func
decorateServerFunc <- function(appobj, serverFunc) {
  origServerFuncSource <- appobj$serverFuncSource
  appobj$serverFuncSource <- function() {
    origServerFunc <- origServerFuncSource()
    function(input, output, session) {
      serverFunc(input, output, session)

      # The clientData and session arguments are optional; check if
      # each exists
      args <- argsForServerFunc(origServerFunc, session)
      do.call(origServerFunc, args)
    }
  }
  appobj
}