Update bulma_level() functions

- Now works like bulma_column(), doesn't re-wrap level items
- Export bulma_level_item() and functions for header level items
- map_arg now takes multiple arguments, and drops null .args
- Adds tag_[div|p|a]()
- Adds c_str()

NAMESPACE

@@ -9,6 +9,9 @@ export(bulma_constants)
 export(bulma_document)
 export(bulma_helper)
 export(bulma_level)
+export(bulma_level_item)
+export(bulma_level_item_header)
+export(bulma_level_items_header)
 export(bulma_modifier)
 export(bulma_responsive)
 export(bulma_responsive_alignment)

R/columns.R

@@ -42,7 +42,7 @@ bulma_columns <- function(
   )
 
   ret <- tag("div", list(class = str_trim(class), style = style,
-                         map_arg(items, bulma_column, column_options)))
+                         map_arg(items, .f = bulma_column, .arg = column_options)))
   ret <- tagList(ret)
   class(ret) <- c("bulma_columns", class(ret))
   ret

R/layout.R

@@ -0,0 +1,141 @@
+
+# Layout ------------------------------------------------------------------
+
+#' Bulma Level
+#'
+#' A multi-purpose horizontal level that can contain almost any other element.
+#'
+#' @param ... Items to be wrapped in a `"level-item"` `<div>` and included in the
+#'   main level container. If only one argument is provided and that argument is
+#'   a list, the items inside the list will be treated as individual level items.
+#' @param left A list of items to be placed in the left side of the level in a
+#'   `"level-left"` container.
+#' @param right A list of items to be placed in the right side of the level in a
+#'   `"level-right"` container.
+#' @param type One of `"item"` or `"header"`. The default (`"item"`) places level
+#'   items in the standard `"level-item"` container. Use `"header"` to use the
+#'   names of the arguments in `...` as headers over their elements to create a
+#'   large single-row pseudo-table. See examples for more details.
+#' @param container_tag Which tag should be used for the main `"level"` container?
+#'   One of `"div"` or `"nav"`.
+#' @param class Additional classes applied to level container
+#' @param style Additional style parameters applied to level container
+#' @param level_class Additional classes applied to all level item containers (except
+#'   for manually created level items).
+#' @param level_style Additional style arguments applied to all level item containers
+#'   (except for manually create level items).
+#' @examples
+#' bulma_level("Home", "Menu", "Bulma", "Reservations", "Contact")
+#' bulma_level("Tweets" = 3456, Following = 123, Followers = "456K", Likes = 789, type = "header")
+#'
+#' iris_vals <- lapply(iris, function(x) length(unique(x)))
+#' bulma_level(iris_vals, type = "header")
+#'
+#' @references <https://bulma.io/documentation/layout/level/>
+#' @family Bulma layouts
+#' @export
+bulma_level <- function(
+  ...,
+  left = NULL,
+  right = NULL,
+  is_mobile = TRUE,
+  type = c("item", "header"),
+  container_tag = c("div", "nav"),
+  class = NULL,
+  style = NULL,
+  level_class = NULL,
+  level_style = NULL
+) {
+  type <- match.arg(type)
+  tag_f <- tag_function(match.arg(container_tag))
+  x <- tag_f(
+    class = c_str("level", if (is_mobile) "is-mobile", class),
+    style = style,
+    level_side(left, "left"),
+    if (type == "item")
+      tagList(lapply(dots2list(...), bulma_level_item, class = level_class, style = level_style)),
+    if (type == "header") bulma_level_items_header(..., class = level_class, style = level_style),
+    level_side(right, "right")
+  )
+
+  x
+}
+
+#' Bulma Level Item
+#'
+#' Constructs an individual level item.
+#'
+#' @param ... Elements to be included in the level item
+#' @param class Additional classes to be applied to the level item container
+#' @param style Additional CSS style directives to be applied to the level item container
+#' @family Bulma layouts
+#' @export
+bulma_level_item <- function(..., class = NULL, style = NULL) {
+  item <- dots2list(...)
+  if (is_level_item(item)) return(item)
+  as_level_item(
+    tag_div(class = c_str("level-item", class),
+            style = style,
+            item)
+  )
+}
+
+as_level_item <- function(x) {
+  if (inherits(x, "level_item")) return(x)
+  class(x) <- c("level_item", class(x))
+  x
+}
+
+is_level_item <- function(x) inherits(x, "level_item")
+
+level_side <- function(x, side = "left") {
+  if (is.null(x)) return(NULL)
+  match.arg(side, c("left", "right"))
+  items <- lapply(x, bulma_level_item)
+  tag_div(class = c_prefix(side, "level-"), items)
+}
+
+#' Bulma Level Items with Headers
+#'
+#' Takes named arguments and converts them to
+#' (level items with headers)[bulma_level_item_header].
+#'
+#' @inheritParams bulma_level_item
+#' @param header_class Additional classes to be applied to the header (upper)
+#'   container in addition to `"heading"`
+#' @param body_class Additional classes to be applied to the title (lower)
+#'   container in addition to `"title"`
+#' @family Bulma layouts
+#' @export
+bulma_level_items_header <- function(..., class = NULL, style = NULL, header_class = NULL, body_class = NULL) {
+  items <- dots2list(...)
+  x <- map_arg(
+    .f = bulma_level_item_header,
+    names(items),
+    items,
+    .args = list(class = if (is.null(class)) "has-text-centered" else class,
+                style = style,
+                header_class = header_class,
+                body_class = body_class)
+  )
+  tagList(x)
+}
+
+#' Bulma Level Item with Header
+#'
+#' Constructs an individual level item with a header (upper) and a title (lower).
+#'
+#' @param item_name The header (or name) of the item
+#' @param item_body The body of the item
+#' @inheritParams bulma_level_items_header
+#' @family Bulma layouts
+#' @export
+bulma_level_item_header <- function(item_header, item_body, class = NULL, style = NULL, header_class = NULL, body_class = NULL) {
+  bulma_level_item(
+    class = class,
+    style = style,
+    tag_div(
+      tag_p(class = c_str("heading", header_class), item_header),
+      tag_p(class = c_str("title", body_class), item_body)
+    ))
+}

R/layout_level.R

@@ -1,66 +0,0 @@
-#' @title Bulma Level
-#' @examples
-#' bulma_level("Home", "Menu", "Bulma", "Reservations", "Contact")
-#' bulma_level("Tweets" = 3456, Following = 123, Followers = "456K", Likes = 789, style = "header")
-#' @export
-bulma_level <- function(
-  ...,
-  left = NULL,
-  right = NULL,
-  is_mobile = TRUE,
-  style = c("item", "header"),
-  container_tag = c("div", "nav")
-) {
-  level_item_f <- switch(
-    match.arg(style),
-    item = level_item,
-    header = level_item_header
-  )
-  tag_f <- tag_function(match.arg(container_tag))
-  x <- tag_f(
-    class = paste("level", if (is_mobile) "is-mobile"),
-    level_side(left),
-    level_item_f(...),
-    level_side(right, "right")
-  )
-
-  x
-}
-
-level_item <- function(...) {
-  x <- apply_tag(dots2list(...), tag = "div", class = "level-item")
-  tagList(x)
-}
-
-level_side <- function(x, side = "left") {
-  if (is.null(x)) return(NULL)
-  match.arg(side, c("left", "right"))
-  lapply(x, function(item) {
-    htmltools::tags$div(
-      class = paste0("level-", side),
-      level_item(x)
-    )
-  })
-}
-
-#' @title Bulma Level Items With Headers
-level_item_header <- function(..., item_class = "has-text-centered", heading_class = NULL, title_class = NULL) {
-  items <- dots2list(...)
-  x <- mapply(level_item_header_, names(items), items,
-         MoreArgs = list(item_class = item_class,
-                         heading_class = heading_class,
-                         title_class = title_class),
-         SIMPLIFY = FALSE)
-  tagList(x)
-}
-
-#' @importFrom htmltools tag
-level_item_header_ <- function(item_name, item_body, item_class = NULL, heading_class = NULL, title_class = NULL) {
-  tag("div", list(
-    class = paste("level-item", item_class),
-    list(tag("div", list(
-      tag("p", list(class = paste("heading", heading_class), item_name)),
-      tag("p", list(class = paste("title", title_class), item_body))
-    )))
-  ))
-}

R/utils.R

@@ -11,14 +11,23 @@ dots2list <- function(...) {
   x
 }
 
-map_arg <- function(x, .f, .args = NULL) {
-  mapply(.f, x, MoreArgs = .args, SIMPLIFY = FALSE, USE.NAMES = TRUE)
+map_arg <- function(..., .f, .args = NULL) {
+  mapply(.f, ..., MoreArgs = compact(.args), SIMPLIFY = FALSE, USE.NAMES = TRUE)
+}
+
+compact <- function(x) {
+  x[!vapply(x, is.null, logical(1))]
 }
 
 tag_function <- function(.tag = "div") {
   function(...) htmltools::tag(.tag, list(...))
 }
 
+tag_div <- tag_function("div")
+tag_p   <- tag_function("p")
+tag_a   <- tag_function("a")
+
+
 validate_value <- function(value = NULL, choices, several.ok = TRUE, value_name = "") {
   if (!is.null(value) && length(value)) {
     value_name <- if (nchar(value_name) > 0) glue("`{value_name}` - ") else ""
@@ -68,6 +77,10 @@ c_prefix <- function(x = NULL, prefix = NULL) {
   paste0(prefix, x)
 }
 
+c_str <- function(...) {
+  str_trim(paste(..., sep = " ", collapse = " "))
+}
+
 str_trim <- function(x) {
   x <- gsub("^\\s*|\\s*$", "", x)
   gsub("\\s+", " ", x)

man/bulma_level.Rd

@@ -1,16 +1,60 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/layout_level.R
+% Please edit documentation in R/layout.R
 \name{bulma_level}
 \alias{bulma_level}
 \title{Bulma Level}
 \usage{
 bulma_level(..., left = NULL, right = NULL, is_mobile = TRUE,
-  style = c("item", "header"), container_tag = c("div", "nav"))
+  type = c("item", "header"), container_tag = c("div", "nav"),
+  class = NULL, style = NULL, level_class = NULL,
+  level_style = NULL)
+}
+\arguments{
+\item{...}{Items to be wrapped in a \code{"level-item"} \code{<div>} and included in the
+main level container. If only one argument is provided and that argument is
+a list, the items inside the list will be treated as individual level items.}
+
+\item{left}{A list of items to be placed in the left side of the level in a
+\code{"level-left"} container.}
+
+\item{right}{A list of items to be placed in the right side of the level in a
+\code{"level-right"} container.}
+
+\item{type}{One of \code{"item"} or \code{"header"}. The default (\code{"item"}) places level
+items in the standard \code{"level-item"} container. Use \code{"header"} to use the
+names of the arguments in \code{...} as headers over their elements to create a
+large single-row pseudo-table. See examples for more details.}
+
+\item{container_tag}{Which tag should be used for the main \code{"level"} container?
+One of \code{"div"} or \code{"nav"}.}
+
+\item{class}{Additional classes applied to level container}
+
+\item{style}{Additional style parameters applied to level container}
+
+\item{level_class}{Additional classes applied to all level item containers (except
+for manually created level items).}
+
+\item{level_style}{Additional style arguments applied to all level item containers
+(except for manually create level items).}
 }
 \description{
-Bulma Level
+A multi-purpose horizontal level that can contain almost any other element.
 }
 \examples{
 bulma_level("Home", "Menu", "Bulma", "Reservations", "Contact")
-bulma_level("Tweets" = 3456, Following = 123, Followers = "456K", Likes = 789, style = "header")
+bulma_level("Tweets" = 3456, Following = 123, Followers = "456K", Likes = 789, type = "header")
+
+iris_vals <- lapply(iris, function(x) length(unique(x)))
+bulma_level(iris_vals, type = "header")
+
+}
+\references{
+\url{https://bulma.io/documentation/layout/level/}
+}
+\seealso{
+Other Bulma layouts: \code{\link{bulma_level_item_header}},
+  \code{\link{bulma_level_items_header}},
+  \code{\link{bulma_level_item}}
 }
+\concept{Bulma layouts}

man/bulma_level_item.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/layout.R
+\name{bulma_level_item}
+\alias{bulma_level_item}
+\title{Bulma Level Item}
+\usage{
+bulma_level_item(..., class = NULL, style = NULL)
+}
+\arguments{
+\item{...}{Elements to be included in the level item}
+
+\item{class}{Additional classes to be applied to the level item container}
+
+\item{style}{Additional CSS style directives to be applied to the level item container}
+}
+\description{
+Constructs an individual level item.
+}
+\seealso{
+Other Bulma layouts: \code{\link{bulma_level_item_header}},
+  \code{\link{bulma_level_items_header}},
+  \code{\link{bulma_level}}
+}
+\concept{Bulma layouts}

man/bulma_level_item_header.Rd

@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/layout.R
+\name{bulma_level_item_header}
+\alias{bulma_level_item_header}
+\title{Bulma Level Item with Header}
+\usage{
+bulma_level_item_header(item_header, item_body, class = NULL,
+  style = NULL, header_class = NULL, body_class = NULL)
+}
+\arguments{
+\item{item_body}{The body of the item}
+
+\item{class}{Additional classes to be applied to the level item container}
+
+\item{style}{Additional CSS style directives to be applied to the level item container}
+
+\item{header_class}{Additional classes to be applied to the header (upper)
+container in addition to \code{"heading"}}
+
+\item{body_class}{Additional classes to be applied to the title (lower)
+container in addition to \code{"title"}}
+
+\item{item_name}{The header (or name) of the item}
+}
+\description{
+Constructs an individual level item with a header (upper) and a title (lower).
+}
+\seealso{
+Other Bulma layouts: \code{\link{bulma_level_items_header}},
+  \code{\link{bulma_level_item}}, \code{\link{bulma_level}}
+}
+\concept{Bulma layouts}

man/bulma_level_items_header.Rd

@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/layout.R
+\name{bulma_level_items_header}
+\alias{bulma_level_items_header}
+\title{Bulma Level Items with Headers}
+\usage{
+bulma_level_items_header(..., class = NULL, style = NULL,
+  header_class = NULL, body_class = NULL)
+}
+\arguments{
+\item{...}{Elements to be included in the level item}
+
+\item{class}{Additional classes to be applied to the level item container}
+
+\item{style}{Additional CSS style directives to be applied to the level item container}
+
+\item{header_class}{Additional classes to be applied to the header (upper)
+container in addition to \code{"heading"}}
+
+\item{body_class}{Additional classes to be applied to the title (lower)
+container in addition to \code{"title"}}
+}
+\description{
+Takes named arguments and converts them to
+(level items with headers)\link{bulma_level_item_header}.
+}
+\seealso{
+Other Bulma layouts: \code{\link{bulma_level_item_header}},
+  \code{\link{bulma_level_item}}, \code{\link{bulma_level}}
+}
+\concept{Bulma layouts}

man/level_item_header.Rd

@@ -1,12 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/layout_level.R
-\name{level_item_header}
-\alias{level_item_header}
-\title{Bulma Level Items With Headers}
-\usage{
-level_item_header(..., item_class = "has-text-centered",
-  heading_class = NULL, title_class = NULL)
-}
-\description{
-Bulma Level Items With Headers
-}

tests/testthat/test-layout.R

@@ -0,0 +1,82 @@
+context("test-layout")
+
+# Bulma Levels ------------------------------------------------------------
+
+level_home_example <- '
+<div class="level is-mobile">
+  <div class="level-item">Home</div>
+  <div class="level-item">Menu</div>
+  <div class="level-item">Bulma</div>
+  <div class="level-item">Reservations</div>
+  <div class="level-item">Contact</div>
+</div>'
+
+level_header_example <- '
+<div class="level is-mobile">
+  <div class="level-item has-text-centered">
+    <div>
+      <p class="heading">Tweets</p>
+      <p class="title">3456</p>
+    </div>
+  </div>
+  <div class="level-item has-text-centered">
+    <div>
+      <p class="heading">Following</p>
+      <p class="title">123</p>
+    </div>
+  </div>
+</div>'
+
+collapse_html_chr <- function(x) {
+  x <- paste(x, collapse = "\n")
+  gsub("\\s*\n\\s*", "", x)
+}
+
+expect_html_chr <- function(x, y) {
+  expect_equal(collapse_html_chr(x), collapse_html_chr(y))
+}
+
+test_that("bulma_level_item single", {
+  expect_html_chr(bulma_level_item("one"), '<div class="level-item">one</div>')
+  expect_true(is_level_item(bulma_level_item("a")))
+  expect_true(is_level_item(bulma_level_item("a", "b")))
+  expect_equal(as_level_item(bulma_level_item("a")),
+               bulma_level_item("a"))
+})
+
+test_that("bulma_level_item doesn't wrap other bulma_level_items", {
+  expect_html_chr(bulma_level_item(bulma_level_item("one")), '<div class="level-item">one</div>')
+})
+
+test_that("bulma_level_item concatenates inputs into single div", {
+  expect_html_chr(bulma_level_item("A", "B"), '<div class="level-item">AB</div>')
+  expect_html_chr(bulma_level_item(tag_p("A"), tag_p("B")), '<div class="level-item"><p>A</p><p>B</p></div>')
+})
+
+test_that("bulma_level generally works", {
+  expect_html_chr(bulma_level("Home", "Menu", "Bulma", "Reservations", "Contact"),
+                  level_home_example)
+  expect_html_chr(bulma_level("Home", bulma_level_item("Menu"), "Bulma", "Reservations", "Contact"),
+                  level_home_example)
+  expect_html_chr(bulma_level("Tweets" = 3456, Following = 123, type = "header"),
+                  level_header_example)
+})
+
+test_that("bulma_level works with sides", {
+  bulma_with_sides <- bulma_level(left = list(bulma_level_item("123 posts")),
+                                  right = list("All", "Published"),
+                                  "Normal")
+  level_with_sides <- '
+  <div class="level is-mobile">
+  <div class="level-left">
+    <div class="level-item">123 posts</div>
+  </div>
+  <div class="level-item">Normal</div>
+  <div class="level-right">
+    <div class="level-item">All</div>
+    <div class="level-item">Published</div>
+  </div>
+  </div>'
+
+  expect_html_chr(bulma_with_sides, level_with_sides)
+})