R/bulma-modal.R

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

#' @title
#' Bulma Modal
#'
#' @description
#' A classic modal overlay, in which you can include any content you want.
#'
#' * `bulma_modal()` - main container
#'   * `bulma_modal_background()` - a transparent overlay that can act as a
#'     click target to close the modal
#'   * `bulma_modal_content()` - a horizontally and vertically centered
#'     container, with a maximum width of 640px, in which you can include
#'     any content
#'   * `bulma_modal_close()` - a simple cross located in the top right corner
#'   * `bulma_modal_card()` - more classic modal structure, based on
#'     [`bulma_card()`]
#'
#' [Modal](https://bulma.io/documentation/components/modal/)
#'
#' @family Bulma Components
#' @name bulma_modal
NULL

#' @describeIn bulma_modal
#' main container; contains `bulma_modal_background()`, `bulma_modal_content()`,
#' `bulma_modal_close()`, and `bulma_modal_card()`.
#'
#' @param active (flag) whether the modal is visible
#' @param ... (tags) content
#' @param tag default HTML tag
#'
#' @export
bulma_modal <- function(..., active = FALSE, tag = tags$div) {

  assert_function(tag)
  assert_flag(active)
  walk(tagList(...),
       ~assert_multi_class(., c("bulma_modal_background",
                                "bulma_modal_content",
                                "bulma_modal_close",
                                "bulma_modal_card")))

  tag(class = "modal", ...) %>%
    when(active, bulma_is(., "active")) %>%
    add_class("bulma_modal")

}

#' @describeIn bulma_modal
#' transparent overlay that can close the modal
#' @export
bulma_modal_background <- function(tag = tags$div) {

  assert_function(tag)
  tag(class = "modal-background") %>%
    add_class("bulma_modal_background")

}

#' @describeIn bulma_modal
#' content of the modal, can contain anything
#' @export
bulma_modal_content <- function(..., tag = tags$div) {

  assert_function(tag)

  tag(class = "modal-content", ...) %>%
    add_class("bulma_modal_content")

}

#' @describeIn bulma_modal
#' close button for the modal
#'
#' @param size (string) styling parameter
#'
#' @export
bulma_modal_close <- function(size = c("small", "medium", "large"),
                              tag = tags$button) {

  size <- match_arg(size)
  assert_function(tag)

  tag(class = "modal-close") %>%
    bulma_size(size) %>%
    add_class("bulma_modal_close")

}

#' @describeIn bulma_modal
#' more classic card modal that can contain many different elements; can contain
#' `bulma_modal_card_head()`, `bulma_modal_card_body()`,
#' `bulma_modal_card_foot()`
#' @export
bulma_modal_card <- function(..., tag = tags$div) {

  assert_function(tag)
  walk(tagList(...),
       ~assert_multi_class(., c("bulma_modal_card_head",
                                "bulma_modal_card_body",
                                "bulma_modal_card_foot")))

  tag(class = "modal-card", ...) %>%
    add_class("bulma_modal_card")

}

#' @describeIn bulma_modal modal card header; can contain
#' [`bulma_modal_card_title()`]
#' @export
bulma_modal_card_head <- function(..., tag = tags$header) {

  assert_function(tag)

  tag(class = "modal-card-head", ...) %>%
    add_class("bulma_modal_card_head")

}

#' @describeIn bulma_modal modal card body
#' @export
bulma_modal_card_body <- function(..., tag = tags$section) {

  assert_function(tag)

  tag(class = "modal-card-body", ...) %>%
    add_class("bulma_modal_card_body")

}

#' @describeIn bulma_modal modal card footer
#' @export
bulma_modal_card_foot <- function(..., tag = tags$footer) {

  assert_function(tag)

  tag(class = "modal-card-foot", ...) %>%
    add_class("bulma_modal_card_foot")

}

#' @describeIn bulma_modal modal card title
#' @export
bulma_modal_card_title <- function(..., tag = tags$p) {

  assert_function(tag)

  tag(class = "modal-card-title", ...) %>%
    add_class("bulma_modal_card_title")

}