1# Creates an object whose $ and [[ pass through to the parent 2# session, unless the name is matched in ..., in which case 3# that value is returned instead. (See Decorator pattern.) 4createSessionProxy <- function(parentSession, ...) { 5 e <- new.env(parent = emptyenv()) 6 e$parent <- parentSession 7 e$overrides <- list(...) 8 9 structure( 10 e, 11 class = "session_proxy" 12 ) 13} 14 15#' @export 16`$.session_proxy` <- function(x, name) { 17 if (name %in% names(.subset2(x, "overrides"))) 18 .subset2(x, "overrides")[[name]] 19 else 20 .subset2(x, "parent")[[name]] 21} 22 23#' @export 24`[[.session_proxy` <- `$.session_proxy` 25 26 27#' @export 28`$<-.session_proxy` <- function(x, name, value) { 29 # this line allows users to write into session$userData 30 # (e.g. it allows something like `session$userData$x <- TRUE`, 31 # but not `session$userData <- TRUE`) from within a module 32 # without any hacks (see PR #1732) 33 if (identical(x[[name]], value)) return(x) 34 35 # Special case for $options (issue #3112) 36 if (name == "options") { 37 session <- find_ancestor_session(x) 38 session[[name]] <- value 39 return(x) 40 } 41 42 stop("Attempted to assign value on session proxy.") 43} 44 45`[[<-.session_proxy` <- `$<-.session_proxy` 46 47# Given a session_proxy, search `parent` recursively to find the real 48# ShinySession object. If given a ShinySession, simply return it. 49find_ancestor_session <- function(x, depth = 20) { 50 if (depth < 0) { 51 stop("ShinySession not found") 52 } 53 if (inherits(x, "ShinySession")) { 54 return(x) 55 } 56 if (inherits(x, "session_proxy")) { 57 return(find_ancestor_session(.subset2(x, "parent"), depth-1)) 58 } 59 60 stop("ShinySession not found") 61} 62 63 64#' Shiny modules 65#' 66#' Shiny's module feature lets you break complicated UI and server logic into 67#' smaller, self-contained pieces. Compared to large monolithic Shiny apps, 68#' modules are easier to reuse and easier to reason about. See the article at 69#' <https://shiny.rstudio.com/articles/modules.html> to learn more. 70#' 71#' Starting in Shiny 1.5.0, we recommend using `moduleServer` instead of 72#' [`callModule()`], because the syntax is a little easier 73#' to understand, and modules created with `moduleServer` can be tested with 74#' [`testServer()`]. 75#' 76#' @param module A Shiny module server function. 77#' @param id An ID string that corresponds with the ID used to call the module's 78#' UI function. 79#' @param session Session from which to make a child scope (the default should 80#' almost always be used). 81#' 82#' @return The return value, if any, from executing the module server function 83#' @seealso <https://shiny.rstudio.com/articles/modules.html> 84#' 85#' @examples 86#' # Define the UI for a module 87#' counterUI <- function(id, label = "Counter") { 88#' ns <- NS(id) 89#' tagList( 90#' actionButton(ns("button"), label = label), 91#' verbatimTextOutput(ns("out")) 92#' ) 93#' } 94#' 95#' # Define the server logic for a module 96#' counterServer <- function(id) { 97#' moduleServer( 98#' id, 99#' function(input, output, session) { 100#' count <- reactiveVal(0) 101#' observeEvent(input$button, { 102#' count(count() + 1) 103#' }) 104#' output$out <- renderText({ 105#' count() 106#' }) 107#' count 108#' } 109#' ) 110#' } 111#' 112#' # Use the module in an app 113#' ui <- fluidPage( 114#' counterUI("counter1", "Counter #1"), 115#' counterUI("counter2", "Counter #2") 116#' ) 117#' server <- function(input, output, session) { 118#' counterServer("counter1") 119#' counterServer("counter2") 120#' } 121#' if (interactive()) { 122#' shinyApp(ui, server) 123#' } 124#' 125#' 126#' 127#' # If you want to pass extra parameters to the module's server logic, you can 128#' # add them to your function. In this case `prefix` is text that will be 129#' # printed before the count. 130#' counterServer2 <- function(id, prefix = NULL) { 131#' moduleServer( 132#' id, 133#' function(input, output, session) { 134#' count <- reactiveVal(0) 135#' observeEvent(input$button, { 136#' count(count() + 1) 137#' }) 138#' output$out <- renderText({ 139#' paste0(prefix, count()) 140#' }) 141#' count 142#' } 143#' ) 144#' } 145#' 146#' ui <- fluidPage( 147#' counterUI("counter", "Counter"), 148#' ) 149#' server <- function(input, output, session) { 150#' counterServer2("counter", "The current count is: ") 151#' } 152#' if (interactive()) { 153#' shinyApp(ui, server) 154#' } 155#' 156#' @export 157moduleServer <- function(id, module, session = getDefaultReactiveDomain()) { 158 if (inherits(session, "MockShinySession")) { 159 body(module) <- rlang::expr({ 160 session$setEnv(base::environment()) 161 !!body(module) 162 }) 163 session$setReturned(callModule(module, id, session = session)) 164 } else { 165 callModule(module, id, session = session) 166 } 167} 168 169 170#' Invoke a Shiny module 171#' 172#' Note: As of Shiny 1.5.0, we recommend using [`moduleServer()`] instead of 173#' [`callModule()`], because the syntax is a little easier 174#' to understand, and modules created with `moduleServer` can be tested with 175#' [`testServer()`]. 176#' 177#' @param module A Shiny module server function 178#' @param id An ID string that corresponds with the ID used to call the module's 179#' UI function 180#' @param ... Additional parameters to pass to module server function 181#' @param session Session from which to make a child scope (the default should 182#' almost always be used) 183#' 184#' @return The return value, if any, from executing the module server function 185#' @export 186callModule <- function(module, id, ..., session = getDefaultReactiveDomain()) { 187 if (!inherits(session, c("ShinySession", "session_proxy", "MockShinySession"))) { 188 stop("session must be a ShinySession or session_proxy object.") 189 } 190 childScope <- session$makeScope(id) 191 192 withReactiveDomain(childScope, { 193 if (!is.function(module)) { 194 stop("module argument must be a function") 195 } 196 197 module(childScope$input, childScope$output, childScope, ...) 198 }) 199} 200