R/bulma-dropdown.R

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

#' @title
#' Bulma Dropdown
#'
#' @description
#' An interactive dropdown menu for discoverable content.
#'
#' * `bulma_dropdown()` - main container
#' * `bulma_dropdown_trigger()` - button that is visible
#'   * `bulma_dropdown_menu()` - part that is hidden by default
#'     * `bulma_dropdown_content()` - dropdown box
#'       * `bulma_dropdown_item()` - each item in the dropdown, link or div
#'       * `bulma_dropdown_divider()` - menu divider
#'
#' [Dropdown](https://bulma.io/documentation/components/dropdown/)
#'
#' @family Bulma Components
#' @name bulma_dropdown
NULL

#' @describeIn bulma_dropdown main container
#' @param active    (flg) dropdown is opened
#' @param hoverable (flg) triggered on hover
#' @param align     (str) right aligned or left aligned (default: left)
#' @param dropup    (flg) menu will open upward
#' @param tag       (fun) container tag
#' @param ...       (tag) content
#' @export
bulma_dropdown <- function(...,
                           active = FALSE,
                           hoverable = FALSE,
                           align = c("left", "right"),
                           dropup = FALSE,
                           tag = tags$div) {

  assert_flag(active)
  assert_flag(hoverable)
  assert_flag(dropup)
  align <- match_arg(align) %||% "left"
  walk(unnamed(...),
       assert_multi_class,
       c("bulma_dropdown_menu", "bulma_dropdown_trigger"))

  tag(class = "dropdown", ...) %>%
    when(hoverable, bulma_is(., "hoverable")) %>%
    when(active, bulma_is(., "active")) %>%
    when(dropup, bulma_is(., "up")) %>%
    when(align == "right", bulma_is(., "right")) %>%
    add_class("bulma_dropdown")

}

#' @describeIn bulma_dropdown button that triggers and is visible
#' @export
bulma_dropdown_trigger <- function(..., tag = tags$div) {

  walk(unnamed(...),
       assert_class, "bulma_button",
       .var.name = "elements of bulma_dropdown_trigger")

  tag(class = "dropdown-trigger", ...) %>%
    add_class("bulma_dropdown_trigger")


}

#' @describeIn bulma_dropdown menu that contains the content; contains only
#' `bulma_dropdown_content()`.
#' @export
bulma_dropdown_menu <- function(..., tag = tags$div) {

  walk(tagList(...), ~assert_class(., "bulma_dropdown_content"))

  tag(class = "dropdown-menu", ...) %>%
    add_class("bulma_dropdown_menu")

}

#' @describeIn bulma_dropdown content box that only contains
#' `bulma_dropdown_item()` and `bulma_dropdown_divider()`.
#' @export
bulma_dropdown_content <- function(..., tag = tags$div) {

  walk(tagList(...),
       ~assert_multi_class(., c("bulma_dropdown_item",
                                "bulma_dropdown_divider")))

  tag(class = "dropdown-content", ...) %>%
    add_class("bulma_dropdown_content")

}

#' @describeIn bulma_dropdown content of the dropdown, should be inside
#' `bulma_dropdown_content()`.
#' @param link   (flg) whether this is a clickable link or just content
#' @param active (flg) whether or not this is active
bulma_dropdown_item <- function(..., link = TRUE, active = FALSE) {

  assert_flag(link)
  tag <- if (link) tags$a else tags$div

  tag(class = "dropdown-item", ...) %>%
    when(active, bulma_is(., "active")) %>%
    add_class("bulma_dropdown_item")

}

#' @describeIn bulma_dropdown divider for the `bulma_dropdown_item()`s.
#' @export
bulma_dropdown_divider <- function() {

  tags$hr(class = "dropdown-divider") %>%
    add_class("bulma_dropdown_divider")

}