Search code examples
rshinyshinymodules

Shiny modules: Destroy module ui if server-function fails


How to display a blank UI (alternatively destroy module UI), if the module server-function fails, without moving all the UI-code to the server function?

Simple reproducible example:

library(shiny)

my_module_ui <- function(id) {
  ns <- NS(id)
  tags$div(
    tags$h1("Don't show me if my_module_server fails!"),
    plotOutput(ns("my_plot"))
  )
}

my_module_server <- function(input, output, session) {

  tryCatch({
    my_data <- cars * "A" # fail for demo
    # my_data <- cars

    output$my_plot <- renderPlot({
      cars2 <- my_data + rnorm(nrow(my_data))
      plot(cars2)
    })
  }, error=function(cond) {
    message("Destroy UI here!")
  })


}

ui <- fluidPage(
  my_module_ui("my_id")
)

server <- function(input, output, session) {
  callModule(my_module_server, "my_id")
}

shinyApp(ui, server)

My current solution is to have nothing but a uiOutput() in my_module_ui and render the entire ui in the server function. I want to prevent this, since large modules get very messy if all UI-components are placed within the module server-function.

In addition I would preferably also like to avoid returning values from callModule() that destroy the UI and do this from within the server-function instead.

Thanks!


Solution

  • How about you assign a value to the session object and evaluate this value before you create the UI (from server side via renderUI().

    1) Move rendering of UI to server side

    Use renderUI(my_module_ui("my_id")) on server side and uiOutput("module") on ui side.

    2) To detect whether your server module was successful assign a value to the session object

    my_module_server <- function(input, output, session) {
      tryCatch({
         ...
        session$userData$mod_server <- TRUE
      }, error = function(cond) {
        session$userData$mod_server <- NULL
      })
    }
    

    3) Use this value to make the call of your module ui conditional

      output$module <- renderUI({
        callModule(my_module_server, "my_id")
        if(!is.null(session$userData$mod_server)) my_module_ui("my_id")
      })
    

    Reproducible example:

    library(shiny)
    
    my_module_ui <- function(id) {
      ns <- NS(id)
      tags$div(
        tags$h1("Don't show me if my_module_server fails!"),
        plotOutput(ns("my_plot"))
      )
    }
    
    my_module_server <- function(input, output, session) {
      tryCatch({
        my_data <- cars * "A" # fail for demo
        # my_data <- cars
    
        output$my_plot <- renderPlot({
          cars2 <- my_data + rnorm(nrow(my_data))
          plot(cars2)
        })
        session$userData$mod_server <- TRUE
      }, error = function(cond) {
        session$userData$mod_server <- NULL
      })
    }
    
    ui <- fluidPage(
      uiOutput("module")
    )
    
    server <- function(input, output, session) {
      output$module <- renderUI({
        callModule(my_module_server, "my_id")
        if(!is.null(session$userData$mod_server)) my_module_ui("my_id")
      })
    }
    shinyApp(ui, server)