Merge pull request #563 from rstudio/single-file2

Single-file app support

R/app.R

@@ -42,35 +42,16 @@
 #' }
 #'
 #' @export
-shinyApp <- function(ui, server, onStart=NULL, options=list(), uiPattern="/") {
+shinyApp <- function(ui=NULL, server=NULL, onStart=NULL, options=list(),
+                     uiPattern="/") {
+  if (is.null(server)) {
+    stop("`server` missing from shinyApp")
+  }
+
   # Ensure that the entire path is a match
   uiPattern <- sprintf("^%s$", uiPattern)
 
-  httpHandler <- function(req) {
-    if (!identical(req$REQUEST_METHOD, 'GET'))
-      return(NULL)
-
-    if (!isTRUE(grepl(uiPattern, req$PATH_INFO)))
-      return(NULL)
-
-    textConn <- textConnection(NULL, "w")
-    on.exit(close(textConn))
-
-    uiValue <- if (is.function(ui)) {
-      if (length(formals(ui)) > 0)
-        ui(req)
-      else
-        ui()
-    } else {
-      ui
-    }
-    if (is.null(uiValue))
-      return(NULL)
-
-    renderPage(uiValue, textConn)
-    html <- paste(textConnectionValue(textConn), collapse='\n')
-    return(httpResponse(200, content=enc2utf8(html)))
-  }
+  httpHandler <- uiHttpHandler(ui, uiPattern)
 
   serverFuncSource <- function() {
     server
@@ -91,9 +72,6 @@ shinyApp <- function(ui, server, onStart=NULL, options=list(), uiPattern="/") {
 #'   file and either ui.R or www/index.html)
 #' @export
 shinyAppDir <- function(appDir, options=list()) {
-  # Most of the complexity here comes from needing to hot-reload if the .R files
-  # change on disk, or are created, or are removed.
-
   if (!file.exists(appDir)) {
     stop("No Shiny application exists at the path \"", appDir, "\"")
   }
@@ -102,6 +80,21 @@ shinyAppDir <- function(appDir, options=list()) {
   # affected by future changes to the path)
   appDir <- normalizePath(appDir, mustWork = TRUE)
 
+  if (file.exists.ci(appDir, "app.R")) {
+    shinyAppDir_appR(appDir, options = options)
+  } else if (file.exists.ci(appDir, "server.R")) {
+    shinyAppDir_serverR(appDir, options = options)
+  } else {
+    stop("App dir must contain either app.R or server.R.")
+  }
+}
+
+# This reads in an app dir in the case that there's a server.R (and ui.R/www)
+# present, and returns a shiny.appobj.
+shinyAppDir_serverR <- function(appDir, options=list()) {
+  # Most of the complexity here comes from needing to hot-reload if the .R files
+  # change on disk, or are created, or are removed.
+
   # uiHandlerSource is a function that returns an HTTP handler for serving up
   # ui.R as a webpage. The "cachedFuncWithFile" call makes sure that the closure
   # we're creating here only gets executed when ui.R's contents change.
@@ -180,6 +173,60 @@ shinyAppDir <- function(appDir, options=list()) {
   )
 }
 
+# This reads in an app dir in the case that there's a app.R present, and returns
+# a shiny.appobj.
+shinyAppDir_appR <- function(appDir, options=list()) {
+  fullpath <- file.path.ci(appDir, "app.R")
+
+  # This sources app.R and caches the content. When appObj() is called but
+  # app.R hasn't changed, it won't re-source the file. But if called and
+  # app.R has changed, it'll re-source the file and return the result.
+  appObj <- cachedFuncWithFile(appDir, "app.R", case.sensitive = FALSE,
+    function(appR) {
+      result <- sourceUTF8(fullpath, local = new.env(parent = globalenv()))$value
+
+      if (!is.shiny.appobj(result))
+        stop("app.R did not return a shiny.appobj object.")
+
+      return(result)
+    }
+  )
+
+  # A function that invokes the http handler from the appObj in app.R, but
+  # since this uses appObj(), it only re-sources the file when it changes.
+  dynHttpHandler <- function(...) {
+    appObj()$httpHandler(...)
+  }
+
+  dynServerFuncSource <- function(...) {
+    appObj()$serverFuncSource(...)
+  }
+
+  wwwDir <- file.path.ci(appDir, "www")
+  fallbackWWWDir <- system.file("www-dir", package = "shiny")
+
+  oldwd <- NULL
+  onStart <- function() {
+    oldwd <<- getwd()
+    setwd(appDir)
+  }
+  onEnd <- function() {
+    setwd(oldwd)
+  }
+
+  structure(
+    list(
+      httpHandler = joinHandlers(c(dynHttpHandler, wwwDir, fallbackWWWDir)),
+      serverFuncSource = dynServerFuncSource,
+      onStart = onStart,
+      onEnd = onEnd,
+      options = options
+    ),
+    class = "shiny.appobj"
+  )
+}
+
+
 #' @rdname shinyApp
 #' @param x Object to convert to a Shiny app.
 #' @export
@@ -205,6 +252,12 @@ as.shiny.appobj.character <- function(x) {
   shinyAppDir(x)
 }
 
+#' @rdname shinyApp
+#' @export
+is.shiny.appobj <- function(x) {
+  inherits(x, "shiny.appobj")
+}
+
 #' @rdname shinyApp
 #' @param ... Additional parameters to be passed to print.
 #' @export

R/shinyui.R

@@ -99,7 +99,7 @@ shinyUI <- function(ui) {
   ui
 }
 
-uiHttpHandler <- function(ui, path = "/") {
+uiHttpHandler <- function(ui, uiPattern = "^/$") {
 
   force(ui)
 
@@ -107,7 +107,7 @@ uiHttpHandler <- function(ui, path = "/") {
     if (!identical(req$REQUEST_METHOD, 'GET'))
       return(NULL)
 
-    if (req$PATH_INFO != path)
+    if (!isTRUE(grepl(uiPattern, req$PATH_INFO)))
       return(NULL)
 
     textConn <- textConnection(NULL, "w")

R/showcase.R

@@ -90,7 +90,7 @@ showcaseCodeTabs <- function(codeLicense) {
       i(class="fa fa-level-up", "show with app")),
     ul(class="nav nav-tabs",
        lapply(rFiles, function(rFile) {
-         li(class=if (tolower(rFile) == "server.r") "active" else "",
+         li(class=if (tolower(rFile) %in% c("app.r", "server.r")) "active" else "",
             a(href=paste("#", gsub(".", "_", rFile, fixed=TRUE),
                          "_code", sep=""),
               "data-toggle"="tab", rFile))
@@ -98,7 +98,8 @@ showcaseCodeTabs <- function(codeLicense) {
     div(class="tab-content", id="showcase-code-content",
         lapply(rFiles, function(rFile) {
           div(class=paste("tab-pane",
-                          if (tolower(rFile) == "server.r") " active" else "",
+                          if (tolower(rFile) %in% c("app.r", "server.r")) " active"
+                          else "",
                           sep=""),
               id=paste(gsub(".", "_", rFile, fixed=TRUE),
                        "_code", sep=""),

R/utils.R

@@ -153,19 +153,43 @@ dropNullsOrEmpty <- function(x) {
 
 # Combine dir and (file)name into a file path. If a file already exists with a
 # name differing only by case, then use it instead.
-file.path.ci <- function(dir, name) {
-  default <- file.path(dir, name)
+file.path.ci <- function(...) {
+  result <- find.file.ci(...)
+  if (!is.null(result))
+    return(result)
+
+  # If not found, return the file path that was given to us.
+  return(file.path(...))
+}
+
+# Does a particular file exist? Case-insensitive for filename, case-sensitive
+# for path (on platforms with case-sensitive file system).
+file.exists.ci <- function(...) {
+  !is.null(find.file.ci(...))
+}
+
+# Look for a file, case-insensitive for filename, case-sensitive for path (on
+# platforms with case-sensitive filesystem). If found, return the path to the
+# file, with the correct case. If not found, return NULL.
+find.file.ci <- function(...) {
+  default <- file.path(...)
+  if (length(default) > 1)
+    stop("find.file.ci can only check for one file at a time.")
   if (file.exists(default))
     return(default)
-  if (!file.exists(dir))
-    return(default)
 
+  dir <- dirname(default)
+  name <- basename(default)
+
+  # If we got here, then we'll check for a directory with the exact case, and a
+  # name with any case.
   all_files <- list.files(dir, all.files=TRUE, full.names=TRUE,
                           include.dirs=TRUE)
   match_idx <- tolower(name) == tolower(basename(all_files))
   matches <- all_files[match_idx]
   if (length(matches) == 0)
-    return(default)
+    return(NULL)
+
   return(matches[1])
 }
 

inst/examples/12_singlefile/DESCRIPTION

@@ -0,0 +1,7 @@
+Title: Single-file shiny app
+Author: RStudio, Inc.
+AuthorUrl: http://www.rstudio.com/
+License: MIT
+DisplayMode: Showcase
+Tags: getting-started
+Type: Shiny

inst/examples/12_singlefile/app.R

@@ -0,0 +1,20 @@
+# Global variables can go here
+n <- 200
+
+
+# Define the UI
+ui <- bootstrapPage(
+  numericInput('n', 'Number of obs', n),
+  plotOutput('plot')
+)
+
+
+# Define the server code
+server <- function(input, output) {
+  output$plot <- renderPlot({
+    hist(runif(input$n))
+  })
+}
+
+# Return a Shiny app object
+shinyApp(ui = ui, server = server)

inst/www-dir/index.html

@@ -7,6 +7,7 @@
   <ul>
     <li><code>www/index.html</code></li>
     <li><code>ui.R</code></li>
+    <li><code>app.R</code></li>
   </ul>
 </body>
 </html>