Shiny modules: Destroy module ui if server-function fails

前端 未结 2 732
眼角桃花
眼角桃花 2021-01-06 15:23

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?

相关标签:
2条回答
  • 2021-01-06 16:05

    With a little code reordering, and the use of the amazing shinyjs package this can be done.

    Note that I added an input to simulate errors and not errors, to see how the UI dissapears. Also all is done in the server part of the module. I hope this will help you. The code has inline comments explaining the steps.

    library(shiny)
    library(shinyjs)
    
    my_module_ui <- function(id) {
      ns <- NS(id)
    
      tagList(
        # input added to be able to throw errors and see the ui dissapear
        selectInput(
          ns('trigger'), 'Error trigger',
          choices = list('no error' = c(2,1), 'error' = c('A', 'B')),
          selected = 2
        ),
        tags$div(
          # div with id, to select it with shinyjs and hide it if necessary
          id = ns('hideable_div'),
          tags$h1("Don't show me if my_module_server fails!"),
          plotOutput(ns("my_plot"))
        )
      )
    }
    
    my_module_server <- function(input, output, session) {
    
      # get all the things prone to error in a reactive call, that way you capture the final
      # result or a NULL reactive when an error occurs
      foo <- reactive({
    
        tryCatch({
    
          if (input$trigger %in% c(2,1)) {
            trigger <- as.numeric(input$trigger)
          } else {
            trigger <- input$trigger
          }
    
          cars * trigger
        }, error=function(cond) {
          message("Destroy UI here!")
        })
      })
    
      # obseveEvent based on the error reactive, to check if hide or not the UI
      observeEvent(foo(), {
        # hide checking if foo is null, using shinyjs
        if (is.null(foo())) {
          shinyjs::hide('hideable_div')
        } else {
          shinyjs::show('hideable_div')
        }
      }, ignoreNULL = FALSE, ignoreInit = FALSE)
    
    
      # outputs, with validation of the error reactive. That way code after validate is not
      # executed but the app does not get blocked (gray)
      output$my_plot <- renderPlot({
        shiny::validate(
          shiny::need(foo(), 'no data')
        )
        cars2 <- foo() + rnorm(nrow(foo()))
        plot(cars2)
      })
    
    }
    
    ui <- fluidPage(
      # really important for shinyjs tu work!!!!!!!
      shinyjs::useShinyjs(),
      my_module_ui("my_id")
    )
    
    server <- function(input, output, session) {
      callModule(my_module_server, "my_id")
    }
    
    shinyApp(ui, server)
    
    
    0 讨论(0)
  • 2021-01-06 16:11

    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)
    
    0 讨论(0)
提交回复
热议问题