R/bulma-card.R

In tjpalanca/bulma.R: Bulma CSS Framework for R

#' @title
#' Bulma Card
#'
#' @description
#' An all-around flexible and composable component.
#'
#' * `bulma_card()` - main container
#'   * `bulma_card_header()` - horizontal bar with a shadow
#'     * `bulma_card_header_title()` - left-aligned bold text
#'     * `bulma_card_header_icon()` - placeholder for an icon
#'   * `bulma_card_image()` - fullwidth container for a responsive image
#'   * `bulma_card_content()` - multi-purpose container for any other element
#'   * `bulma_card_footer` - horizontal list of controls
#'     * `bulma_card_footer_item()` - repeatable list item
#'
#' [Card](https://bulma.io/documentation/components/card/)
#'
#' @param ... (tags) content
#' @param tag,outer_tag,inner_tag (fn) default HTML container
#'
#' @family Bulma Components
#' @name bulma_card
NULL

#' @describeIn bulma_card main container; should only contain header, image,
#' content, and footer
#' @export
bulma_card <- function(..., tag = tags$div) {

  assert_function(tag)
  walk(tagList(...), assert_multi_class,
       c("bulma_card_header", "bulma_card_image", "bulma_card_content",
         "bulma_card_footer"))

  tag(class = "card", ...) %>%
    add_class("bulma_card")

}

#' @describeIn bulma_card  horizontal bar with a shadow; contains only title
#' and icon
#' @export
bulma_card_header <- function(..., tag = tags$div) {

  assert_function(tag)
  walk(tagList(...),
       assert_multi_class,
       c("bulma_card_header_title", "bulma_card_header_icon"))


  tag(class = "card-header", ...) %>%
    add_class("bulma_card_header")

}

#' @describeIn bulma_card left-aligned bold text
#' @param align (str) alignment of the header title
#' @export
bulma_card_header_title <- function(...,
                                    align = c("left", "centered", "right"),
                                    tag = tags$p) {

  assert_function(tag)
  align <- match_arg(align)

  tag(class = "card-header-title", ...) %>%
    bulma_align(align) %>%
    add_class("bulma_card_header_title")

}

#' @describeIn bulma_card placeholder for an icon
#' @param icon (string) icon class based on the icon collection
#' @export
bulma_card_header_icon <- function(icon,
                                   ...,
                                   outer_tag = tags$button,
                                   inner_tag = tags$span) {

  assert_function(outer_tag)
  assert_function(inner_tag)

  outer_tag(
    class = "card-header-icon",
    bulma_icon(
      icon = icon,
      ...,
      tag = inner_tag
    )
  ) %>%
    add_class("bulma_card_header_icon")

}

#' @describeIn bulma_card fullwidth container for a responsive image
#' @param ratio (string) ratio of the image
#' @param fig_tags (string) tags inside the figure
#' @export
bulma_card_image <- function(...,
                             ratio = c("square", "1by1", "5by4", "4by3", "3by2",
                                       "5by3", "16by9", "2by1", "3by1", "4by5",
                                       "3by4", "2by3", "3by5", "9by16", "1by2",
                                       "1by3"),
                             fig_tags  = list(),
                             outer_tag = tags$div,
                             inner_tag = tags$img) {

  assert_function(outer_tag)
  assert_function(inner_tag)
  ratio <- match_arg(ratio)

  outer_tag(
    class = "card-image",
    bulma_image(
      ...,
      ratio = ratio,
      fig_tags = fig_tags,
      tag = inner_tag
    )
  ) %>%
    add_class("bulma_card_image")

}

#' @describeIn bulma_card content for the card, can contain anything
#' @export
bulma_card_content <- function(..., tag = tags$div) {

  assert_function(tag)

  tag(class = "card-content", ...) %>%
    add_class("bulma_card_content")

}

#' @describeIn bulma_card footer of controls for the card. Can only contain
#' footer items.
#' @export
bulma_card_footer <- function(..., tag = tags$div) {

  assert_function(tag)
  walk(tagList(...), assert_class, "bulma_card_footer_item")

  tag(class = "card-footer", ...) %>%
    add_class("bulma_card_footer")

}

#' @describeIn bulma_card item in the footer
#' @export
bulma_card_footer_item <- function(..., tag = tags$div) {

  assert_function(tag)

  tag(class = "card-footer-item", ...) %>%
    add_class("bulma_card_footer_item")

}