Merge pull request #988 from rstudio/joe/feature/namespaces

Shiny modules

DESCRIPTION

@@ -117,6 +117,7 @@ Collate:
     'jqueryui.R'
     'middleware-shiny.R'
     'middleware.R'
+    'modules.R'
     'priorityqueue.R'
     'progress.R'
     'react.R'

NAMESPACE

@@ -1,8 +1,10 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
 S3method("$",reactivevalues)
+S3method("$",session_proxy)
 S3method("$",shinyoutput)
 S3method("$<-",reactivevalues)
+S3method("$<-",session_proxy)
 S3method("$<-",shinyoutput)
 S3method("[",reactivevalues)
 S3method("[",shinyoutput)
@@ -24,6 +26,7 @@ S3method(print,reactive)
 S3method(print,shiny.appobj)
 S3method(str,reactivevalues)
 export(HTML)
+export(NS)
 export(Progress)
 export(a)
 export(absolutePanel)
@@ -37,6 +40,7 @@ export(bootstrapPage)
 export(br)
 export(brushOpts)
 export(brushedPoints)
+export(callModule)
 export(checkboxGroupInput)
 export(checkboxInput)
 export(clickOpts)
@@ -105,6 +109,7 @@ export(navbarPage)
 export(navlistPanel)
 export(nearPoints)
 export(need)
+export(ns.sep)
 export(numericInput)
 export(observe)
 export(observeEvent)

R/modules.R

@@ -0,0 +1,57 @@
+# Creates an object whose $ and $<- pass through to the parent
+# session, unless the name is matched in ..., in which case
+# that value is returned instead. (See Decorator pattern.)
+createSessionProxy <- function(parentSession, ...) {
+  e <- new.env(parent = emptyenv())
+  e$parent <= parentSession
+  e$overrides <- list(...)
+
+  structure(
+    e,
+    class = "session_proxy"
+  )
+}
+
+#' @export
+`$.session_proxy` <- function(x, name) {
+  if (name %in% names(x[["overrides"]]))
+    x[["overrides"]][[name]]
+  else
+    x[["parent"]][[name]]
+}
+
+#' @export
+`$<-.session_proxy` <- function(x, name, value) {
+  x[["parent"]][[name]] <- value
+  x
+}
+
+#' Invoke a Shiny module
+#'
+#' Shiny's module feature lets you break complicated UI and server logic into
+#' smaller, self-contained pieces. Compared to large monolithic Shiny apps,
+#' modules are easier to reuse and easier to reason about. See the article at
+#' \url{http://shiny.rstudio.com/articles/modules.html} to learn more.
+#'
+#' @param module A Shiny module server function
+#' @param id An ID string that corresponds with the ID used to call the module's
+#'   UI function
+#' @param ... Additional parameters to pass to module server function
+#' @param session Session from which to make a child scope (the default should
+#'   almost always be used)
+#'
+#' @return The return value, if any, from executing the module server function
+#' @seealso \url{http://shiny.rstudio.com/articles/modules.html}
+#'
+#' @export
+callModule <- function(module, id, ..., session = getDefaultReactiveDomain()) {
+  childScope <- session$makeScope(id)
+
+  withReactiveDomain(childScope, {
+    if (!is.function(module)) {
+      stop("module argument must be a function")
+    }
+
+    module(childScope$input, childScope$output, childScope, ...)
+  })
+}

R/reactives.R

@@ -200,12 +200,28 @@ reactiveValues <- function(...) {
   values
 }
 
+checkName <- function(x) {
+  if (!is.character(x) || length(x) != 1) {
+    stop("Must use single string to index into reactivevalues")
+  }
+}
+
 # Create a reactivevalues object
 #
 # @param values A ReactiveValues object
 # @param readonly Should this object be read-only?
-.createReactiveValues <- function(values = NULL, readonly = FALSE) {
-  structure(list(impl=values), class='reactivevalues', readonly=readonly)
+# @param ns A namespace function (either `identity` or `NS(namespace)`)
+.createReactiveValues <- function(values = NULL, readonly = FALSE,
+  ns = identity) {
+
+  structure(
+    list(
+      impl = values,
+      readonly = readonly,
+      ns = ns
+    ),
+    class='reactivevalues'
+  )
 }
 
 #' Checks whether an object is a reactivevalues object
@@ -219,7 +235,8 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 
 #' @export
 `$.reactivevalues` <- function(x, name) {
-  .subset2(x, 'impl')$get(name)
+  checkName(name)
+  .subset2(x, 'impl')$get(.subset2(x, 'ns')(name))
 }
 
 #' @export
@@ -227,14 +244,12 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 
 #' @export
 `$<-.reactivevalues` <- function(x, name, value) {
-  if (attr(x, 'readonly')) {
+  if (.subset2(x, 'readonly')) {
     stop("Attempted to assign value to a read-only reactivevalues object")
-  } else if (length(name) != 1 || !is.character(name)) {
-    stop("Must use single string to index into reactivevalues")
-  } else {
-    .subset2(x, 'impl')$set(name, value)
-    x
   }
+  checkName(name)
+  .subset2(x, 'impl')$set(.subset2(x, 'ns')(name), value)
+  x
 }
 
 #' @export
@@ -252,7 +267,13 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 
 #' @export
 names.reactivevalues <- function(x) {
-  .subset2(x, 'impl')$names()
+  prefix <- .subset2(x, 'ns')("")
+  results <- .subset2(x, 'impl')$names()
+  if (nzchar(prefix)) {
+    results <- results[substring(results, 1, nchar(prefix)) == prefix]
+    results <- substring(results, nchar(prefix) + 1)
+  }
+  results
 }
 
 #' @export

R/server.R

@@ -289,7 +289,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
               # The client tells us what singletons were rendered into
               # the initial page
               if (!is.null(msg$data$.clientdata_singletons)) {
-                shinysession$singletons <<- strsplit(
+                shinysession$singletons <- strsplit(
                   msg$data$.clientdata_singletons, ',')[[1]]
               }
 

R/shiny.R

@@ -237,10 +237,52 @@ workerId <- local({
 #'   from Shiny apps, but through friendlier wrapper functions like
 #'   \code{\link{updateTextInput}}.
 #' }
+#' \item{ns(id)}{
+#'   Server-side version of \code{ns <- \link{NS}(id)}. If bare IDs need to be
+#'   explicitly namespaced for the current module, \code{session$ns("name")}
+#'   will return the fully-qualified ID.
+#' }
 #'
 #' @name session
 NULL
 
+#' @rdname NS
+#' @export
+ns.sep <- "-"
+
+#' Namespaced IDs for inputs/outputs
+#'
+#' The \code{NS} function creates namespaced IDs out of bare IDs, by joining
+#' them using \code{ns.sep} as the delimiter. It is intended for use in Shiny
+#' modules. See \url{http://shiny.rstudio.com/articles/modules.html}.
+#'
+#' Shiny applications use IDs to identify inputs and outputs. These IDs must be
+#' unique within an application, as accidentally using the same input/output ID
+#' more than once will result in unexpected behavior. The traditional solution
+#' for preventing name collisions is \emph{namespaces}; a namespace is to an ID
+#' as a directory is to a file. Use the \code{NS} function to turn a bare ID
+#' into a namespaced one, by combining them with \code{ns.sep} in between.
+#'
+#' @param namespace The character vector to use for the namespace. This can have
+#'   any length, though a single element is most common. Length 0 will cause the
+#'   \code{id} to be returned without a namespace, and length 2 will be
+#'   interpreted as multiple namespaces, in increasing order of specificity
+#'   (i.e. starting with the top-level namespace).
+#' @param id The id string to be namespaced (optional).
+#' @return If \code{id} is missing, returns a function that expects an id string
+#'   as its only argument and returns that id with the namespace prepended.
+#' @seealso \url{http://shiny.rstudio.com/articles/modules.html}
+#'
+#' @export
+NS <- function(namespace, id = NULL) {
+  if (missing(id)) {
+    function(id) {
+      paste(c(namespace, id), collapse = ns.sep)
+    }
+  } else {
+    paste(c(namespace, id), collapse = ns.sep)
+  }
+}
 
 #' @include utils.R
 ShinySession <- R6Class(
@@ -383,6 +425,24 @@ ShinySession <- R6Class(
         sessionId = self$token
       ))))
     },
+    makeScope = function(namespace) {
+      createSessionProxy(self,
+        input = .createReactiveValues(private$.input, readonly = TRUE, ns = NS(namespace)),
+        output = .createOutputWriter(self, ns = NS(namespace)),
+        sendInputMessage = function(inputId, message) {
+          .subset2(self, "sendInputMessage")(NS(namespace, inputId), message)
+        },
+        registerDataObj = function(name, data, filterFunc) {
+          .subset2(self, "registerDataObj")(NS(namespace, name), data, filterFunc)
+        },
+        ns = function(id) {
+          NS(namespace, id)
+        }
+      )
+    },
+    ns = function(id) {
+      NS(NULL, id)
+    },
     onSessionEnded = function(callback) {
       "Registers the given callback to be invoked when the session is closed
       (i.e. the connection to the client has been severed). The return value
@@ -933,12 +993,14 @@ ShinySession <- R6Class(
   )
 )
 
-.createOutputWriter <- function(shinysession) {
-  structure(list(impl=shinysession), class='shinyoutput')
+.createOutputWriter <- function(shinysession, ns = identity) {
+  structure(list(impl=shinysession, ns=ns), class='shinyoutput')
 }
 
 #' @export
 `$<-.shinyoutput` <- function(x, name, value) {
+  name <- .subset2(x, 'ns')(name)
+
   label <- deparse(substitute(value))
   if (length(substitute(value)) > 1) {
     # value is an object consisting of a call and its arguments. Here we want
@@ -1010,5 +1072,7 @@ outputOptions <- function(x, name, ...) {
   if (!inherits(x, "shinyoutput"))
     stop("x must be a shinyoutput object.")
 
+  name <- .subset2(x, 'ns')(name)
+
   .subset2(x, 'impl')$outputOptions(name, ...)
 }

inst/staticdocs/index.r

@@ -170,6 +170,13 @@ sd_section("Plot interaction",
     "nearPoints"
   )
 )
+sd_section("Modules",
+  "Functions for modularizing Shiny apps",
+  c(
+    "NS",
+    "callModule"
+  )
+)
 sd_section("Embedding",
   "Functions that are intended for third-party packages that embed Shiny applications.",
   c(

inst/tests/test-modules.R

@@ -0,0 +1,39 @@
+context("modules")
+
+test_that("Namespace qualifying", {
+  expect_equivalent(NS("one", "two"), "one-two")
+  expect_equivalent(NS(c("one", "two"))(NULL), "one-two")
+  expect_equivalent(NS(NULL)(c("one", "two")), "one-two")
+  expect_equivalent(NS(c("one", "two"), c("three", "four")), "one-two-three-four")
+  expect_equivalent(NS(c("one", "two"))(c("three", "four")), "one-two-three-four")
+  expect_equivalent(NS(c("one", "two"))("three four"), "one-two-three four")
+  expect_equivalent(NS(c("one", "two"))("three-four"), "one-two-three-four")
+})
+
+test_that("reactiveValues with namespace", {
+  values <- ReactiveValues$new()
+
+  rv <- .createReactiveValues(values)
+  rv$foo <- 10
+  rv$baz <- 11
+  expect_equivalent(isolate(values$get("foo")), 10)
+  expect_equivalent(isolate(values$get("baz")), 11)
+
+  rv1 <- .createReactiveValues(values, ns = NS("bar"))
+  rv1$baz <- 20
+  expect_equivalent(isolate(rv1$baz), 20)
+  expect_equivalent(isolate(rv[["bar-baz"]]), 20)
+
+  rv2 <- .createReactiveValues(values, ns = NS(c("bar", "qux")))
+  rv2$quux <- 30
+  expect_equivalent(isolate(rv2$quux), 30)
+  expect_equivalent(isolate(rv1[["qux-quux"]]), 30)
+  expect_equivalent(isolate(rv[["bar-qux-quux"]]), 30)
+
+  # Namespaced reactive values objects only get their own names,
+  # minus the namespace prefix, when names() is called.
+  # Unnamespaced (root) reactive values objects get all names.
+  expect_equivalent(isolate(names(rv)), c("bar-baz", "bar-qux-quux", "baz", "foo"))
+  expect_equivalent(isolate(names(rv1)), c("baz", "qux-quux"))
+  expect_equivalent(isolate(names(rv2)), c("quux"))
+})

man/NS.Rd

@@ -0,0 +1,45 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/shiny.R
+\docType{data}
+\name{ns.sep}
+\alias{NS}
+\alias{ns.sep}
+\title{Namespaced IDs for inputs/outputs}
+\format{\preformatted{ chr "-"
+}}
+\usage{
+ns.sep
+
+NS(namespace, id = NULL)
+}
+\arguments{
+\item{namespace}{The character vector to use for the namespace. This can have
+any length, though a single element is most common. Length 0 will cause the
+\code{id} to be returned without a namespace, and length 2 will be
+interpreted as multiple namespaces, in increasing order of specificity
+(i.e. starting with the top-level namespace).}
+
+\item{id}{The id string to be namespaced (optional).}
+}
+\value{
+If \code{id} is missing, returns a function that expects an id string
+  as its only argument and returns that id with the namespace prepended.
+}
+\description{
+The \code{NS} function creates namespaced IDs out of bare IDs, by joining
+them using \code{ns.sep} as the delimiter. It is intended for use in Shiny
+modules. See \url{http://shiny.rstudio.com/articles/modules.html}.
+}
+\details{
+Shiny applications use IDs to identify inputs and outputs. These IDs must be
+unique within an application, as accidentally using the same input/output ID
+more than once will result in unexpected behavior. The traditional solution
+for preventing name collisions is \emph{namespaces}; a namespace is to an ID
+as a directory is to a file. Use the \code{NS} function to turn a bare ID
+into a namespaced one, by combining them with \code{ns.sep} in between.
+}
+\seealso{
+\url{http://shiny.rstudio.com/articles/modules.html}
+}
+\keyword{datasets}
+

man/callModule.Rd

@@ -0,0 +1,32 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/modules.R
+\name{callModule}
+\alias{callModule}
+\title{Invoke a Shiny module}
+\usage{
+callModule(module, id, ..., session = getDefaultReactiveDomain())
+}
+\arguments{
+\item{module}{A Shiny module server function}
+
+\item{id}{An ID string that corresponds with the ID used to call the module's
+UI function}
+
+\item{...}{Additional parameters to pass to module server function}
+
+\item{session}{Session from which to make a child scope (the default should
+  almost always be used)}
+}
+\value{
+The return value, if any, from executing the module server function
+}
+\description{
+Shiny's module feature lets you break complicated UI and server logic into
+smaller, self-contained pieces. Compared to large monolithic Shiny apps,
+modules are easier to reuse and easier to reason about. See the article at
+\url{http://shiny.rstudio.com/articles/modules.html} to learn more.
+}
+\seealso{
+\url{http://shiny.rstudio.com/articles/modules.html}
+}
+

man/session.Rd

@@ -101,6 +101,11 @@
   from Shiny apps, but through friendlier wrapper functions like
   \code{\link{updateTextInput}}.
 }
+\item{ns(id)}{
+  Server-side version of \code{ns <- \link{NS}(id)}. If bare IDs need to be
+  explicitly namespaced for the current module, \code{session$ns("name")}
+  will return the fully-qualified ID.
+}
 }
 \description{
 Shiny server functions can optionally include \code{session} as a parameter