Having difficulty nesting action button inside bs4card

Question

I am trying to build a modular shiny app and one important component in the app is bs4cards that have a dropdown menu and the in the menu there is a save button that will save the content of the card. Here is the code for the two modules that I build. The bs4card module will contain the actionbttn module.

mod_actionbttn_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("button"))
  )
}

#' valuebox Server Functions
#'
#' 
mod_actionbttn_server <- function(id, label, icon, style, size, block){
  moduleServer(id, function(input, output, session){
    
    output$button <- renderUI({
      actionBttn(
                 label = req(rlabel()),
                 icon = req(ricon()),
                 style = req(rstyle()),
                 color = req(zsize()),
                 block = req(rblock())
      )
    })
    
    rlabel <- reactive(label)
    ricon <- reactive(icon)
    rstyle <- reactive(style)
    rsize <- reactive(size)
    rblock <- reactive(block)
  })
}

mod_bs4card_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("card")),
    mod_actionbttn_ui(ns("button"))
  )
}

#' valuebox Server Functions
#'
#' 
mod_bs4card_server <- function(id, title, status){
  moduleServer(id, function(input, output, session){
    
    output$card <- renderUI({
      bs4Card(title = req(rtitle()), 
              status = req(rstatus()),
              solidHeader = TRUE,
              width = NULL,
              collapsible = TRUE,
              collapsed = TRUE,
              closable = TRUE,
              maximizable = TRUE,
              dropdownMenu = mod_actionbttn_server("button"))
    })
    
    rtitle <- reactive(title)
    rstatus <- reactive(status)
  })
}

ui <- bs4DashPage(header = bs4DashNavbar(), 
                  sidebar = bs4DashSidebar(),
                  body =  fluidRow(
                    column(
                      width = 12,mod_bs4card_ui("bs4c")))
)

server <- function(input,output,session){
  mod_bs4card_server("bs4c",
                     title = "Some Title",
                     status = "navy")
}

shinyApp(ui = ui, server = server)

The major problem is how to pass the parameters for the action button, I mean the label, icon, style,style and so on.

Please post a full [MRE](https://stackoverflow.com/help/minimal-reproducible-example), so that someone can help you. We cannot guess what you are doing in your `ui` and `server`. — YBS, Sep 24 '21 at 12:48

score 0 · Answer 1 · answered Sep 24 '21 at 15:29

I am not sure what you looking for. The following works, but you need to update it to your needs.

library(bs4Dash)

mod_actionbttn_ui <- function(id){
  ns <- NS(id)
  tagList(
    uiOutput(ns("button"))
  )
}

#' valuebox Server Functions
#'
#' 
mod_actionbttn_server <- function(id, label, status, zsize, block){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    output$button <- renderUI({
      actionBttn(inputId = ns("btn4"),
        label = "My actionbttn",
        #icon = icon("sliders"),
        style = "float",
        color = req(status()),
        size = zsize,
        block = block
      )
    })
    
    return(reactive(input$btn4))
  })
}

mod_bs4card_ui <- function(id){
  ns <- NS(id)
  tagList(
    fluidRow(column(6, uiOutput(ns("card")) ,
                    mod_actionbttn_ui(ns("button"))
                    )), 
  )
}

#' valuebox Server Functions
#'
mod_bs4card_server <- function(id, title, status){
  moduleServer(id, function(input, output, session){
    rtitle <- reactive(title)
    rstatus <- reactive(status)
    
    mybtn4 <- mod_actionbttn_server("button",rtitle,rstatus,"lg",TRUE)
    observe({print(mybtn4())})
    
    output$card <- renderUI({
      bs4Card(title = req(rtitle()), 
              status = req(rstatus()),
              solidHeader = TRUE,
              width = 12,
              collapsible = TRUE,
              collapsed = TRUE,
              closable = TRUE,
              maximizable = TRUE,
              #dropdownMenu = mod_actionbttn_server("button",rtitle,rstatus,"lg",TRUE)
              p("My Box Content",mybtn4())
              )
    })
    
  })
}

ui <- bs4DashPage(header = bs4DashNavbar(), 
                  sidebar = bs4DashSidebar(),
                  body =  bs4DashBody(fluidRow(
                    column(width = 12,mod_bs4card_ui("bs4c"))))
)

server <- function(input,output,session){
  mod_bs4card_server("bs4c",
                     title = "Some Title",
                     status = "primary")
}

shinyApp(ui = ui, server = server)

Having difficulty nesting action button inside bs4card

1 Answers1

Linked