R shinydashboard add a customized color for status parameter

Question

So my question is very related to this one : R shinyDashboard customize box status color

However, the problem is that the provided solution does not add an available color but only replace an existing one. Thus, we are limited to only 5 colors for boxes in one shiny apps. In other words, I would like to add a customized color while keeping the existing ones

So i thought about a similar solution but it didn't work...

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(
        tags$style(HTML("
                        .box.box-solid.box-primary2>.box-header {
                        color:#fff;
                        background:#666666
                        }

                        .box.box-solid.box-primary2{
                        border-bottom-color:#666666;
                        border-left-color:#666666;
                        border-right-color:#666666;
                        border-top-color:#666666;
                        }

                        ")),
        fluidRow(
            box(width = 6, title = "youhou", status = "primary2", solidHeader = TRUE,
                "Box content"
            )
        )
        )
    )


server <- function(input, output) {}

shinyApp(ui, server)

Error in validateStatus(status) : Invalid status: primary2. Valid statuses are: primary, success, info, warning, danger.

Answer 1

The below is a hacky way of doing it. Essentially you need to create a custom div and use it's id tag so that the css styling takes precedence over the original box styling and use renderUI to generate this new custom box.

However, you also do not want to inadvertently style the other box so you use the id to apply the styling specifically to your box of choice.

Finally you use uiOutput and renderUI on the server side to create this new div and the respective styled box.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(

      box(width = 6, title = "youhou", status = "primary", solidHeader = TRUE,
          "Box content"
      ),

      uiOutput("primary2")
    )
  )
)


server <- function(input, output) {

  output$primary2 <- renderUI({
    tags$div(class = "another-box", id = "primariy2",
    box(width = 6, title = "youhou", status = "primary", solidHeader = TRUE,
        "Box content"
    ),
    tags$style(HTML("
                        #primariy2 .box.box-solid.box-primary>.box-header {
                        color:#fff;
                        background:#666666
                        }

                        .box.box-solid.box-primary {
                        border-bottom-color:#666666;
                        border-left-color:#666666;
                        border-right-color:#666666;
                        border-top-color:#666666;
                        }

                        ")) 
  )

  })

}