In hiplot/bs4Dash2: A 'Bootstrap 4' Version of 'shinydashboard'

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

A Real Time Skin Selector

{bs4Dash} has a new feature called the skinSelector(). This is a JavaScript based widget allowing the end user to change the app skin. There are 20 unique colors with 2 versions, light or dark. Note that the dashboardControlbar() is the perfect place to host the skinSelector().

library(shiny)
library(bs4Dash)
shinyApp(
  ui = dashboardPage(
    header = dashboardHeader(),
    sidebar = dashboardSidebar(
      sidebarMenu(
        menuItem(
          text = "Item 1"
        ),
        menuItem(
          text = "Item 2"
        )
      )
    ),
    body = dashboardBody(),
    controlbar = dashboardControlbar(
      collapsed = FALSE,
      div(class = "p-3", skinSelector()),
      pinned = TRUE
    ),
    title = "Skin Selector"
  ),
  server = function(input, output) { }
)

Fresh

{fresh} is developed by the dreamRs team. It is built on top of {sass}, which provides a solid R API to write SASS variables and compile into CSS. {fresh} captures most of the AdminLTE2 (as well as AdminLTE3 for Bootstrap 4) SASS variables to allow deep customization, hiding all the compilation burden under the hood.

bs4dash_color() and bs4Dash_status() provide an interface to all available AdminLTE colors and allow to overwrite the default. I strongly suggest to avoid setting the default green to blue, as it might become confusing. Instead, it is better to play with color palettes. bs4dash_sidebar_light() allows to re-style the sidebar component, bs4dash_layout() controls the main background color, bs4dash_yiq() fine tune the global contrast and bs4dash_vars() offers deeper customization (navbar, ...). The fresh theme below is based on some dark theme color palettes.

library(fresh)
# create the theme with a cyberpunk color palette
theme <- create_theme(
  bs4dash_vars(
    navbar_light_color = "#bec5cb",
    navbar_light_active_color = "#FFF",
    navbar_light_hover_color = "#FFF"
  ),
  bs4dash_yiq(
    contrasted_threshold = 10,
    text_dark = "#FFF",
    text_light = "#272c30"
  ),
  bs4dash_layout(
    main_bg = "#353c42"
  ),
  bs4dash_sidebar_light(
    bg = "#272c30",
    color = "#bec5cb",
    hover_color = "#FFF",
    submenu_bg = "#272c30",
    submenu_color = "#FFF",
    submenu_hover_color = "#FFF"
  ),
  bs4dash_status(
    primary = "#5E81AC", danger = "#BF616A", light = "#272c30"
  ),
  bs4dash_color(
    gray_900 = "#FFF", white = "#272c30"
  )
)

# create tribble for box global config
box_config <- tibble::tribble(
  ~background, ~labelStatus,
  "danger", "warning",
  "purple", "success",
  "success", "primary",
  "warning", "danger",
  "fuchsia", "info"
)

# box factory function
box_factory <- function(background, labelStatus) {
  box(
    title = "Cyberpunk Box",
    collapsible = TRUE,
    background = background,
    height = "200px",
    label = boxLabel(1, labelStatus)
  )
}

# pmap magic
boxes <- purrr::pmap(box_config, box_factory)

shinyApp(
  ui = dashboardPage(
    freshTheme = theme,
    header = dashboardHeader(
      leftUi = dropdownMenu(
        type = "messages",
        badgeStatus = "success",
        messageItem(
          from = "Support Team",
          message = "This is the content of a message.",
          time = "5 mins"
        ),
        messageItem(
          from = "Support Team",
          message = "This is the content of another message.",
          time = "2 hours"
        )
      )
    ),
    sidebar = dashboardSidebar(),
    body = dashboardBody(boxes),
    controlbar = dashboardControlbar(),
    title = "Fresh theming"
  ),
  server = function(input, output) { }
)