Add session$ns(); some light refactoring; add tests; fix staticdocs

R/reactives.R

@@ -210,14 +210,15 @@ checkName <- function(x) {
 #
 # @param values A ReactiveValues object
 # @param readonly Should this object be read-only?
+# @param ns A namespace function (either `identity` or `NS(namespace)`)
 .createReactiveValues <- function(values = NULL, readonly = FALSE,
-  prefix = "") {
+  ns = identity) {
 
   structure(
     list(
       impl = values,
       readonly = readonly,
-      prefix = prefix
+      ns = ns
     ),
     class='reactivevalues'
   )
@@ -235,7 +236,7 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 #' @export
 `$.reactivevalues` <- function(x, name) {
   checkName(name)
-  .subset2(x, 'impl')$get(paste0(.subset2(x, 'prefix'), name))
+  .subset2(x, 'impl')$get(.subset2(x, 'ns')(name))
 }
 
 #' @export
@@ -247,7 +248,7 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
     stop("Attempted to assign value to a read-only reactivevalues object")
   }
   checkName(name)
-  .subset2(x, 'impl')$set(paste0(.subset2(x, 'prefix'), name), value)
+  .subset2(x, 'impl')$set(.subset2(x, 'ns')(name), value)
   x
 }
 
@@ -266,7 +267,7 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 
 #' @export
 names.reactivevalues <- function(x) {
-  prefix <- .subset2(x, 'prefix')
+  prefix <- .subset2(x, 'ns')("")
   results <- .subset2(x, 'impl')$names()
   if (nzchar(prefix)) {
     results <- results[substring(results, 1, nchar(prefix)) == prefix]

R/shiny.R

@@ -237,6 +237,11 @@ 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
@@ -425,15 +430,20 @@ ShinySession <- R6Class(
       ))))
     },
     makeScope = function(namespace) {
-      namespace <- paste0(namespace, ns.sep)
       createSessionProxy(self,
-        input = .createReactiveValues(private$.input, readonly = TRUE, prefix = namespace),
-        output = .createOutputWriter(self, prefix = namespace),
+        input = .createReactiveValues(private$.input, readonly = TRUE, ns = NS(namespace)),
+        output = .createOutputWriter(self, ns = NS(namespace)),
         sendInputMessage = function(inputId, message) {
-          .subset2(self, "sendInputMessage")(paste0(namespace, inputId), message)
+          .subset2(self, "sendInputMessage")(NS(namespace, inputId), message)
+        },
+        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
@@ -980,18 +990,13 @@ ShinySession <- R6Class(
   )
 )
 
-.createOutputWriter <- function(shinysession, prefix = "") {
-  structure(list(impl=shinysession, prefix=prefix), class='shinyoutput')
+.createOutputWriter <- function(shinysession, ns = identity) {
+  structure(list(impl=shinysession, ns=ns), class='shinyoutput')
 }
 
 #' @export
 `$<-.shinyoutput` <- function(x, name, value) {
-  if (nzchar(prefix <- .subset2(x, 'prefix'))) {
-    name <- paste0(prefix, name)
-  } else {
-    # Just to make sure errors happen at the same time regardless of prefix
-    force(name)
-  }
+  name <- .subset2(x, 'ns')(name)
 
   label <- deparse(substitute(value))
   if (length(substitute(value)) > 1) {
@@ -1064,9 +1069,7 @@ outputOptions <- function(x, name, ...) {
   if (!inherits(x, "shinyoutput"))
     stop("x must be a shinyoutput object.")
 
-  if (nzchar(prefix <- .subset2(x, 'prefix'))) {
-    name <- paste0(prefix, name)
-  }
+  name <- .subset2(x, 'ns')(name)
 
   .subset2(x, 'impl')$outputOptions(name, ...)
 }

inst/staticdocs/index.r

@@ -174,7 +174,6 @@ sd_section("Modules",
   "Functions for modularizing Shiny apps",
   c(
     "NS",
-    "moduleUI",
     "callModule"
   )
 )

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/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