All session parameters from the update* functions now default to `get…

…DefaultReactiveDomain()` (rstudio#3195)

Co-authored-by: colin <[email protected]>

NEWS.md

@@ -64,10 +64,12 @@ shiny 1.5.0.9000
 
 * Closed #3140: Added support for `...` argument in `icon()`. (#3143)
 
-* Improved error messages when reading reactive values outside of a reactive domain (e.g., `reactiveVal()()`). (#3007)
+* Closed #629: All `update*` functions now have a default value for `session`, and issue an informative warning if it is missing. (#3195)
 
 ### Bug fixes
 
+* Improved error messages when reading reactive values outside of a reactive domain (e.g., `reactiveVal()()`). (#3007)
+
 * Fixed #1942: Calling `runApp("app.R")` no longer ignores options passed into `shinyApp()`. This makes it possible for Shiny apps to specify what port/host should be used by default. (#2969)
 
 * Fixed #3033: When a `DiskCache` was created with both `max_n` and `max_size`, too many items could get pruned when `prune()` was called. (#3034)

R/shiny.R

@@ -2532,3 +2532,17 @@ markdown <- function(mds, extensions = TRUE, .noWS = NULL, ...) {
   html <- rlang::exec(commonmark::markdown_html, glue::trim(mds), extensions = extensions, ...)
   htmltools::HTML(html, .noWS = .noWS)
 }
+
+
+# Check that an object is a ShinySession object, and give an informative error.
+# The default label is the caller function's name.
+validate_session_object <- function(session, label = as.character(sys.call(sys.parent())[[1]])) {
+  if (missing(session) || !inherits(session, c("ShinySession", "MockShinySession"))) {
+    stop(call. = FALSE,
+      sprintf(
+        "`session` must be a 'ShinySession' object. Did you forget to pass `session` to `%s()`?",
+        label
+      )
+    )
+  }
+}

R/update-input.R

@@ -34,7 +34,9 @@
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateTextInput <- function(session, inputId, label = NULL, value = NULL, placeholder = NULL) {
+updateTextInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL, placeholder = NULL) {
+  validate_session_object(session)
+
   message <- dropNulls(list(label=label, value=value, placeholder=placeholder))
   session$sendInputMessage(inputId, message)
 }
@@ -106,7 +108,9 @@ updateTextAreaInput <- updateTextInput
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateCheckboxInput <- function(session, inputId, label = NULL, value = NULL) {
+updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL) {
+  validate_session_object(session)
+
   message <- dropNulls(list(label=label, value=value))
   session$sendInputMessage(inputId, message)
 }
@@ -165,7 +169,9 @@ updateCheckboxInput <- function(session, inputId, label = NULL, value = NULL) {
 #' }
 #' @rdname updateActionButton
 #' @export
-updateActionButton <- function(session, inputId, label = NULL, icon = NULL) {
+updateActionButton <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL) {
+  validate_session_object(session)
+
   if (!is.null(icon)) icon <- as.character(validateIcon(icon))
   message <- dropNulls(list(label=label, icon=icon))
   session$sendInputMessage(inputId, message)
@@ -206,8 +212,10 @@ updateActionLink <- updateActionButton
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateDateInput <- function(session, inputId, label = NULL, value = NULL,
-                            min = NULL, max = NULL) {
+updateDateInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
+                            min = NULL, max = NULL)
+{
+  validate_session_object(session)
 
   value <- dateYMD(value, "value")
   min   <- dateYMD(min, "min")
@@ -251,9 +259,11 @@ updateDateInput <- function(session, inputId, label = NULL, value = NULL,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateDateRangeInput <- function(session, inputId, label = NULL,
+updateDateRangeInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL,
                                  start = NULL, end = NULL, min = NULL,
-                                 max = NULL) {
+                                 max = NULL)
+{
+  validate_session_object(session)
 
   start <- dateYMD(start, "start")
   end <- dateYMD(end, "end")
@@ -273,7 +283,7 @@ updateDateRangeInput <- function(session, inputId, label = NULL,
 #' Change the selected tab on the client
 #'
 #' @param session The `session` object passed to function given to
-#'   `shinyServer`.
+#'   `shinyServer`. Default is `getDefaultReactiveDomain()`.
 #' @param inputId The id of the `tabsetPanel`, `navlistPanel`,
 #' or `navbarPage` object.
 #' @inheritParams tabsetPanel
@@ -309,7 +319,9 @@ updateDateRangeInput <- function(session, inputId, label = NULL,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateTabsetPanel <- function(session, inputId, selected = NULL) {
+updateTabsetPanel <- function(session = getDefaultReactiveDomain(), inputId, selected = NULL) {
+  validate_session_object(session)
+
   message <- dropNulls(list(value = selected))
   session$sendInputMessage(inputId, message)
 }
@@ -357,9 +369,11 @@ updateNavlistPanel <- updateTabsetPanel
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
+updateNumericInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
     min = NULL, max = NULL, step = NULL) {
 
+  validate_session_object(session)
+
   message <- dropNulls(list(
     label = label, value = formatNoSci(value),
     min = formatNoSci(min), max = formatNoSci(max), step = formatNoSci(step)
@@ -404,9 +418,11 @@ updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
 #'   )
 #' }
 #' @export
-updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
+updateSliderInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
   min = NULL, max = NULL, step = NULL, timeFormat = NULL, timezone = NULL)
 {
+  validate_session_object(session)
+
   # If no min/max/value is provided, we won't know the
   # type, and this will return an empty string
   dataType <- getSliderType(min, max, value)
@@ -439,6 +455,8 @@ updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
 updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
                                selected = NULL, inline = FALSE, type = NULL,
                                choiceNames = NULL, choiceValues = NULL) {
+  validate_session_object(session)
+
   if (is.null(type)) stop("Please specify the type ('checkbox' or 'radio')")
 
   args <- normalizeChoicesArgs(choices, choiceNames, choiceValues, mustExist = FALSE)
@@ -496,9 +514,12 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateCheckboxGroupInput <- function(session, inputId, label = NULL,
+updateCheckboxGroupInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL,
   choices = NULL, selected = NULL, inline = FALSE,
-  choiceNames = NULL, choiceValues = NULL) {
+  choiceNames = NULL, choiceValues = NULL)
+{
+  validate_session_object(session)
+
   updateInputOptions(session, inputId, label, choices, selected,
                      inline, "checkbox", choiceNames, choiceValues)
 }
@@ -539,9 +560,12 @@ updateCheckboxGroupInput <- function(session, inputId, label = NULL,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
+updateRadioButtons <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, choices = NULL,
                                selected = NULL, inline = FALSE,
-                               choiceNames = NULL, choiceValues = NULL) {
+                               choiceNames = NULL, choiceValues = NULL)
+{
+  validate_session_object(session)
+
   # you must select at least one radio button
   if (is.null(selected)) {
     if (!is.null(choices)) selected <- choices[[1]]
@@ -591,8 +615,11 @@ updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
-                              selected = NULL) {
+updateSelectInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, choices = NULL,
+                              selected = NULL)
+{
+  validate_session_object(session)
+
   choices <- if (!is.null(choices)) choicesWithNames(choices)
   if (!is.null(selected)) selected <- as.character(selected)
   options <- if (!is.null(choices)) selectOptions(choices, selected, inputId, FALSE)
@@ -607,9 +634,12 @@ updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
 #'   `choices` into the page at once (i.e., only use the client-side
 #'   version of \pkg{selectize.js})
 #' @export
-updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
+updateSelectizeInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, choices = NULL,
                                  selected = NULL, options = list(),
-                                 server = FALSE) {
+                                 server = FALSE)
+{
+  validate_session_object(session)
+
   if (length(options)) {
     res <- checkAsIs(options)
     cfg <- tags$script(
@@ -722,12 +752,15 @@ updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
 #' @rdname updateSelectInput
 #' @inheritParams varSelectInput
 #' @export
-updateVarSelectInput <- function(session, inputId, label = NULL, data = NULL, selected = NULL) {
+updateVarSelectInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, data = NULL, selected = NULL) {
+  validate_session_object(session)
+
   if (is.null(data)) {
     choices <- NULL
   } else {
     choices <- colnames(data)
   }
+
   updateSelectInput(
     session = session,
     inputId = inputId,
@@ -738,7 +771,11 @@ updateVarSelectInput <- function(session, inputId, label = NULL, data = NULL, se
 }
 #' @rdname updateSelectInput
 #' @export
-updateVarSelectizeInput <- function(session, inputId, label = NULL, data = NULL, selected = NULL, options = list(), server = FALSE) {
+updateVarSelectizeInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL,
+                                    data = NULL, selected = NULL, options = list(), server = FALSE)
+{
+  validate_session_object(session)
+
   if (is.null(data)) {
     choices <- NULL
   } else {

man-roxygen/update-input.R

@@ -17,6 +17,6 @@
 #' can be cleared by using \code{selected=character(0)}.
 #'
 #' @param session The \code{session} object passed to function given to
-#'   \code{shinyServer}.
+#'   \code{shinyServer}. Default is \code{getDefaultReactiveDomain()}.
 #' @param inputId The id of the input object.
 #' @param label The label to set for the input object.