Add Column helper functions

NAMESPACE

 # Generated by roxygen2: do not edit by hand
 
 export(bulma_color)
+export(bulma_column)
+export(bulma_column_narrow)
+export(bulma_column_options)
+export(bulma_columns)
 export(bulma_document)
 export(bulma_helper)
 export(bulma_level)

R/columns.R

+#' Bulma Columns
+#'
+#' @param breakpoint By default, columns are only activated from **tablet**
+#'   onwards, meaning that columns are stacked on top of each other on
+#'   **mobile**. Use `breakpoint` to set the point at which columns are spread
+#'   out. See `viewport` option in [bulma_responsive()] for valid options.
+#' @param gap Gap between colums, integer from 0 to 8
+#' @param multiline Should columns wrap to multiple lines (allows columns whose
+#'   width or size add up to more than the screen width).
+#' @param class Extra classes that should be applied to the `columns` container.
+#' @param style CSS styles applied to the `columns` container.
+#' @param column_options Column options to be applied to each column. Use
+#'   [bulma_column_options()] to format.
+#' @export
+bulma_columns <- function(
+  ...,
+  breakpoint = "tablet",
+  gap = NULL,
+  multiline = TRUE,
+  class = NULL,
+  style = NULL,
+  column_options = NULL
+) {
+  items <- dots2list(...)
+  if (!is.null(column_options) && !inherits(column_options, "bulma_column_options")) {
+    rlang::abort("Please use bulma_column_options() to specify `column_options`")
+  }
+
+  breakpoint <- validate_viewport(breakpoint, "breakpoint")
+  breakpoint <- c_is(breakpoint)
+  gap <- c_is(validate_value(paste(gap), paste(0:8), FALSE, "gap"))
+
+  class <- paste(
+    "columns",
+    paste(unlist(class), collapse = " "),
+    breakpoint,
+    gap, if (length(gap)) "is-variable",
+    if (multiline) "is-multiline"
+  )
+
+  ret <- tag("div", list(class = str_trim(class), style = style,
+                         map_arg(items, bulma_column, column_options)))
+  ret <- tagList(ret)
+  class(ret) <- c("bulma_columns", class(ret))
+  ret
+}
+
+is_bulma_columns <- function(x) inherits(x, "bulma_columns")
+
+#' Bulma Column
+#'
+#' @param size One of "full", "four-fifths", "three-quarters", "two-thirds",
+#'   "three-fifths", "half", "two-fifths", "one-third", "one-quarter",
+#'   "one-fifth"
+#' @param width Column width in terms of the 12 grid units, i.e. 1-12.
+#' @param offset Column offset, one of `size` or `width`
+#' @param narrow Use [bulma_column_narrow()] to construct options
+#' @inheritParams bulma_columns
+#' @export
+bulma_column <- function(
+  ...,
+  size = NULL,
+  width = NULL,
+  offset = NULL,
+  narrow = NULL,
+  class = NULL,
+  style = NULL
+) {
+  content <- dots2list(...)
+  if (is_bulma_column(content)) return(content)
+
+  class <- str_trim(paste(
+    "column",
+    paste(unlist(class), collapse = " "),
+    bulma_column_options_format(size, width, offset, narrow)
+  ))
+
+  ret <- tag("div", list(class = class, style = style, content))
+  class(ret) <- c("bulma_column", class(ret))
+  ret
+}
+
+is_bulma_column <- function(x) inherits(x, "bulma_column")
+
+#' Bulma Column Options
+#'
+#' @inheritParams bulma_column
+#' @examples
+#' bulma_column_options(size = "one-half", offset = "one-quarter")
+#'
+#' @export
+bulma_column_options <- function(size = NULL, width = NULL, offset = NULL, narrow = NULL,
+                                 class = NULL, style = NULL) {
+  structure(
+    list(
+      size = validate_col_size(size),
+      width = validate_value(paste(width), paste(1:12), FALSE, "width"),
+      offset = validate_value(offset, c(.bulma_col_sizes, paste(1:12)), FALSE, "offset"),
+      narrow = use_bulma_column_narrow(narrow, "narrow"),
+      class = class,
+      style = style
+    ),
+    class = "bulma_column_options"
+  )
+}
+
+bulma_column_options_format <- function(size = NULL, width = NULL, offset = NULL, narrow = NULL) {
+  size <- c_is(validate_col_size(size))
+  width <- c_is(validate_value(paste(width), paste(1:12), FALSE, "width"))
+  offset <- validate_value(offset, c(.bulma_col_sizes, paste(1:12)), FALSE, "offset")
+  offset <- c_is(c_prefix(offset, "offset-"))
+  narrow <- use_bulma_column_narrow(narrow, "narrow")
+  str_trim(paste(size, width, offset, narrow))
+}
+
+.bulma_col_sizes <- c(
+  "full", "four-fifths", "three-quarters", "two-thirds",
+  "three-fifths", "half", "two-fifths", "one-third", "one-quarter",
+  "one-fifth"
+)
+
+validate_col_size <- function(size, var_name = "size") {
+  validate_value(size, .bulma_col_sizes, FALSE, var_name)
+}
+
+#' Bulma Narrow Column Helper
+#'
+#' @inheritParams bulma_responsive
+#' @export
+bulma_column_narrow <- function(viewport = NULL) {
+  ret <- if (is.null(viewport)) {
+    "is-narrow"
+  } else {
+    viewport <- validate_viewport(viewport)
+    c_is(c_prefix(viewport, "narrow-"))
+  }
+  class(ret) <- c("bulma_column_narrow", "character")
+  ret
+}
+
+use_bulma_column_narrow <- function(x, varname) {
+  if (!is.null(x)) {
+    if (!inherits(x, glue("bulma_column_narrow"))) {
+      rlang::abort(glue("Please use bulma_column_narrow() to prepare `{varname}`."))
+    }
+    x
+  }
+}

R/modifiers.R

-c_is <- function(x) {
-  str_trim(paste("is-", x, sep = "", collapse = " "))
-}
-
-c_has <- function(x) {
-  str_trim(paste("has-", x, sep = "", collapse = " "))
-}
-
-c_prefix <- function(x = NULL, prefix = NULL) {
-  if (is.null(x)) return(NULL)
-  paste0(prefix, x)
-}
-
-str_trim <- function(x) {
-  gsub("^\\s*|\\s*$", "", x)
-}
 
 # Modifiers :: Syntax -----------------------------------------------------
 
   display <- validate_value(display, c(
     "block", "flex", "inline", "inline-block", "inline-flex"
   ), FALSE, "display")
-  viewport <- validate_value(viewport, c(
-    "mobile", "tablet", "touch", "desktop", "widescreen", "fullhd"
-  ), FALSE, "viewport")
+  viewport <- validate_viewport(viewport)
   c_is(paste(display, viewport, if (only) "only", sep = "-"))
 }
 
+.bulma_viewports <- c(
+  "mobile", "tablet", "touch", "desktop", "widescreen", "fullhd"
+)
+
+validate_viewport <- function(viewport, var_name = "viewport") {
+  validate_value(viewport, .bulma_viewports , FALSE, var_name)
+}
 
 # Modifiers :: Color ------------------------------------------------------
 
 #' @return String of modifer classes
 #' @export
 bulma_color <- function(text = NULL, background = NULL) {
-  text <- validate_value(text, bulma::.bulma_colors, FALSE, "text")
+  text <- validate_value(text, .bulma_colors, FALSE, "text")
   text <- c_prefix(text, "text-")
-  background <- validate_value(background, bulma::.bulma_colors, FALSE, "background")
+  background <- validate_value(background, .bulma_colors, FALSE, "background")
   background <- c_prefix(background, prefix = "background-")
   c_has(c(text, background))
 }
   size <- c_prefix(size, prefix = "size-")
   responsive_size <- use_bulma_responsive(responsive_size, "size", "responsive_size")
 
-  color <- validate_value(color, bulma::.bulma_colors, FALSE, "text")
+  color <- validate_value(color, .bulma_colors, FALSE, "text")
   color <- c_prefix(color, prefix = "text-")
 
 
   # TODO: Needs to be vectorized, matching size/viewport arguments
   size <- validate_value(paste(size), paste(1:7), FALSE, "size")
   size <- c_prefix(size, "size-")
-  viewport <- validate_value(viewport,
-    c("mobile", "tablet", "touch", "desktop", "widescreen", "fullhd"),
-    FALSE, "viewport")
+  viewport <- validate_viewport(viewport)
   x <- c_is(paste0(size, "-", viewport))
   class(x) <- c("responsive_size", "bulma", "character")
   x
   alignment <- validate_value(alignment, c("centered", "justified", "left", "right"),
                               FALSE, "alignment")
   alignment <- c_prefix(alignment, "text-")
-  viewport <- validate_value(viewport,
-                             c("mobile", "tablet", "touch", "desktop", "widescreen", "fullhd"),
-                             FALSE, "viewport")
+  viewport <- validate_viewport(viewport)
   x <- c_has(paste0(alignment, "-", viewport))
   class(x) <- c("responsive_alignment", "bulma", "character")
   x

R/utils.R

   x
 }
 
+map_arg <- function(x, .f, .args = NULL) {
+  mapply(.f, x, MoreArgs = .args, SIMPLIFY = FALSE, USE.NAMES = TRUE)
+}
+
 tag_function <- function(.tag = "div") {
   function(...) htmltools::tag(.tag, list(...))
 }
 
 validate_value <- function(value = NULL, choices, several.ok = TRUE, value_name = "") {
-  if (!is.null(value)) {
+  if (!is.null(value) && length(value)) {
     value_name <- if (nchar(value_name) > 0) glue("`{value_name}` - ") else ""
     if (!several.ok && length(value) > 1) {
       msg <- glue("{value_name}Using the first of {length(value)} values: {value[1]}")
       rlang::abort(glue("{value_name}Must be one of the following valid choices: ",
                         "\"{paste(choices, collapse = '\", \"')}\""))
     }
-  }
+  } else if (!is.null(value) && !length(value)) NULL
+}
+
+is_html <- function(x) inherits(class(x), "html")
+is_tagList <- function(x) inherits(class(x), "shiny.tag.list")
+is_tag <- function(x) inherits(class(x), "shiny.tag")
+is_htmlish <- function(x) is_html(x) | is_tag(x) | is_tagList(x)
+
+c_is <- function(x) {
+  if (is.null(x)) return(NULL)
+  str_trim(paste("is-", x, sep = "", collapse = " "))
+}
+
+c_has <- function(x) {
+  if (is.null(x)) return(NULL)
+  str_trim(paste("has-", x, sep = "", collapse = " "))
+}
+
+c_prefix <- function(x = NULL, prefix = NULL) {
+  if (is.null(x)) return(NULL)
+  paste0(prefix, x)
+}
+
+str_trim <- function(x) {
+  x <- gsub("^\\s*|\\s*$", "", x)
+  gsub("\\s+", " ", x)
 }

man/bulma_column.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/columns.R
+\name{bulma_column}
+\alias{bulma_column}
+\title{Bulma Column}
+\usage{
+bulma_column(..., size = NULL, width = NULL, offset = NULL,
+  narrow = NULL, class = NULL, style = NULL)
+}
+\arguments{
+\item{size}{One of "full", "four-fifths", "three-quarters", "two-thirds",
+"three-fifths", "half", "two-fifths", "one-third", "one-quarter",
+"one-fifth"}
+
+\item{width}{Column width in terms of the 12 grid units, i.e. 1-12.}
+
+\item{offset}{Column offset, one of `size` or `width`}
+
+\item{narrow}{Use [bulma_column_narrow()] to construct options}
+
+\item{class}{Extra classes that should be applied to the `columns` container.}
+
+\item{style}{CSS styles applied to the `columns` container.}
+}
+\description{
+Bulma Column
+}

man/bulma_column_narrow.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/columns.R
+\name{bulma_column_narrow}
+\alias{bulma_column_narrow}
+\title{Bulma Narrow Column Helper}
+\usage{
+bulma_column_narrow(viewport = NULL)
+}
+\arguments{
+\item{viewport}{One of "mobile", "tablet", "touch", "desktop", "widescreen",
+"fullhd". See <https://bulma.io/documentation/modifiers/responsive-helpers/>
+for more information.}
+}
+\description{
+Bulma Narrow Column Helper
+}

man/bulma_column_options.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/columns.R
+\name{bulma_column_options}
+\alias{bulma_column_options}
+\title{Bulma Column Options}
+\usage{
+bulma_column_options(size = NULL, width = NULL, offset = NULL,
+  narrow = NULL, class = NULL, style = NULL)
+}
+\arguments{
+\item{size}{One of "full", "four-fifths", "three-quarters", "two-thirds",
+"three-fifths", "half", "two-fifths", "one-third", "one-quarter",
+"one-fifth"}
+
+\item{width}{Column width in terms of the 12 grid units, i.e. 1-12.}
+
+\item{offset}{Column offset, one of `size` or `width`}
+
+\item{narrow}{Use [bulma_column_narrow()] to construct options}
+
+\item{class}{Extra classes that should be applied to the `columns` container.}
+
+\item{style}{CSS styles applied to the `columns` container.}
+}
+\description{
+Bulma Column Options
+}
+\examples{
+bulma_column_options(size = "one-half", offset = "one-quarter")
+
+}

man/bulma_columns.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/columns.R
+\name{bulma_columns}
+\alias{bulma_columns}
+\title{Bulma Columns}
+\usage{
+bulma_columns(..., breakpoint = "tablet", gap = NULL,
+  multiline = TRUE, class = NULL, style = NULL,
+  column_options = NULL)
+}
+\arguments{
+\item{breakpoint}{By default, columns are only activated from **tablet**
+onwards, meaning that columns are stacked on top of each other on
+**mobile**. Use `breakpoint` to set the point at which columns are spread
+out. See `viewport` option in [bulma_responsive()] for valid options.}
+
+\item{gap}{Gap between colums, integer from 0 to 8}
+
+\item{multiline}{Should columns wrap to multiple lines (allows columns whose
+width or size add up to more than the screen width).}
+
+\item{class}{Extra classes that should be applied to the `columns` container.}
+
+\item{style}{CSS styles applied to the `columns` container.}
+
+\item{column_options}{Column options to be applied to each column. Use
+[bulma_column_options()] to format.}
+}
+\description{
+Bulma Columns
+}

tests/manual/layout/columns/bulma_layout_columns.Rmd

+---
+title: "Column Tests"
+subtitle: "Testing Bulma Column Functions"
+author: 
+  - name: First Author
+    url: https://rstudio.com
+    extra: 
+      - "First Affiliation"
+      - "@tweeter345"
+  - name: Second Author
+    url: https://duckduckgo.com
+    extra: 
+      - "Second Affiliation"
+      - "Very Cool Guy"
+date: '`r strftime(Sys.time(), "%F %T")`'
+header-links:
+  - name: Github
+    url: https://github.com/gerkelab
+  - name: Home
+    url: https://gerkelab.com
+bulma:
+  hero: ["info", "bold"]
+output: bulma::bulma_document
+editor_options: 
+  chunk_output_type: console
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+library(bulma)
+```
+
+## Columns
+
+```r
+bulma::bulma_columns("first column", "second column", "third column")
+```
+
+`r bulma::bulma_columns("first column", "second column", "third column")`
+
+### Setting Gap
+
+```{r}
+bulma_columns(
+  "First", "Second", "Third", "Fourth",
+  gap = 2
+)
+```
+
+
+<div class="columns is-tablet is-2 is-variable is-multiline has-background-primary">
+  <div class="column">First</div>
+  <div class="column">Second</div>
+  <div class="column">Third</div>
+  <div class="column">Fourth</div>
+</div>
+
+
+### Apply Class to Columns Container
+
+```{r}
+bulma_columns(
+  "First", "Second", "Third", 
+  class = list(bulma_typography(alignment = "centered", size = 3))
+)
+```
+
+### Apply Class to Columns Container and Columns
+
+```{r}
+bulma_columns(
+  "First", "Second", "Third", 
+  gap = 2,
+  class = list(bulma_typography(alignment = "centered", size = 3)),
+  column_options = bulma_column_options(
+    class = list(
+      bulma_color("white", background = "success"),
+      bulma_modifier(state = "outlined")
+    )
+  )
+)
+```
+
+
+<div class="columns is-variable is-1-mobile is-0-tablet is-3-desktop is-8-widescreen is-2-fullhd">
+<div class="column has-background-primary">
+Column
+</div>
+<div class="column has-background-warning">
+Column
+</div>
+<div class="column has-background-danger">
+Column
+</div>
+<div class="column">
+Column
+</div>
+<div class="column">
+Column
+</div>
+<div class="column">
+Column
+</div>
+</div>

tests/manual/layout/level/bulma_layout_level.Rmd

+---
+title: "Layout Tests"
+subtitle: "Testing Bulma Layout Elements"
+author: 
+  - name: First Author
+    url: https://rstudio.com
+    extra: 
+      - "First Affiliation"
+      - "@tweeter345"
+  - name: Second Author
+    url: https://duckduckgo.com
+    extra: 
+      - "Second Affiliation"
+      - "Very Cool Guy"
+date: '`r strftime(Sys.time(), "%F %T")`'
+header-links:
+  - name: Github
+    url: https://github.com/gerkelab
+  - name: Home
+    url: https://gerkelab.com
+bulma:
+  hero: ["info", "bold"]
+output: bulma::bulma_document
+editor_options: 
+  chunk_output_type: console
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+library(bulma)
+```
+
+## Level
+
+### Basic
+
+```r
+bulma::bulma_level("Home", "Menu", "Bulma", "Reservations", "Contact")
+```
+
+`r bulma::bulma_level("Home", "Menu", "Bulma", "Reservations", "Contact")`
+
+### Heading/Number Style
+
+```r
+bulma_level("Tweets" = 3456, Following = 123, Followers = "456K", Likes = 789, style = "header")
+```
+
+`r bulma_level("Tweets" = 3456, Following = 123, Followers = "456K", Likes = 789, style = "header")`
+
+#### Dynamic Level
+
+```{r}
+iris_values <- purrr::map(iris, ~ length(unique(.)))
+bulma_level(iris_values, style = "header")
+```
+