R/card.R

In shidashi: A Shiny Dashboard Template System

#' @title Card-like 'HTML' element
#' @param title the title of the card
#' @param ... the body content of the card
#' @param body_main,body_side used by \code{card2}, the body
#' content of the front and back sides of the card
#' @param footer the footer of the card; will be hidden if
#' \code{footer=NULL}
#' @param tools a list of tools or badges to be displayed at
#' top-right corner, generated by \code{\link{as_badge}} or
#' \code{\link{card_tool}}
#' @param inputId the id of the card
#' @param class the 'HTML' class of the entire card
#' @param class_header the the 'HTML' class of the card header
#' @param class_body the the 'HTML' class of the card body
#' @param class_foot the the 'HTML' class of the card footer
#' @param style_header 'CSS' style of the header
#' @param style_body 'CSS' style of the body
#' @param start_collapsed whether the card starts as collapsed
#' @param resizable whether the card body can be resized vertically;
#' notice that if true, then the default padding for body will be zero
#' @param root_path see \code{\link{template_root}}
#' @param session shiny session domain
#' @param method action to expand, minimize, or remove the cards;
#' choices are \code{"collapse"}, \code{"expand"}, \code{"remove"},
#' \code{"toggle"}, \code{"maximize"}, \code{"minimize"},
#' and \code{"toggleMaximize"}
#' @return 'HTML' tags
#'
#' @examples
#' library(shiny)
#' library(shidashi)
#'
#' # Used for example only
#' ns <- I
#' session <- MockShinySession$new()
#'
#' # -------------- Basic usage -------------
#' card(
#'   title = "Badges", div(
#'     class = "padding-20",
#'     p(
#'       "Add badges to the top-right corder. ",
#'       "Use \"|\" to indicate the badge classes; ",
#'       "for example: \"badge-info\", \"badge-warning\"..."
#'     ),
#'     hr(), p(
#'       "Use `resizable = TRUE` to make card resizable."
#'     )
#'   ),
#'   tools = list(
#'     as_badge("New|badge-info"),
#'     as_badge("3|badge-warning")
#'   ),
#'   class_body = "height-300",
#'   resizable = TRUE
#' )
#'
#' # ---------------- With tools -----------------
#' card(
#'   title = "Default Tools",
#'   plotOutput(
#'     ns("card_defaulttool_plot"),
#'     height = "100%"
#'   ),
#'   tools = list(
#'     card_tool(
#'       widget = "link",
#'       href = "https://github.com/dipterix"
#'     ),
#'     card_tool(widget = "collapse"),
#'     card_tool(widget = "maximize")
#'   ),
#'   class_body = "height-300",
#'   resizable = TRUE
#' )
#'
#' # -------------- Card2 example --------------
#' card2(
#'   title = "Card2 Example", body_main =
#'     plotOutput(
#'     outputId = ns("card2_plot"),
#'     height = "100%"
#'   ),
#'   body_side = fluidRow(
#'     column(
#'       6L, textInput(
#'         ns("card2_plot_title"),
#'         "Plot title"
#'       )
#'     ),
#'     column(
#'       6L, sliderInput(
#'         ns("card2_plot_npts"),
#'         "# of points", min = 1, max = 100,
#'         value = 10, step = 1, round = TRUE
#'       )
#'     )
#'   ),
#'   tools = list(
#'     card_tool(widget = "link",
#'               href = "https://github.com/dipterix"),
#'     card_tool(widget = "collapse"),
#'     card_tool(widget = "maximize")
#'   ),
#'   class_body = "height-300"
#' )
#'
#' @export
card <- function(
  title, ..., footer = NULL, tools = NULL, inputId = NULL,
  class = "", class_header = "", class_body = "", class_foot = "",
  style_header = NULL, style_body = NULL, start_collapsed = FALSE,
  resizable = FALSE, root_path = template_root()){

  call <- match.call()
  body <- shiny::tagList(...)

  template_path <- file.path(root_path, 'views', 'card.html')

  if(length(title) >= 1){
    data_title <- trimws(as.character(title[[1]])[[1]])
  } else {
    data_title <- ""
  }

  if(length(footer)){
    footer <- shiny::div(
      class = combine_class("card-footer", class_foot),
      footer
    )
  } else {
    footer <- ''
  }

  if(length(tools)){
    tools <- shiny::div(
      class = "card-tools",
      tools
    )
  } else {
    tools <- ""
  }

  if(length(inputId) == 1){
    if(grepl("[\"']", inputId)){
      stop("`card` ID cannot contain quotation marks.")
    }
    card_id <- sprintf(" id='%s'", inputId)
  } else {
    card_id <- ''
  }

  if(resizable){
    default_class_body <- "height-400 resize-vertical flex-container no-padding"
    if(length(class_body)){
      class_body <- unlist(strsplit(class_body, " "))
      if(length(class_body)){
        tmp <- class_body[
          startsWith(class_body, "height-") |
            startsWith(class_body, "min-height-")
        ]
        size <- sapply(strsplit(tmp, "-"), function(x){ x[[length(x)]] })
        if(length(size)){
          suppressWarnings({
            size <- as.numeric(size)
            size <- size[!is.na(size)]
            if(length(size) && size %% 50 == 0){
              default_class_body <- "resize-vertical flex-container no-padding"
            }
          })
        }
      }
    }
    class_body <- combine_class(
      default_class_body,
      class_body
    )
    body <- flex_item(
      class = "fill-height fill-width fill-max-width",
      body
    )
  } else {
    class_body <- combine_class(
      "fill-width fill-height",
      class_body
    )
  }

  set_attr_call(shiny::htmlTemplate(
    template_path,
    document_ = FALSE,
    title = title,
    body = body,
    class = class,
    class_header = class_header,
    class_body = class_body,
    style_header = style_header,
    style_body = style_body,
    footer = footer,
    tools = tools,
    card_id = card_id,
    start_collapsed = start_collapsed,
    data_title = data_title
  ), call)
}

#' @rdname card
#' @export
card2 <- function(
  title, body_main, body_side = NULL,
  footer = NULL, tools = NULL, inputId = NULL,
  class = "", class_header = "", class_body = "min-height-400",
  class_foot = "",
  style_header = NULL, style_body = NULL, start_collapsed = FALSE,
  root_path = template_root()){

  call <- match.call()
  template_path <- file.path(root_path, 'views', 'card2.html')

  if(length(title) >= 1){
    data_title <- trimws(as.character(title[[1]])[[1]])
  } else {
    data_title <- ""
  }

  if(length(footer)){
    footer <- shiny::div(
      class = combine_class("card-footer", class_foot),
      footer
    )
  } else {
    footer <- ''
  }

  if(length(tools)){
    tools <- shiny::tagList(
      tools
    )
  } else {
    tools <- ""
  }

  if(length(inputId) == 1){
    if(grepl("[\"']", inputId)){
      stop("`card` ID cannot contain quotation marks.")
    }
    card_id <- sprintf(" id='%s'", inputId)
  } else {
    card_id <- ''
  }

  set_attr_call(shiny::htmlTemplate(
    template_path,
    document_ = FALSE,
    title = title,
    body_main = body_main,
    body_side = body_side,
    class = class,
    class_header = class_header,
    class_body = class_body,
    style_header = style_header,
    style_body = style_body,
    footer = footer,
    tools = tools,
    card_id = card_id,
    start_collapsed = start_collapsed,
    data_title = data_title
  ), call)
}

#' @rdname card
#' @export
card2_open <- function(inputId, session = shiny::getDefaultReactiveDomain()){
  session$sendCustomMessage(
    "shidashi.card2widget",
    list(
      selector = sprintf("#%s:not(.direct-chat-contacts-open) .card-tools>.btn-tool.card2-switch", session$ns(inputId))
    )
  )
}

#' @rdname card
#' @export
card2_close <- function(inputId, session = shiny::getDefaultReactiveDomain()){
  session$sendCustomMessage(
    "shidashi.card2widget",
    list(
      selector = sprintf("#%s.direct-chat-contacts-open .card-tools>.btn-tool.card2-switch", session$ns(inputId))
    )
  )
}

#' @rdname card
#' @export
card2_toggle <- function(inputId, session = shiny::getDefaultReactiveDomain()){
  # session$sendCustomMessage(
  #   "shidashi.click",
  #   list(
  #     selector = sprintf("#%s .card-tools>.btn-tool.card2-switch", session$ns(inputId))
  #   )
  # )
  session$sendCustomMessage(
    "shidashi.card2widget",
    list(
      selector = sprintf("#%s .card-tools>.btn-tool.card2-switch", session$ns(inputId))
    )
  )
}

#' @rdname card
#' @export
card_operate <- function(
  inputId, title, method, session = shiny::getDefaultReactiveDomain()
){
  method <- match.arg(
    method, choices = c("collapse", "expand", "remove", "toggle",
                        "maximize", "minimize", "toggleMaximize")
  )
  params <- list(method = method)
  if(missing(inputId)){
    params$title <- title
  } else {
    params$inputId <- session$ns(inputId)
  }
  session$sendCustomMessage("shidashi.cardwidget", params)
}