rshinymodule

How to carefully and properly encapsulate objects in R Shiny module?


I am trying to make my R Shiny modules as independent as possible, where each module can run independently for testing. I am trying to minimize the risk of conflicts between modules and tightly control the flow of data between modules. In the below working example code, user clicks on a checkmark toggle and a signal is sent from the module server back to the module ui via the toggleStatus object. In order to get this to work, I define toggles in both the module ui and module server: not great.

Is there a way to more cleanly encapsulate the toggles object and the createToggle() function, placing both in the server perhaps? I've been trying with no luck.

One thing that does work was defining toggles in the global environment and passing it on as a module parameter (using mod30_B_ui <- function(id, toggles), mod30_B_server <- function(id, toggles), ui <- fluidPage(mod30_B_ui("mod30_B", toggles), mod30_B_server("mod30_B", toggles), etc.), but I find this approach cumbersome and don't want to add more parameters to the module server. Also I'm trying to avoid global environment in this example.

Any advice?

library(shiny)
library(shinyWidgets)

mod30_B_ui <- function(id) {
  ns <- NS(id)
  
  toggles <- c("CS", "WF", "RA")
  
  createToggle <- function(label, id) {
    tags$span(
      prettyCheckbox(
        inputId = id,
        label = label,
        value = TRUE,
        status = "success",
        shape = "curve",
        icon = icon("check")
      )
    )
  }
  
  tagList(
    fluidRow(
      lapply(toggles, function(label) {
        createToggle(label, ns(paste0("toggle_", gsub(" ", "_", tolower(label)))))
      })
    ),
    fluidRow(textOutput(ns("toggleStatus")))
  )
}

mod30_B_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- NS(id)
    
    toggles <- c("CS", "WF", "RA")
    
    output$toggleStatus <- renderText({
      results <- sapply(toggles, function(label) {
        toggle_id <- paste0("toggle_", gsub(" ", "_", tolower(label)))
        if (input[[toggle_id]]) {
          paste(label, "is checked")
        } else {
          paste(label, "is unchecked")
        }
      })
      paste(results, collapse = "\n")
    })
  })
}

ui <- fluidPage(mod30_B_ui("mod30_B"))

server <- function(input, output, session) {
  mod30_B_server("mod30_B")
}

shinyApp(ui = ui, server = server)

Solution

  • Here's one possibility. Delegate responsibility for the creation of the module UI to the UI server by using renderUI amd uiOutput. That removes all references to the individual toggles from the module UI.

    library(shiny)
    library(shinyWidgets)
    
    mod30_B_ui <- function(id) {
      ns <- NS(id)
    
      tagList(
        fluidRow(
          uiOutput(ns("toggles"))
        ),
        fluidRow(textOutput(ns("toggleStatus")))
      )
    }
    
    mod30_B_server <- function(id) {
      moduleServer(id, function(input, output, session) {
        ns <- NS(id)
    
        toggles <- c("CS", "WF", "RA")
    
        createToggle <- function(label, id) {
          tags$span(
            prettyCheckbox(
              inputId = id,
              label = label,
              value = TRUE,
              status = "success",
              shape = "curve",
              icon = icon("check")
            )
          )
        }
    
        output$toggleStatus <- renderText({
          req(sapply(toggles, \(x) paste0("toggle_", gsub(" ", "_", tolower(x)))))
    
          results <- sapply(toggles, function(label) {
            toggle_id <- paste0("toggle_", gsub(" ", "_", tolower(label)))
            if (input[[toggle_id]]) {
              paste(label, "is checked")
            } else {
              paste(label, "is unchecked")
            }
          })
          paste(results, collapse = " ")
        })
    
        output$toggles <- renderUI({
          tagList(
            lapply(toggles, function(label) {
              createToggle(label, ns(paste0("toggle_", gsub(" ", "_", tolower(label)))))
            })
          )
        })
      })
    }
    
    ui <- fluidPage(mod30_B_ui("mod30_B"))
    
    server <- function(input, output, session) {
      mod30_B_server("mod30_B")
    }
    
    shinyApp(ui = ui, server = server)