bookmark-friendly shiny module with global objects

Question: is there a way other than envs to preserve per-server module UI state-information when the app's ui is called individually for each session?

Background: suppose a module supports multiple calls to its UI component in order to spread different components in different locations. Also consider that some elements may be shown more than once, syncing the value, discarding the opinion that this is often not the best design choice. In order to track the 0+ ids for a given element, an environment is used so that each time the module_ui function is called, it updates what the server needs to know to be able to monitor and update all elements.

Use of an environment works fine until the UI element of the main application (which loaded/called the module) enables bookmarks, at which point its UI component becomes a function. At this point, the UI component is called for each session, but since the env is still on the same server, it continues to update the vector of ids.

The decision to use a third function, module_global(), is stemmed partially from https://community.rstudio.com/t/best-practices-for-global-external-variables-used-in-a-module, though it does not follow directly from some of the provided examples. (Particularly the suggestion to use session$userData is not feasible because the session is not available for the module_ui function to update.)

Code and Setup

hello_module.R
hello_global <- function(ID, choices) {
  list2env(
    list(choices = choices, ids = list(text = character(0), select = character(0))),
    parent = emptyenv()
  )
}

hello_ui <- function(ID, global, widgets = c("text", "select")) {
  ns <- shiny::NS(ID)
  # ensure repeated widgets are given unique ids
  newids <- setdiff(
    make.unique(c(unlist(global$ids), widgets), sep = "_"),
    unlist(global$ids)
  )
  for (fld in unique(widgets))
    global$ids[[ fld ]] <- c(global$ids[[ fld ]], newids[ widgets == fld ])
  # produce 0 or more of each widget type
  tagl <- Map(ns(newids), widgets,
              f = function(id, typ) list(
                text   = htmlOutput(id),
                select = selectInput(id, label = "Hi", choices = global$choices,
                                     selected = global$choices[1])
              )[[typ]] )
  htmltools::tagList(tagl)
}

hello_server <- function(input, output, session, global) {
  stopifnot(isTRUE(length(global$ids$select) > 0))

  if (isTRUE(length(global$ids$select) > 1L)) {
    # update other 'select' elements (if present) on first one changing;
    # 'input$select' is "always" available, regardless of unique-ification
    observeEvent(input$select, {
      for (id in global$ids$select[-1])
        updateSelectInput(session, id, selected = input$select)
    })
    # update first 'select' on another changing
    observeEvent({
      Map(`[[`, list(input), global$ids$select[-1])
    }, {
      vals <- unlist(mapply(`[[`, list(input), global$ids$select[-1]))
      newval <- setdiff(vals, input$select)
      if (length(newval) > 0)
        updateSelectInput(session, global$ids$select[1], selected = newval[1])
    })
  }

  # update zero or more 'text'
  Map(list(input), global$ids$text,
      f = function(inp, id) {
        output[[id]] <- renderText({ inp$select })
      })

  return(reactive(input$select))
}
app.R
library(shiny)

source("hello_module.R")

glob <- hello_global("quux", choices = c("hello", "wassup?", "goodbye"))

ui <- pageWithSidebar(
  headerPanel("Hello Shiny!"),
  sidebarPanel(
    fluidRow( hello_ui("quux", global = glob) ),
    tags$hr(),
    fluidRow( hello_ui("quux", global = glob, widgets = "select") )
  ),
  mainPanel(
    textOutput("textout"),
    actionButton("debug", "Debug!")
  )
)

server <- function(input, output, session) {
  hello <- callModule(hello_server, "quux", global = glob)
  output$textout <- renderText({ hello() })
  observeEvent(input$debug, { browser(); 1; })
}

shinyApp(ui, server)

If we run this app, we see the point (mundane as it may be):

image

As we change one select, the other(s) are updated and all text labels render correctly. If we copy the URL and post it into multiple tabs (right), each tab behaves correctly.

Enter Bookmarks

The first driving change for bookmarks is that the ui component must be a single-argument function. If I change the ui element to:

ui <- function(request) {
  pageWithSidebar(
    # ...
  )
}

then when we run the app, the first app behaves normally. As we copy the url and open another browser tab to it, it initially renders correctly but none of the reactivity functions correctly.

The culprit is found when I press "Debug!" (gives me a browser on my machine) and look at what is available.

Without bookmarking

This is what I expect it to give me, and what is "normal":

# Listening on http://127.0.0.1:3617
# Called from: observeEventHandler(...)
# Browse[1]> 
debug at ~/20190626_rsc_module_bookmark/app.R#23: [1] 1
# Browse[2]> 
names(input)
# [1] "debug"                    "quux-select"              "quux-select-selectized"   "quux-select_1"           
# [5] "quux-select_1-selectized"
# Browse[2]> 
glob$ids
# $text
# [1] "text"
# $select
# [1] "select"   "select_1"

(Recall that glob is the global "state" variable for the module, called from the main app.)

In this case, I have two instances of the 'select' widget, so I have two $select ids. Correct. I expect every instance of this app (based on how it called the hello_module) to have exactly one 'text' and two 'select' widgets.

With bookmarking

After copying the url to two more tabs, they come up fine (and initially look correct), but:

# Listening on http://127.0.0.1:3617
# Called from: observeEventHandler(...)
# Browse[1]> 
debug at ~/20190626_rsc_module_bookmark/app.R#25: [1] 1
# Browse[2]> 
names(input)
# [1] "debug"                    "quux-select_2"            "quux-select_2-selectized" "quux-select_3"           
# [5] "quux-select_3-selectized"
# Browse[2]> 
glob$ids
# $text
# [1] "text"   "text_1" "text_2"
# $select
# [1] "select"   "select_1" "select_2" "select_3" "select_4" "select_5"

In the second web-browser tab, the single 'text' widget has an id of "text_1", and its two 'select' widgets have ids "select_2" and "select_3", respectively.

This behavior "makes sense" with the understanding that the main app's UI function is called for each new session, presumably so that later on down the road some code can do something with request within the UI's closure.

The first tab still works, even though after other sessions are started, its reactivity will try to update elements that are not on its tab (effectively no-ops). The other tabs do not work: at least in this app, the first id for each element type is only strictly located on the first tab, so outside of their input$ namespace.

I understand the premise behind converting to a function. However, the module underneath (which knows/cares nothing about bookmarking) behaves very differently based on an otherwise unrelated decision in the parent app.

Given that the module cannot affect how the calling app chooses to instantiate itself, I'd think a solution would include providing a mechanism to thwart this behavior, by either retaining the environment and some trickery to notice that it is a new session/instance, or by using something other than an environment.

(Thanks for making it this far, it's a long one but should be completely reproducible.)

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.