Automatically load 'helpers' in R/ directory at runtime

NAMESPACE

@@ -138,6 +138,7 @@ export(knit_print.shiny.appobj)
 export(knit_print.shiny.render.function)
 export(knit_print.shiny.tag)
 export(knit_print.shiny.tag.list)
+export(loadSupport)
 export(mainPanel)
 export(makeReactiveBinding)
 export(markRenderFunction)

NEWS.md

@@ -3,6 +3,8 @@ shiny 1.3.2.9001
 
 ## Changes
 
+* All files ending in `.r` or `.R` contained in a directory named `R/` adjacent to your application are sourced when your app is started. ([#2547](https://github.com/rstudio/shiny/pull/2547))
+
 * Resolved [#1433](https://github.com/rstudio/shiny/issues/1433): `plotOutput()`'s coordmap info now includes discrete axis limits for **ggplot2** plots. As a result, any **shinytest** tests that contain **ggplot2** plots with discrete axes (that were recorded before this change) will now report differences that can safely be updated. This new coordmap info was added to correctly infer what data points are within an input brush and/or near input click/hover in scenarios where a non-trivial discrete axis scale is involved (e.g., whenever `scale_[x/y]_discrete(limits = ...)` and/or free scales across multiple discrete axes are used). ([#2410](https://github.com/rstudio/shiny/pull/2410))
 
 ### Improvements

R/app.R

@@ -139,10 +139,15 @@ shinyAppFile <- function(appFile, options=list()) {
 
 # 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.
+# appDir must be a normalized (absolute) path, not a relative one
 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.
 
+  # Create a child env which contains all the helpers and will be the shared parent
+  # of the ui.R and server.R load.
+  sharedEnv <- new.env(parent = globalenv())
+
   # 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.
@@ -153,7 +158,7 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
         # If not, then take the last expression that's returned from ui.R.
         .globals$ui <- NULL
         on.exit(.globals$ui <- NULL, add = FALSE)
-        ui <- sourceUTF8(uiR, envir = new.env(parent = globalenv()))
+        ui <- sourceUTF8(uiR, envir = new.env(parent = sharedEnv))
         if (!is.null(.globals$ui)) {
           ui <- .globals$ui[[1]]
         }
@@ -183,7 +188,7 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
       # server.R.
       .globals$server <- NULL
       on.exit(.globals$server <- NULL, add = TRUE)
-      result <- sourceUTF8(serverR, envir = new.env(parent = globalenv()))
+      result <- sourceUTF8(serverR, envir = new.env(parent = sharedEnv))
       if (!is.null(.globals$server)) {
         result <- .globals$server[[1]]
       }
@@ -214,8 +219,8 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
     oldwd <<- getwd()
     setwd(appDir)
     monitorHandle <<- initAutoReloadMonitor(appDir)
-    if (file.exists(file.path.ci(appDir, "global.R")))
-      sourceUTF8(file.path.ci(appDir, "global.R"))
+    # TODO: we should support hot reloading on global.R and R/*.R changes.
+    loadSupport(appDir, renv=sharedEnv, globalrenv=globalenv())
   }
   onStop <- function() {
     setwd(oldwd)
@@ -288,18 +293,53 @@ initAutoReloadMonitor <- function(dir) {
   obs$destroy
 }
 
+#' Load an app's supporting R files
+#'
+#' Loads all of the supporting R files of a Shiny application. Specifically,
+#' this function loads any top-level supporting `.R` files in the `R/` directory
+#' adjacent to the app and a `global.R` file.
+#'
+#' @details The files are sourced in alphabetical order (as determined by
+#'   [list.files]). `global.R` is evaluated before the supporting R files in the
+#'   `R/` directory.
+#' @param appDir The application directory
+#' @param renv The environmeny in which the files in the `R/` directory should
+#'   be evaluated.
+#' @param globalrenv The environment in which `global.R` should be evaluated. If
+#'   `NULL`, `global.R` will not be evaluated at all.
+#' @export
+loadSupport <- function(appDir, renv=new.env(parent=globalenv()), globalrenv=globalenv()){
+  if (!is.null(globalrenv)){
+    # Evaluate global.R, if it exists.
+    if (file.exists(file.path.ci(appDir, "global.R"))){
+      sourceUTF8(file.path.ci(appDir, "global.R"), envir=globalrenv)
+    }
+  }
+  helpersDir <- file.path(appDir, "R")
+  helpers <- list.files(helpersDir, pattern="\\.[rR]$", recursive=FALSE, full.names=TRUE)
+
+  lapply(helpers, sourceUTF8, envir=renv)
+
+  invisible(renv)
+}
+
 # This reads in an app dir for a single-file application (e.g. app.R), and
 # returns a shiny.appobj.
+# appDir must be a normalized (absolute) path, not a relative one
 shinyAppDir_appR <- function(fileName, appDir, options=list())
 {
   fullpath <- file.path.ci(appDir, fileName)
 
+  # Create a child env which contains all the helpers and will be the parent
+  # of app.R
+  sharedEnv <- new.env(parent = globalenv())
+
   # 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, fileName, case.sensitive = FALSE,
     function(appR) {
-      result <- sourceUTF8(fullpath, envir = new.env(parent = globalenv()))
+      result <- sourceUTF8(fullpath, envir = new.env(parent = sharedEnv))
 
       if (!is.shiny.appobj(result))
         stop("app.R did not return a shiny.appobj object.")
@@ -342,6 +382,8 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
   onStart <- function() {
     oldwd <<- getwd()
     setwd(appDir)
+    # TODO: we should support hot reloading on R/*.R changes.
+    loadSupport(appDir, renv=sharedEnv, globalrenv=NULL)
     monitorHandle <<- initAutoReloadMonitor(appDir)
     if (!is.null(appObj()$onStart)) appObj()$onStart()
   }

inst/staticdocs/index.r

@@ -155,7 +155,8 @@ sd_section("Running",
     "runUrl",
     "stopApp",
     "viewer",
-    "isRunning"
+    "isRunning",
+    "loadSupport"
   )
 )
 sd_section("Bookmarking state",

tests/test-helpers/app1-standard/R/helperCap.R

@@ -0,0 +1,2 @@
+
+helper1 <- 123

tests/test-helpers/app1-standard/R/helperLower.r

@@ -0,0 +1,2 @@
+
+helper2 <- "abc"

tests/test-helpers/app1-standard/global.R

@@ -0,0 +1 @@
+global <- "ABC"

tests/test-helpers/app2-nested/R/helper.R

@@ -0,0 +1,2 @@
+
+helper1 <- 456

tests/test-helpers/app2-nested/R/nested/helper.R

@@ -0,0 +1,2 @@
+
+helper2 <- "def"

tests/test-helpers/app2-nested/app.R

@@ -0,0 +1,8 @@
+
+library(shiny)
+
+ui <- fluidPage()
+
+server <- function(input, output) {}
+
+shinyApp(ui = ui, server = server)

tests/test-helpers/app3-badglobal/R/helper.R

@@ -0,0 +1,2 @@
+
+helper1 <- 456

tests/test-helpers/app3-badglobal/global.R

@@ -0,0 +1,2 @@
+
+stop("I wasn't supposed to be sourced")

tests/test-helpers/app4-both/r/lower.R

@@ -0,0 +1 @@
+lowerHelper <- 123

tests/testthat/helper.R

@@ -49,8 +49,21 @@ contents_identical <- function(a, b) {
   TRUE
 }
 
-
 # Don't print out stack traces (which go to stderr)
 suppress_stacktrace <- function(expr) {
   capture.output(force(expr), type = "message")
 }
+
+# Rewire copies the given function, f, and replaces any named
+# provided arguments in its execution.
+# Note #1: this only substitutes variables at the top-level function
+#   call. Recursive calls back into this function will not have the
+#   substitutions.
+# Note #2: this function won't work if the call includes the namespace.
+#   i.e. `rewire(f, ls=function(x))` will not rewire a call to `base::ls()`.
+rewire <- function(f, ...) {
+  orig_env <- environment(f)
+  new_env <- list2env(list(...), parent = orig_env)
+  environment(f) <- new_env
+  f
+}

tests/testthat/test-app.R

@@ -0,0 +1,127 @@
+
+context("app")
+
+test_that("files are loaded into the right env", {
+  renv <- new.env(parent=environment())
+  genv <- new.env(parent=environment())
+
+  loadSupport("../test-helpers/app1-standard", renv=renv, globalrenv=genv)
+  expect_equal(get("helper1", renv, inherits=FALSE), 123)
+  expect_equal(get("helper2", renv, inherits=FALSE), "abc")
+
+  expect_equal(get("global", genv, inherits=FALSE), "ABC")
+})
+
+test_that("Can suppress sourcing global.R", {
+  # Confirm that things blow up if we source global.R
+  expect_error(loadSupport("../test-helpers/app3-badglobal"))
+
+  # Shouldn't see an error now that we're suppressing global sourcing.
+  renv <- loadSupport("../test-helpers/app3-badglobal", globalrenv=NULL)
+
+  # But other helpers are still sourced
+  expect_true(exists("helper1", envir=renv))
+})
+
+test_that("nested helpers are not loaded", {
+  loadSupport("../test-helpers/app2-nested", renv=environment())
+  expect_equal(helper1, 456)
+  expect_false(exists("helper2"))
+})
+
+test_that("app with both r/ and R/ prefers R/", {
+  ## App 4 already has a lower-case r/ directory. Try to create an upper.
+  tryCatch(dir.create("../test-helpers/app4-both/R"),
+           warning=function(w){testthat::skip("File system is not case-sensitive")})
+  writeLines("upperHelper <- 'abc'", file.path("../test-helpers/app4-both/R", "upper.R"))
+
+  renv <- loadSupport("../test-helpers/app4-both")
+
+  expect_false(exists("lowerHelper", envir=renv))
+  expect_equal(upperHelper, "abc", envir=renv)
+})
+
+test_that("With ui/server.R, global.R is loaded before R/ helpers and into the right envs", {
+  calls <- list()
+  sourceStub <- function(...){
+    calls[[length(calls)+1]] <<- list(...)
+    NULL
+  }
+
+  # + shinyAppDir_serverR
+  # +--- sourceUTF8
+  # +--+ loadSupport
+  # |  +--- sourceUTF8
+  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceStub)
+  sad <- rewire(shinyAppDir_serverR, sourceUTF8 = sourceStub, loadSupport = loadSpy)
+
+  sa <- sad(normalizePath("../test-helpers/app1-standard"))
+  sa$onStart()
+  sa$onStop() # Close down to free up resources
+
+  # Should have seen three calls -- first to global then to the helpers
+  expect_length(calls, 3)
+  expect_match(calls[[1]][[1]], "/global\\.R$", perl=TRUE)
+  expect_match(calls[[2]][[1]], "/helperCap\\.R$", perl=TRUE)
+  expect_match(calls[[3]][[1]], "/helperLower\\.r$", perl=TRUE)
+
+  # Check environments
+  # global.R loaded into the global env
+  gEnv <- calls[[1]]$envir
+  expect_identical(gEnv, globalenv())
+
+  # helpers are loaded into a child of the global env
+  helperEnv1 <- calls[[2]]$envir
+  helperEnv2 <- calls[[3]]$envir
+  expect_identical(helperEnv1, helperEnv2)
+  expect_identical(parent.env(helperEnv1), globalenv())
+
+  calls <- NULL
+  # Source the server
+  sa$serverFuncSource()
+  expect_length(calls, 1)
+  # server.R is sourced into a child environment of the helpers
+  expect_match(calls[[1]][[1]], "/server\\.R$")
+  expect_identical(parent.env(calls[[1]]$envir), helperEnv1)
+
+  calls <- NULL
+  # Invoke the UI by simulating a request
+  sa$httpHandler(list())
+  expect_length(calls, 1)
+  # ui.R is sourced into a child environment of the helpers
+  expect_match(calls[[1]][[1]], "/ui\\.R$")
+  expect_identical(parent.env(calls[[1]]$envir), helperEnv1)
+})
+
+
+test_that("app.R is loaded after R/ helpers and into the right envs", {
+  calls <- list()
+  sourceSpy <- function(...){
+    calls[[length(calls)+1]] <<- list(...)
+    do.call(sourceUTF8, list(...))
+  }
+
+  # + shinyAppDir_serverR
+  # +--- sourceUTF8
+  # +--+ loadSupport
+  # |  +--- sourceUTF8
+  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceSpy)
+  sad <- rewire(shinyAppDir_appR, sourceUTF8 = sourceSpy, loadSupport = loadSpy)
+
+  sa <- sad("app.R", normalizePath("../test-helpers/app2-nested"))
+  sa$onStart()
+  sa$onStop() # Close down to free up resources
+
+  # Should have seen three calls -- first to two helpers then to app.R
+  expect_length(calls, 2)
+  expect_match(calls[[1]][[1]], "/helper\\.R$", perl=TRUE)
+  expect_match(calls[[2]][[1]], "/app\\.R$", perl=TRUE)
+
+  # Check environments
+  # helpers are loaded into a child of the global env
+  helperEnv1 <- calls[[1]]$envir
+  expect_identical(parent.env(helperEnv1), globalenv())
+
+  # app.R is sourced into a child environment of the helpers
+  expect_identical(parent.env(calls[[2]]$envir), helperEnv1)
+})

tests/testthat/test-options.R

@@ -1,6 +1,9 @@
 context("options")
 
 test_that("Local options", {
+  # Clear out any options so we know we're starting fresh
+  .globals$options <- list()
+
   # Basic options
   shinyOptions(a = 1, b = 2)