Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge remote-tracking branch 'upstream/master'
  • Loading branch information
kippandrew committed Oct 28, 2015
2 parents 1f49756 + 32c5c3d commit a6f57de
Show file tree
Hide file tree
Showing 11 changed files with 131 additions and 21 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
@@ -1,7 +1,7 @@
Package: shinyapps
Type: Package
Title: Deployment Interface for Shiny Applications
Version: 0.4.1.7
Version: 0.4.1.8
Date: 2015-10-22
Author: JJ Allaire
Maintainer: JJ Allaire <jj@rstudio.com>
Expand Down
39 changes: 29 additions & 10 deletions R/bundle.R
@@ -1,4 +1,4 @@
bundleAppDir <- function(appDir, appFiles) {
bundleAppDir <- function(appDir, appFiles, appPrimaryDoc = NULL) {
# create a directory to stage the application bundle in
bundleDir <- tempfile()
dir.create(bundleDir, recursive = TRUE)
Expand All @@ -8,6 +8,13 @@ bundleAppDir <- function(appDir, appFiles) {
for (file in appFiles) {
from <- file.path(appDir, file)
to <- file.path(bundleDir, file)
# if deploying a single-file Shiny application, name it "app.R" so it can
# be run as an ordinary Shiny application
if (is.character(appPrimaryDoc) &&
tolower(tools::file_ext(appPrimaryDoc)) == "r" &&
file == appPrimaryDoc) {
to <- file.path(bundleDir, "app.R")
}
if (!file.exists(dirname(to)))
dir.create(dirname(to), recursive = TRUE)
file.copy(from, to)
Expand All @@ -33,14 +40,14 @@ bundleFiles <- function(appDir) {
}

bundleApp <- function(appName, appDir, appFiles, appPrimaryDoc, assetTypeName,
contentCategory, accountInfo) {
contentCategory) {

# infer the mode of the application from its layout
appMode <- inferAppMode(appDir, appFiles)
appMode <- inferAppMode(appDir, appPrimaryDoc, appFiles)
hasParameters <- appHasParameters(appDir, appFiles)

# copy files to bundle dir to stage
bundleDir <- bundleAppDir(appDir, appFiles)
bundleDir <- bundleAppDir(appDir, appFiles, appPrimaryDoc)

# get application users (for non-document deployments)
users <- NULL
Expand All @@ -51,8 +58,7 @@ bundleApp <- function(appName, appDir, appFiles, appPrimaryDoc, assetTypeName,
# generate the manifest and write it into the bundle dir
manifestJson <- enc2utf8(createAppManifest(bundleDir, appMode,
contentCategory, hasParameters,
accountInfo,
appFiles, appPrimaryDoc,
appPrimaryDoc,
assetTypeName, users))
writeLines(manifestJson, file.path(bundleDir, "manifest.json"),
useBytes = TRUE)
Expand Down Expand Up @@ -119,7 +125,14 @@ isShinyRmd <- function(filename) {
return(FALSE)
}

inferAppMode <- function(appDir, files) {
inferAppMode <- function(appDir, appPrimaryDoc, files) {
# single-file Shiny application
if (!is.null(appPrimaryDoc) &&
tolower(tools::file_ext(appPrimaryDoc)) == "r") {
return("shiny")
}

# shiny directory
shinyFiles <- grep("^(server|app).r$", files, ignore.case = TRUE, perl = TRUE)
if (length(shinyFiles) > 0) {
return("shiny")
Expand Down Expand Up @@ -165,8 +178,8 @@ inferDependencies <- function(appMode, hasParameters) {
unique(deps)
}

createAppManifest <- function(appDir, appMode, contentCategory, hasParameters, accountInfo,
files, appPrimaryDoc, assetTypeName, users) {
createAppManifest <- function(appDir, appMode, contentCategory, hasParameters,
appPrimaryDoc, assetTypeName, users) {

# provide package entries for all dependencies
packages <- list()
Expand Down Expand Up @@ -211,6 +224,10 @@ createAppManifest <- function(appDir, appMode, contentCategory, hasParameters, a
}
if (length(msg)) stop(paste(formatUL(msg, '\n*'), collapse = '\n'), call. = FALSE)

# build the list of files to checksum
files <- list.files(appDir, recursive = TRUE, all.files = TRUE,
full.names = FALSE)

# provide checksums for all files
filelist <- list()
for (file in files) {
Expand Down Expand Up @@ -264,7 +281,9 @@ createAppManifest <- function(appDir, appMode, contentCategory, hasParameters, a
metadata <- list(appmode = appMode)

# emit appropriate primary document information
primaryDoc <- ifelse(is.null(appPrimaryDoc), NA, appPrimaryDoc)
primaryDoc <- ifelse(is.null(appPrimaryDoc) ||
tolower(tools::file_ext(appPrimaryDoc)) == "r",
NA, appPrimaryDoc)
metadata$primary_rmd <- ifelse(grepl("\\brmd\\b", appMode), primaryDoc, NA)
metadata$primary_html <- ifelse(appMode == "static", primaryDoc, NA)

Expand Down
5 changes: 2 additions & 3 deletions R/deployApp.R
Expand Up @@ -132,7 +132,7 @@ deployApp <- function(appDir = getwd(),
}

if (isTRUE(lint)) {
lintResults <- lint(appDir, appFiles)
lintResults <- lint(appDir, appFiles, appPrimaryDoc)

if (hasLint(lintResults)) {

Expand Down Expand Up @@ -195,8 +195,7 @@ deployApp <- function(appDir = getwd(),
withStatus(paste0("Uploading bundle for ", assetTypeName, ": ",
application$id), {
bundlePath <- bundleApp(target$appName, appDir, appFiles,
appPrimaryDoc, assetTypeName, contentCategory,
accountDetails)
appPrimaryDoc, assetTypeName, contentCategory)
bundle <- client$uploadApplication(application$id, bundlePath)
})
} else {
Expand Down
25 changes: 20 additions & 5 deletions R/lint-framework.R
Expand Up @@ -67,8 +67,10 @@ applyLinter <- function(linter, ...) {
##' @param project Path to a project directory.
##' @param files Specific files to lint. Can be NULL, in which case all
##' the files in the directory will be linted.
##' @param appPrimaryDoc The primary file in the project directory. Can be NULL,
##' in which case it's inferred (if possible) from the directory contents.
##' @export
lint <- function(project, files = NULL) {
lint <- function(project, files = NULL, appPrimaryDoc = NULL) {

if (!file.exists(project))
stop("No directory at path '", project, "'")
Expand All @@ -93,13 +95,25 @@ lint <- function(project, files = NULL) {
projectFiles <- gsub("^\\./", "", projectFiles)
names(projectFiles) <- projectFiles

# Do some checks for a valid application structure
# collect files
appFilesBase <- tolower(list.files())
wwwFiles <- tolower(list.files("www/"))

# check for single-file app collision
if (!is.null(appPrimaryDoc) &&
tolower(tools::file_ext(appPrimaryDoc)) == "r" &&
"app.r" %in% appFilesBase) {
stop("The project contains both a single-file Shiny application and a ",
"file named app.R; it must contain only one of these.")
}

# Do some checks for a valid application structure
satisfiedLayouts <- c(
shinyAndUi = all(c("server.r", "ui.r") %in% appFilesBase),
shinyAndIndex = "server.r" %in% appFilesBase && "index.html" %in% wwwFiles,
app = "app.r" %in% appFilesBase,
app = any("app.r" %in% appFilesBase,
!is.null(appPrimaryDoc) &&
tolower(tools::file_ext(appPrimaryDoc)) == "r"),
Rmd = any(grepl(glob2rx("*.rmd"), appFilesBase)),
static = any(grepl("^.*\\.html?$", appFilesBase))
)
Expand All @@ -109,8 +123,9 @@ lint <- function(project, files = NULL) {
The project should have one of the following layouts:
1. 'shiny.R' and 'ui.R' in the application base directory,
2. 'shiny.R' and 'www/index.html' in the application base directory,
3. An R Markdown (.Rmd) document,
4. A static HTML (.html) document."
3. 'app.R' or a single-file Shiny .R file,
4. An R Markdown (.Rmd) document,
5. A static HTML (.html) document."

# strip leading whitespace from the above
msg <- paste(collapse = "\n",
Expand Down
2 changes: 1 addition & 1 deletion R/utils.R
Expand Up @@ -144,7 +144,7 @@ fileLeaf <- function(path) {
# whether the given path points to an individual piece of content
isDocumentPath <- function(path) {
ext <- tolower(tools::file_ext(path))
!is.null(ext) && ext != "" && ext != "r"
!is.null(ext) && ext != ""
}

# given a path, return the directory under which rsconnect package state is
Expand Down
5 changes: 4 additions & 1 deletion man/lint.Rd
Expand Up @@ -4,13 +4,16 @@
\alias{lint}
\title{Lint a Project}
\usage{
lint(project, files = NULL)
lint(project, files = NULL, appPrimaryDoc = NULL)
}
\arguments{
\item{project}{Path to a project directory.}

\item{files}{Specific files to lint. Can be NULL, in which case all
the files in the directory will be linted.}

\item{appPrimaryDoc}{The primary file in the project directory. Can be NULL,
in which case it's inferred (if possible) from the directory contents.}
}
\description{
Takes the set of active linters (see \code{\link{addLinter}}), and applies
Expand Down
12 changes: 12 additions & 0 deletions tests/testthat/shinyapp-appR/app.R
@@ -0,0 +1,12 @@
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500,
value = 100)),
mainPanel(plotOutput("distPlot"))))
shinyApp(ui = ui, server = server)
8 changes: 8 additions & 0 deletions tests/testthat/shinyapp-simple/server.R
@@ -0,0 +1,8 @@
library(shiny)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
dist <- rnorm(input$obs)
hist(dist)
})
output$obs <- renderText({paste(input$obs, "\n", input$obs)})
})
11 changes: 11 additions & 0 deletions tests/testthat/shinyapp-simple/ui.R
@@ -0,0 +1,11 @@
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello, Shiny!"),
sidebarPanel(
sliderInput("obs", "Number of observations:",
min = 1,
max = 1000,
value = 500)),
mainPanel(
plotOutput("distPlot")))
)
12 changes: 12 additions & 0 deletions tests/testthat/shinyapp-singleR/single.R
@@ -0,0 +1,12 @@
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500,
value = 100)),
mainPanel(plotOutput("distPlot"))))
shinyApp(ui = ui, server = server)
31 changes: 31 additions & 0 deletions tests/testthat/test-bundle.R
@@ -0,0 +1,31 @@
context("bundle")

makeShinyBundleTempDir <- function(appName, appDir, appPrimaryDoc) {
tarfile <- bundleApp(appName, appDir, bundleFiles(appDir), appPrimaryDoc,
"application", NULL)
bundleTempDir <- tempfile()
utils::untar(tarfile, exdir = bundleTempDir)
unlink(tarfile)
bundleTempDir
}

test_that("simple Shiny app bundle is runnable", {
bundleTempDir <- makeShinyBundleTempDir("simple_shiny", "shinyapp-simple",
NULL)
on.exit(unlink(bundleTempDir, recursive = TRUE))
expect_true(inherits(shiny::shinyAppDir(bundleTempDir), "shiny.appobj"))
})

test_that("app.R Shiny app bundle is runnable", {
bundleTempDir <- makeShinyBundleTempDir("app_r_shiny", "shinyapp-appR",
NULL)
on.exit(unlink(bundleTempDir, recursive = TRUE))
expect_true(inherits(shiny::shinyAppDir(bundleTempDir), "shiny.appobj"))
})

test_that("single-file Shiny app bundle is runnable", {
bundleTempDir <- makeShinyBundleTempDir("app_r_shiny", "shinyapp-singleR",
"single.R")
on.exit(unlink(bundleTempDir, recursive = TRUE))
expect_true(inherits(shiny::shinyAppDir(bundleTempDir), "shiny.appobj"))
})

0 comments on commit a6f57de

Please sign in to comment.