R/bulma-menu.R

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

#' @title
#' Bulma Menu
#'
#' @description
#' A simple menu, for any type of vertical navigation.
#'
#' * `bulma_menu()` - main menu container
#'   * `bulma_menu_label()` - labels on the menu
#'   * `bulma_menu_list()` - lists (can be nested up to 2 levels)
#'
#' [Menu](https://bulma.io/documentation/components/menu/)
#'
#' @param ... (tags) content
#' @param tag default HTML tag
#'
#' @family Bulma Components
#' @name bulma_menu
NULL

#' @describeIn bulma_menu
#' main container, should contain only `bulma_menu_list()` and
#' `bulma_menu_label()`.
#' @export
bulma_menu <- function(..., tag = tags$aside) {

  assert_function(tag)
  walk(tagList(...),
       ~assert_multi_class(., c("bulma_menu_list",
                                "bulma_menu_label")))

  tag(class = "menu", ...) %>%
    add_class("bulma_menu")

}

#' @describeIn bulma_menu menu list, should contain only
#' `bulma_menu_list_item()`
#'
#' @export
bulma_menu_list <- function(..., tag = tags$ul) {

  assert_function(tag)
  walk(unnamed(...), assert_multi_class, c("bulma_menu_list_item",
                                           "bulma_menu_list_menu"))

  tag(class = "menu-list", ...) %>%
    add_class("bulma_menu_list")

}

#' @describeIn bulma_menu menu list item
#' @param active (flg) whether or not this list item is selected
#' @param menu   (tag) content for the menu
#' @param outer_tag,inner_tag (fun) functions for the list item
#' @export
bulma_menu_list_item <- function(...,
                                 menu = NULL,
                                 active = FALSE,
                                 outer_tag = tags$li,
                                 inner_tag = tags$a) {

  assert_function(outer_tag)
  assert_function(inner_tag)

  inner_tag(...) %>%
    when(active, bulma_is(., "active")) %>%
    outer_tag(menu) %>%
    add_class("bulma_menu_list_item")

}

#' @describeIn bulma_menu menu label
#' @export
bulma_menu_label <- function(..., tag = tags$p) {

  assert_function(tag)

  tag(class = "menu-label", ...) %>%
    add_class("bulma_menu_label")

}

#' @describeIn bulma_menu menu item that is also a menu
bulma_menu_list_item_menu <- function(..., tag = tags$ul) {

  walk(unnamed(...), assert_class, "bulma_menu_list_item")
  tag(...) %>%
    add_class("bulma_menu_list_menu")

}