R/card.R

In HarryRosen/hrimodules: Harry Rosen Inc Shiny Modules

#' The Card UI for bs4dash
#'
#' The card creates a server-side function to be handled
#' by conditional logic at later dates
#'
#' @param id is unique ID associated with the card for the UI namespace
#'
#' @importFrom shiny uiOutput
#'
#' @export
card_ui <- function(id) {
  ns <- NS(id)
  uiOutput(ns("card"))
}



#' The card server for bs4dash
#'
#' The card functions create a server-side interaction to be handled
#' by conditional logic for the parameters (\code{reactive})
#'
#'
#' @param input list of inputs used in the shiny application session
#' @param output list of outputs used the shiny application session
#' @param session The shiny app session object
#' @param name The title of the card
#' @param closable_ The option to open or close the card
#' @param width The total width of the card
#' @param status_colour The colour of the card to use
#' @param solid_header The colour of the card header
#' @param collapse_ Can the window be collapsed?
#' @param lbl_text Label text
#' @param lbl_colour Label colour
#' @param lbl_tooltip Label tooltip
#' @param ... The other components of the card UI
#'
#' @importFrom bs4Dash bs4Card
#' @importFrom shiny renderUI
#' @export
#'
card_server <- function(input,
                        output,
                        session,
                        name,
                        closable_,
                        width,
                        status_colour,
                        solid_header,
                        collapse_,
                        lbl_text,
                        lbl_colour,
                        lbl_tooltip,
                        ...) {

  name <- to_reactive(name)
  closable_ <- to_reactive(closable_)
  width <- to_reactive(width)
  status_colour <- to_reactive(status_colour)
  solid_header <- to_reactive(solid_header)
  collapse_ <- to_reactive(collapse_)
  lbl_text <- to_reactive(lbl_text)
  lbl_colour <- to_reactive(lbl_colour)
  lbl_tooltip <- to_reactive(lbl_tooltip)


  output[['card']] <- renderUI(bs4Dash::bs4Card(
    title = name(),
    closable = closable_(),
    width = width(),
    status = status_colour(),
    solidHeader = solid_header(),
    collapsible = collapse_(),
    labelText = lbl_text(),
    labelStatus = lbl_colour(),
    labelTooltip = lbl_tooltip(),
    ...
  ))
}