mirror of
https://github.com/rstudio/shiny.git
synced 2026-01-29 08:48:13 -05:00
c03842056c
If reactivePrint or reactiveText return non-ASCII characters on Windows, it causes invalid UTF-8 strings to be received by the browser which closes the websocket connection. I'm not sure this is the right place to do encoding, but it seems to me like this approach is likely to work best for the most users (especially those who just aren't thinking about encoding). If you want to handle encoding in the reactives themselves (for example), use `options(shiny.transcode.json=F)`.
684 lines
20 KiB
R
684 lines
20 KiB
R
#' @docType package
|
|
#' @import websockets caTools RJSONIO xtable digest
|
|
NULL
|
|
|
|
suppressPackageStartupMessages({
|
|
library(websockets)
|
|
library(RJSONIO)
|
|
})
|
|
|
|
ShinyApp <- setRefClass(
|
|
'ShinyApp',
|
|
fields = list(
|
|
.websocket = 'list',
|
|
.invalidatedOutputValues = 'Map',
|
|
.invalidatedOutputErrors = 'Map',
|
|
.progressKeys = 'character',
|
|
.fileUploadContext = 'FileUploadContext',
|
|
session = 'Values'
|
|
),
|
|
methods = list(
|
|
initialize = function(ws) {
|
|
.websocket <<- ws
|
|
.invalidatedOutputValues <<- Map$new()
|
|
.invalidatedOutputErrors <<- Map$new()
|
|
.progressKeys <<- character(0)
|
|
# TODO: Put file upload context in user/app-specific dir if possible
|
|
.fileUploadContext <<- FileUploadContext$new()
|
|
session <<- Values$new()
|
|
},
|
|
defineOutput = function(name, func) {
|
|
"Binds an output generating function to this name. The function can either
|
|
take no parameters, or have named parameters for \\code{name} and
|
|
\\code{shinyapp} (in the future this list may expand, so it is a good idea
|
|
to also include \\code{...} in your function signature)."
|
|
|
|
# jcheng 08/31/2012: User submitted an example of a dynamically calculated
|
|
# name not working unless name was eagerly evaluated. Yikes!
|
|
force(name)
|
|
|
|
if (is.function(func)) {
|
|
if (length(formals(func)) != 0) {
|
|
orig <- func
|
|
func <- function() {
|
|
orig(name=name, shinyapp=.self)
|
|
}
|
|
}
|
|
|
|
obs <- Observer$new(function() {
|
|
|
|
value <- try(func(), silent=F)
|
|
|
|
.invalidatedOutputErrors$remove(name)
|
|
.invalidatedOutputValues$remove(name)
|
|
|
|
if (inherits(value, 'try-error')) {
|
|
cond <- attr(value, 'condition')
|
|
.invalidatedOutputErrors$set(
|
|
name,
|
|
list(message=cond$message,
|
|
call=capture.output(print(cond$call))))
|
|
}
|
|
else
|
|
.invalidatedOutputValues$set(name, value)
|
|
})
|
|
|
|
obs$onInvalidateHint(function() {
|
|
showProgress(name)
|
|
})
|
|
}
|
|
else {
|
|
stop(paste("Unexpected", class(func), "output for", name))
|
|
}
|
|
},
|
|
flushOutput = function() {
|
|
if (length(.progressKeys) == 0
|
|
&& length(.invalidatedOutputValues) == 0
|
|
&& length(.invalidatedOutputErrors) == 0) {
|
|
return(invisible())
|
|
}
|
|
|
|
.progressKeys <<- character(0)
|
|
|
|
values <- .invalidatedOutputValues
|
|
.invalidatedOutputValues <<- Map$new()
|
|
errors <- .invalidatedOutputErrors
|
|
.invalidatedOutputErrors <<- Map$new()
|
|
|
|
json <- toJSON(list(errors=as.list(errors),
|
|
values=as.list(values)))
|
|
|
|
.write(json)
|
|
},
|
|
showProgress = function(id) {
|
|
'Send a message to the client that recalculation of the output identified
|
|
by \\code{id} is in progress. There is currently no mechanism for
|
|
explicitly turning off progress for an output component; instead, all
|
|
progress is implicitly turned off when flushOutput is next called.'
|
|
if (id %in% .progressKeys)
|
|
return()
|
|
|
|
.progressKeys <<- c(.progressKeys, id)
|
|
|
|
json <- toJSON(list(progress=list(id)))
|
|
|
|
.write(json)
|
|
},
|
|
dispatch = function(msg) {
|
|
method <- paste('@', msg$method, sep='')
|
|
func <- try(do.call(`$`, list(.self, method)), silent=T)
|
|
if (inherits(func, 'try-error')) {
|
|
.sendErrorResponse(msg, paste('Unknown method', msg$method))
|
|
}
|
|
|
|
value <- try(do.call(func, as.list(append(msg$args, msg$blobs))))
|
|
if (inherits(value, 'try-error')) {
|
|
.sendErrorResponse(msg, paste('Error:', as.character(value)))
|
|
}
|
|
else {
|
|
.sendResponse(msg, value)
|
|
}
|
|
},
|
|
.sendResponse = function(requestMsg, value) {
|
|
if (is.null(requestMsg$tag)) {
|
|
warning("Tried to send response for untagged message; method: ",
|
|
requestMsg$method)
|
|
return()
|
|
}
|
|
.write(toJSON(list(response=list(tag=requestMsg$tag, value=value))))
|
|
},
|
|
.sendErrorResponse = function(requestMsg, error) {
|
|
if (is.null(requestMsg$tag))
|
|
return()
|
|
.write(toJSON(list(response=list(tag=requestMsg$tag, error=error))))
|
|
},
|
|
.write = function(json) {
|
|
if (getOption('shiny.trace', F))
|
|
message('SEND ', json)
|
|
if (getOption('shiny.transcode.json', T))
|
|
json <- iconv(json, to='UTF-8')
|
|
websocket_write(json, .websocket)
|
|
},
|
|
|
|
# Public RPC methods
|
|
`@uploadInit` = function() {
|
|
return(list(jobId=.fileUploadContext$createUploadOperation()))
|
|
},
|
|
`@uploadFileBegin` = function(jobId, fileName, fileType, fileSize) {
|
|
.fileUploadContext$getUploadOperation(jobId)$fileBegin(list(
|
|
name=fileName, type=fileType, size=fileSize
|
|
))
|
|
invisible()
|
|
},
|
|
`@uploadFileChunk` = function(jobId, ...) {
|
|
args <- list(...)
|
|
if (length(args) != 1)
|
|
stop("Bad file chunk request")
|
|
.fileUploadContext$getUploadOperation(jobId)$fileChunk(args[[1]])
|
|
invisible()
|
|
},
|
|
`@uploadFileEnd` = function(jobId) {
|
|
.fileUploadContext$getUploadOperation(jobId)$fileEnd()
|
|
invisible()
|
|
},
|
|
`@uploadEnd` = function(jobId, inputId) {
|
|
fileData <- .fileUploadContext$getUploadOperation(jobId)$finish()
|
|
session$set(inputId, fileData)
|
|
invisible()
|
|
}
|
|
)
|
|
)
|
|
|
|
.createOutputWriter <- function(shinyapp) {
|
|
ow <- list(impl=shinyapp)
|
|
class(ow) <- 'shinyoutput'
|
|
return(ow)
|
|
}
|
|
|
|
#' @S3method $<- shinyoutput
|
|
`$<-.shinyoutput` <- function(x, name, value) {
|
|
x[['impl']]$defineOutput(name, value)
|
|
return(invisible(x))
|
|
}
|
|
|
|
resolve <- function(dir, relpath) {
|
|
abs.path <- file.path(dir, relpath)
|
|
if (!file.exists(abs.path))
|
|
return(NULL)
|
|
abs.path <- normalizePath(abs.path, winslash='/', mustWork=T)
|
|
dir <- normalizePath(dir, winslash='/', mustWork=T)
|
|
if (nchar(abs.path) <= nchar(dir) + 1)
|
|
return(NULL)
|
|
if (substr(abs.path, 1, nchar(dir)) != dir ||
|
|
!(substr(abs.path, nchar(dir)+1, nchar(dir)+1) %in% c('/', '\\'))) {
|
|
return(NULL)
|
|
}
|
|
return(abs.path)
|
|
}
|
|
|
|
httpResponse <- function(status = 200,
|
|
content_type = "text/html; charset=UTF-8",
|
|
content = "") {
|
|
resp <- list(status = status, content_type = content_type, content = content);
|
|
class(resp) <- 'httpResponse'
|
|
return(resp)
|
|
}
|
|
|
|
httpServer <- function(handlers) {
|
|
handler <- joinHandlers(handlers)
|
|
|
|
filter <- getOption('shiny.http.response.filter', NULL)
|
|
if (is.null(filter))
|
|
filter <- function(ws, header, response) response
|
|
|
|
function(ws, header) {
|
|
response <- handler(ws, header)
|
|
if (is.null(response))
|
|
response <- httpResponse(404, content="<h1>Not Found</h1>")
|
|
|
|
response <- filter(ws, header, response)
|
|
|
|
return(http_response(ws,
|
|
status=response$status,
|
|
content_type=response$content_type,
|
|
content=response$content))
|
|
}
|
|
}
|
|
|
|
joinHandlers <- function(handlers) {
|
|
handlers <- lapply(handlers, function(h) {
|
|
if (is.character(h))
|
|
return(staticHandler(h))
|
|
else
|
|
return(h)
|
|
})
|
|
|
|
# Filter out NULL
|
|
handlers <- handlers[!sapply(handlers, is.null)]
|
|
|
|
if (length(handlers) == 0)
|
|
return(function(ws, header) NULL)
|
|
if (length(handlers) == 1)
|
|
return(handlers[[1]])
|
|
|
|
function(ws, header) {
|
|
for (handler in handlers) {
|
|
response <- handler(ws, header)
|
|
if (!is.null(response))
|
|
return(response)
|
|
}
|
|
return(NULL)
|
|
}
|
|
}
|
|
|
|
dynamicHandler <- function(filePath, dependencyFiles=filePath) {
|
|
lastKnownTimestamps <- NA
|
|
metaHandler <- function(ws, header) NULL
|
|
|
|
if (!file.exists(filePath))
|
|
return(metaHandler)
|
|
|
|
return (function(ws, header) {
|
|
# Check if we need to rebuild
|
|
mtime <- file.info(dependencyFiles)$mtime
|
|
if (!identical(lastKnownTimestamps, mtime)) {
|
|
lastKnownTimestamps <<- mtime
|
|
clearClients()
|
|
if (file.exists(filePath)) {
|
|
local({
|
|
source(filePath, local=T)
|
|
})
|
|
}
|
|
metaHandler <<- joinHandlers(.globals$clients)
|
|
clearClients()
|
|
}
|
|
|
|
return(metaHandler(ws, header))
|
|
})
|
|
}
|
|
|
|
staticHandler <- function(root) {
|
|
return(function(ws, header) {
|
|
path <- header$RESOURCE
|
|
|
|
if (is.null(path))
|
|
return(httpResponse(400, content="<h1>Bad Request</h1>"))
|
|
|
|
if (path == '/')
|
|
path <- '/index.html'
|
|
|
|
abs.path <- resolve(root, path)
|
|
if (is.null(abs.path))
|
|
return(NULL)
|
|
|
|
ext <- tools::file_ext(abs.path)
|
|
content.type <- switch(ext,
|
|
html='text/html; charset=UTF-8',
|
|
htm='text/html; charset=UTF-8',
|
|
js='text/javascript',
|
|
css='text/css',
|
|
png='image/png',
|
|
jpg='image/jpeg',
|
|
jpeg='image/jpeg',
|
|
gif='image/gif',
|
|
'application/octet-stream')
|
|
response.content <- readBin(abs.path, 'raw', n=file.info(abs.path)$size)
|
|
return(httpResponse(200, content.type, response.content))
|
|
})
|
|
}
|
|
|
|
apps <- Map$new()
|
|
|
|
# Provide a character representation of the WS that can be used
|
|
# as a key in a Map.
|
|
wsToKey <- function(WS) {
|
|
as.character(WS$socket)
|
|
}
|
|
|
|
.globals <- new.env()
|
|
|
|
.globals$clients <- function(ws, header) NULL
|
|
|
|
|
|
clearClients <- function() {
|
|
.globals$clients <- function(ws, header) NULL
|
|
}
|
|
|
|
|
|
registerClient <- function(client) {
|
|
.globals$clients <- append(.globals$clients, client)
|
|
}
|
|
|
|
|
|
.globals$resources <- list()
|
|
|
|
#' Resource Publishing
|
|
#'
|
|
#' Adds a directory of static resources to Shiny's web server, with the given
|
|
#' path prefix. Primarily intended for package authors to make supporting
|
|
#' JavaScript/CSS files available to their components.
|
|
#'
|
|
#' @param prefix The URL prefix (without slashes). Valid characters are a-z,
|
|
#' A-Z, 0-9, hyphen, and underscore; and must begin with a-z or A-Z. For
|
|
#' example, a value of 'foo' means that any request paths that begin with
|
|
#' '/foo' will be mapped to the given directory.
|
|
#' @param directoryPath The directory that contains the static resources to be
|
|
#' served.
|
|
#'
|
|
#' @details You can call \code{addResourcePath} multiple times for a given
|
|
#' \code{prefix}; only the most recent value will be retained. If the
|
|
#' normalized \code{directoryPath} is different than the directory that's
|
|
#' currently mapped to the \code{prefix}, a warning will be issued.
|
|
#'
|
|
#' @seealso \code{\link{singleton}}
|
|
#'
|
|
#' @examples
|
|
#' addResourcePath('datasets', system.file('data', package='datasets'))
|
|
#'
|
|
#' @export
|
|
addResourcePath <- function(prefix, directoryPath) {
|
|
prefix <- prefix[1]
|
|
if (!grepl('^[a-z][a-z0-9\\-_]*$', prefix, ignore.case=T, perl=T)) {
|
|
stop("addResourcePath called with invalid prefix; please see documentation")
|
|
}
|
|
|
|
if (prefix %in% c('shared')) {
|
|
stop("addResourcePath called with the reserved prefix '", prefix, "'; ",
|
|
"please use a different prefix")
|
|
}
|
|
|
|
directoryPath <- normalizePath(directoryPath, mustWork=T)
|
|
|
|
existing <- .globals$resources[[prefix]]
|
|
|
|
if (!is.null(existing)) {
|
|
if (existing$directoryPath != directoryPath) {
|
|
warning("Overriding existing prefix ", prefix, " => ",
|
|
existing$directoryPath)
|
|
}
|
|
}
|
|
|
|
message('Shiny URLs starting with /', prefix, ' will mapped to ', directoryPath)
|
|
|
|
.globals$resources[[prefix]] <- list(directoryPath=directoryPath,
|
|
func=staticHandler(directoryPath))
|
|
}
|
|
|
|
resourcePathHandler <- function(ws, header) {
|
|
path <- header$RESOURCE
|
|
|
|
match <- regexpr('^/([^/]+)/', path, perl=T)
|
|
if (match == -1)
|
|
return(NULL)
|
|
len <- attr(match, 'capture.length')
|
|
prefix <- substr(path, 2, 2 + len - 1)
|
|
|
|
resInfo <- .globals$resources[[prefix]]
|
|
if (is.null(resInfo))
|
|
return(NULL)
|
|
|
|
suffix <- substr(path, 2 + len, nchar(path))
|
|
|
|
header$RESOURCE <- suffix
|
|
|
|
return(resInfo$func(ws, header))
|
|
}
|
|
|
|
.globals$server <- NULL
|
|
#' Define Server Functionality
|
|
#'
|
|
#' Defines the server-side logic of the Shiny application. This generally
|
|
#' involves creating functions that map user inputs to various kinds of output.
|
|
#'
|
|
#' @param func The server function for this application. See the details section
|
|
#' for more information.
|
|
#'
|
|
#' @details
|
|
#' Call \code{shinyServer} from your application's \code{server.R} file, passing
|
|
#' in a "server function" that provides the server-side logic of your
|
|
#' application.
|
|
#'
|
|
#' The server function will be called when each client (web browser) first loads
|
|
#' the Shiny application's page. It must take an \code{input} and an
|
|
#' \code{output} parameter. Any return value will be ignored.
|
|
#'
|
|
#' See the \href{http://rstudio.github.com/shiny/tutorial/}{tutorial} for more
|
|
#' on how to write a server function.
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' # A very simple Shiny app that takes a message from the user
|
|
#' # and outputs an uppercase version of it.
|
|
#' shinyServer(function(input, output) {
|
|
#' output$uppercase <- reactiveText(function() {
|
|
#' toupper(input$message)
|
|
#' })
|
|
#' })
|
|
#' }
|
|
#'
|
|
#' @export
|
|
shinyServer <- function(func) {
|
|
.globals$server <- func
|
|
invisible()
|
|
}
|
|
|
|
decodeMessage <- function(data) {
|
|
readInt <- function(pos) {
|
|
packBits(rawToBits(data[pos:(pos+3)]), type='integer')
|
|
}
|
|
|
|
if (readInt(1) != 0x01020202L)
|
|
return(fromJSON(rawToChar(data), asText=T, simplify=F))
|
|
|
|
i <- 5
|
|
parts <- list()
|
|
while (i <= length(data)) {
|
|
length <- readInt(i)
|
|
i <- i + 4
|
|
if (length != 0)
|
|
parts <- append(parts, list(data[i:(i+length-1)]))
|
|
else
|
|
parts <- append(parts, list(raw(0)))
|
|
i <- i + length
|
|
}
|
|
|
|
mainMessage <- decodeMessage(parts[[1]])
|
|
mainMessage$blobs <- parts[2:length(parts)]
|
|
return(mainMessage)
|
|
}
|
|
|
|
# Instantiates the app in the current working directory.
|
|
# port - The TCP port that the application should listen on.
|
|
startApp <- function(port=8101L) {
|
|
|
|
sys.www.root <- system.file('www', package='shiny')
|
|
|
|
globalR <- file.path(getwd(), 'global.R')
|
|
uiR <- file.path(getwd(), 'ui.R')
|
|
serverR <- file.path(getwd(), 'server.R')
|
|
wwwDir <- file.path(getwd(), 'www')
|
|
|
|
if (!file.exists(uiR) && !file.exists(wwwDir))
|
|
stop(paste("Neither ui.R nor a www subdirectory was found in", getwd()))
|
|
if (!file.exists(serverR))
|
|
stop(paste("server.R file was not found in", getwd()))
|
|
|
|
if (file.exists(globalR))
|
|
source(globalR, local=F)
|
|
|
|
shinyServer(NULL)
|
|
serverFileTimestamp <- NULL
|
|
local({
|
|
serverFileTimestamp <<- file.info(serverR)$mtime
|
|
source(serverR, local=T)
|
|
if (is.null(.globals$server))
|
|
stop("No server was defined in server.R")
|
|
})
|
|
serverFunc <- .globals$server
|
|
|
|
ws_env <- create_server(
|
|
port=port,
|
|
webpage=httpServer(c(dynamicHandler(uiR),
|
|
wwwDir,
|
|
sys.www.root,
|
|
resourcePathHandler)))
|
|
|
|
set_callback('established', function(WS, ...) {
|
|
shinyapp <- ShinyApp$new(WS)
|
|
apps$set(wsToKey(WS), shinyapp)
|
|
}, ws_env)
|
|
|
|
set_callback('closed', function(WS, ...) {
|
|
apps$remove(wsToKey(WS))
|
|
}, ws_env)
|
|
|
|
set_callback('receive', function(DATA, WS, ...) {
|
|
if (getOption('shiny.trace', F)) {
|
|
if (as.raw(0) %in% DATA)
|
|
message("RECV ", '$$binary data$$')
|
|
else
|
|
message("RECV ", rawToChar(DATA))
|
|
}
|
|
|
|
if (identical(charToRaw("\003\xe9"), DATA))
|
|
return()
|
|
|
|
shinyapp <- apps$get(wsToKey(WS))
|
|
|
|
msg <- decodeMessage(DATA)
|
|
|
|
# Do our own list simplifying here. sapply/simplify2array give names to
|
|
# character vectors, which is rarely what we want.
|
|
if (!is.null(msg$data)) {
|
|
msg$data <- lapply(msg$data, function(x) {
|
|
if (is.list(x) && is.null(names(x)))
|
|
unlist(x, recursive=F)
|
|
else
|
|
x
|
|
})
|
|
}
|
|
|
|
switch(
|
|
msg$method,
|
|
init = {
|
|
|
|
# Check if server.R has changed, and if so, reload
|
|
mtime <- file.info(serverR)$mtime
|
|
if (!identical(mtime, serverFileTimestamp)) {
|
|
shinyServer(NULL)
|
|
local({
|
|
serverFileTimestamp <<- mtime
|
|
source(serverR, local=T)
|
|
if (is.null(.globals$server))
|
|
stop("No server was defined in server.R")
|
|
})
|
|
serverFunc <<- .globals$server
|
|
}
|
|
|
|
shinyapp$session$mset(msg$data)
|
|
flushReact()
|
|
local({
|
|
serverFunc(input=.createValuesReader(shinyapp$session),
|
|
output=.createOutputWriter(shinyapp))
|
|
})
|
|
},
|
|
update = {
|
|
shinyapp$session$mset(msg$data)
|
|
},
|
|
shinyapp$dispatch(msg)
|
|
)
|
|
flushReact()
|
|
shinyapp$flushOutput()
|
|
}, ws_env)
|
|
|
|
message('\n', 'Listening on port ', port)
|
|
|
|
return(ws_env)
|
|
}
|
|
|
|
# NOTE: we de-roxygenized this comment because the function isn't exported
|
|
# Run an application that was created by \code{\link{startApp}}. This
|
|
# function should normally be called in a \code{while(T)} loop.
|
|
#
|
|
# @param ws_env The return value from \code{\link{startApp}}.
|
|
serviceApp <- function(ws_env) {
|
|
if (timerCallbacks$executeElapsed()) {
|
|
flushReact()
|
|
lapply(apps$values(), function(shinyapp) {
|
|
shinyapp$flushOutput()
|
|
NULL
|
|
})
|
|
}
|
|
|
|
# If this R session is interactive, then call service() with a short timeout
|
|
# to keep the session responsive to user input
|
|
maxTimeout <- ifelse(interactive(), 100, 5000)
|
|
|
|
timeout <- max(1, min(maxTimeout, timerCallbacks$timeToNextEvent()))
|
|
service(server=ws_env, timeout=timeout)
|
|
}
|
|
|
|
#' 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).
|
|
#'
|
|
#' @param appDir The directory of the application. Should contain
|
|
#' \code{server.R}, plus, either \code{ui.R} or a \code{www} directory that
|
|
#' contains the file \code{index.html}. Defaults to the working directory.
|
|
#' @param port The TCP port that the application should listen on. Defaults to
|
|
#' port 8100.
|
|
#' @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.
|
|
#'
|
|
#' @export
|
|
runApp <- function(appDir=getwd(),
|
|
port=8100L,
|
|
launch.browser=getOption('shiny.launch.browser',
|
|
interactive())) {
|
|
|
|
# Make warnings print immediately
|
|
ops <- options(warn = 1)
|
|
on.exit(options(ops))
|
|
|
|
orig.wd <- getwd()
|
|
setwd(appDir)
|
|
on.exit(setwd(orig.wd))
|
|
|
|
ws_env <- startApp(port=port)
|
|
|
|
if (launch.browser) {
|
|
appUrl <- paste("http://localhost:", port, sep="")
|
|
utils::browseURL(appUrl)
|
|
}
|
|
|
|
tryCatch(
|
|
while (T) {
|
|
serviceApp(ws_env)
|
|
},
|
|
finally = {
|
|
websocket_close(ws_env)
|
|
}
|
|
)
|
|
}
|
|
|
|
#' 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 \code{NA} (the default) to
|
|
#' list the available examples.
|
|
#' @param port The TCP port that the application should listen on. Defaults to
|
|
#' port 8100.
|
|
#' @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.
|
|
#'
|
|
#' @export
|
|
runExample <- function(example=NA,
|
|
port=8100L,
|
|
launch.browser=getOption('shiny.launch.browser',
|
|
interactive())) {
|
|
examplesDir <- system.file('examples', package='shiny')
|
|
dir <- resolve(examplesDir, example)
|
|
if (is.null(dir)) {
|
|
if (is.na(example)) {
|
|
errFun <- message
|
|
errMsg <- ''
|
|
}
|
|
else {
|
|
errFun <- stop
|
|
errMsg <- paste('Example', example, 'does not exist. ')
|
|
}
|
|
|
|
errFun(errMsg,
|
|
'Valid examples are "',
|
|
paste(list.files(examplesDir), collapse='", "'),
|
|
'"')
|
|
}
|
|
else {
|
|
runApp(dir, port = port, launch.browser = launch.browser)
|
|
}
|
|
}
|