bulma/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 = "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_constants("column 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_constants("column 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))
}

validate_col_size <- function(size, var_name = "size") {
  validate_value(size, bulma_constants("column 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
  }
}