lundi 6 juillet 2020

A good design pattern for shiny application with navigation buttons (wizard-like approach)

I'm trying to figure out a good design pattern for the following case (I'm developing a shiny app, but the language can be generalized, I guess): In my application, I'm trying to implement HOC pattern known from React - I've got a navigation component (a module in shiny) with two buttons - Back and Next. This component enhances another shiny module with navigation logic. The code is like this:

#' HOC - enhances modules with navigation buttons
#'
#' @param id unique identifier
#' @rdname hoc_with_nav_buttons
with_nav_buttons_ui <- function(id) {
  ns <- NS(id)

  tagList(
    uiOutput(ns("component_ui")),

    fluidRow(
      column(
        12,
        actionButton(ns("btn_back"), "Back"),
        actionButton(ns("btn_next"), "Next")
      )
    )
  )
}


#' @rdname hoc_with_nav_buttons
#'
#' @param input shiny's default
#' @param output shiny's default
#' @param session shiny's default
#' @param component an object of class component created with \link{create_component} function
with_nav_buttons <- function(input, output, session, component) {

  move <- reactiveVal()

  # handling component's ui and logic: ----
  output$component_ui <- renderUI({
    component$ui(session$ns)
  })

  component$server(
    data = list(navi = move)
  )

  # native logic: ----
  observeEvent(input$btn_back, {
    futile.logger::flog.debug(" <<< 'btn_back' clicked")
    move(-input$btn_back)
  })
  observeEvent(input$btn_next, {
    futile.logger::flog.debug("'btn_next >>>' clicked")
    move(input$btn_next)
  })

  return(move)
}

and the module being enhanced:

outer_ui <- function(id) {
  ns <- NS(id)

  tagList(
    tags$style(
      ".mockup-content {
        min-height: 400px;
        border: 1px gray solid;
        padding: 15px;
      }"
    ),

    uiOutput(ns("ui_tabset"))
  )
}


outer <- function(input, output, session, data) {

  # tabs configuration: ----
  tabs <- paste("tab", 1:4)

  panels <- lapply(tabs, function(i) create_tab_panel(i))

  active_tab <- reactiveVal(1) # control which tab is selected (a kind of state)

  output$ui_tabset <- renderUI({
    tabsetPanel(
      id = session$ns("tabs"),
      panels[[1]],
      panels[[2]],
      panels[[3]],
      panels[[4]]
    )
  })

  observeEvent(data$navi(), {
    req(data$navi())
    move <- ifelse(data$navi() > 0, 1, -1)
    move_to <- active_tab() + move
    if (move_to == 0) {
      active_tab(1)
    } else if (move_to > length(tabs)) {
      active_tab(length(tabs))
    } else {
      active_tab(move_to)
    }
  })

  observeEvent(active_tab(), {
    updateTabsetPanel(
      session,
      inputId = "tabs",
      selected = tabs[[active_tab()]]
    )
  })
}

I put these all int the app with some helper functions:

#' Creates a component object that can be used inside HOCs
#'
#' @param module_ui function; the ui part of a standard shiny module
#' @param module_server function; the server part of a standard shiny module
#' @param id character; the unique identifier used to create a namespace; the same
#' as the \code{id} parameter in the ui part of shiny modules
#' @param ... extra arguments to the \code{module_server} function
#'
#' @return a list with 'component' class
create_component <- function(module_ui, module_server, id, ...) {
  component <- list(
    ui = function(ns) {
      module_ui(ns(id))
    },
    server = function(...) { # dots in case a module should accept an extra input
      callModule(
        module_server,
        id,
        ...
      )
    }
  )

  class(component) <- append(class(component), "component")

  return(component)
}

# helper for content creation:
create_tab_panel <- function(title) {
  tabPanel(
    title = title,
    div(class = "mockup-content",
        sprintf("%s content", title))
  )
}

# create a custom component: ----
custom_component <- create_component(
  outer_ui, outer, "tabs"
)


# the App: ----
ui <- dashboardPage(

  dashboardHeader(title = "Nav buttons example"),

  dashboardSidebar(collapsed = TRUE),

  dashboardBody(
    with_nav_buttons_ui("hoc")
  )

)

server <- function(input, output, session) {
  callModule(
    with_nav_buttons,
    "hoc",
    component = custom_component
  )
}

shinyApp(ui, server)

Trust me, this is a minimal example.

Now I wonder: what design pattern will be the best for communicating both modules two-directionally, e.g. I'd like to disable Back button if a user is on the first pane. In this case I need to send a message to the navigation component from the outer component. What design pattern is the best for such concept?

Aucun commentaire:

Enregistrer un commentaire