R/bulma-form.R

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

#' @title
#' Bulma Forms
#'
#' @description
#' Forms exist everywhere user input is needed. These are the general containers
#' that comprise forms.
#'
#' [Form](https://bulma.io/documentation/form/general/)
#'
#' @family Bulma Form Components
#' @name bulma_form
bulma_form <- function(..., tag = tags$form) {

  tag(...) %>%
    add_class("bulma_form")

}

#' @describeIn bulma_form field container contains a `bulma_form_control()`,
#' `bulma_form_label()`, and `bulma_form_help()`.
#'
#' @param ... (tags) content
#' @param tag (fn) default HTML content
#' @param attach (flag) whether the controls here are attached to each other.
#' @param attach_align (string) if attached, then alignment of the controls
#' @param grouped (flag) controls are grouped in some way
#' @param grouped_align (string) if grouped, alignment of the group
#' @param grouped_multiline (flag) whether the group can wrap around; ideal for
#'                                 long lists of controls.
#'
#' @export
bulma_form_field <- function(...,
                             attach = FALSE,
                             attach_align = c("left", "centered", "right"),
                             grouped = FALSE,
                             grouped_align = c("left", "centered", "right"),
                             grouped_multiline = FALSE,
                             tag = tags$div) {

  assert_function(tag)
  walk(unnamed(...),
       assert_multi_class,
       c("bulma_form_control",
         "bulma_form_label",
         "bulma_form_help"))
  attach_align <- match_arg(attach_align)
  if (!is.null(attach_align)) assert_true(attach)
  grouped_align <- match_arg(grouped_align)
  if (!is.null(grouped_align)) assert_true(grouped)
  if (grouped_multiline) assert_true(grouped)

  tag(class = "field", ...) %>%
    when(attach & is.null(attach_align),
         bulma_has(., "addons")) %>%
    when(attach & !is.null(attach_align),
         bulma_has(., glue("addons-{attach_align}"))) %>%
    when(grouped && is.null(grouped_align),
         bulma_is(., "grouped")) %>%
    when(grouped && !is.null(grouped_align),
         bulma_is(., glue("grouped-{grouped_align}"))) %>%
    when(grouped && grouped_multiline, bulma_is(., "grouped-multiline")) %>%
    add_class("bulma_form_field")

}

#' @describeIn bulma_form
#' horizontal styling, should contain `bulma_form_horizontal_field_label()` and
#' `bulma_form_horizontal_field_body()`.
#'
#' @export
bulma_form_horizontal_field <- function(..., tag = tags$div) {

  assert_function(tag)
  walk(tagList(...), assert_multi_class,
       c("bulma_form_horizontal_field_label",
         "bulma_form_horizontal_field_body"))

  tag(class = "field is-horizontal", ...) %>%
    add_class("bulma_form_horizontal_field")

}

#' @describeIn bulma_form
#' field label. You can leave this blank to make it appear such that the label
#' above is inherited. should contain `bulma_form_label()`.
#'
#' @param outer_tag,inner_tag (fun) functions for the outer and inner tag.
#'
#' @export
bulma_form_horizontal_field_label <- function(...,
                                              size = c("small", "medium",
                                                       "large"),
                                              outer_tag = tags$div,
                                              inner_tag = tags$label) {

  assert_function(outer_tag)
  assert_function(inner_tag)

  outer_tag(class = "field-label", inner_tag(class = "label", ...)) %>%
    bulma_size(size) %>%
    add_class("bulma_form_horizontal_field_label")

}

#' @describeIn bulma_form contains the controls corresponding to the label.
#' Contains `bulma_form_field()`.
#' @export
bulma_form_horizontal_field_body <- function(..., tag = tags$div) {

  assert_function(tag)
  walk(unnamed(...), assert_class, "bulma_form_field")

  tag(class = "field-body", ...) %>%
    add_class("bulma_form_horizontal_field_body")

}

#' @describeIn bulma_form this can contain different fields and can all be
#' disabled in one fell swoop through `disabled = TRUE`.
#'
#' @param disabled (flag) disabled all the fields in this fieldset
#'
#' @export
bulma_form_fieldset <- function(..., disabled = FALSE, tag = tags$fieldset) {

  assert_function(tag)
  walk(tagList(...), assert_multi_class,
       c("bulma_form_field", "bulma_form_horizontal_field"))

  tag(...) %>%
    when(disabled, bulma_disabled(.)) %>%
    add_class("bulma_form_fieldset")

}

#' @describeIn bulma_form contains the actual inputs in the field.
#'
#' @param icons    (str) if there are any `bulma_form_icon()`s, the alignment
#' @param expanded (flg) whether the control stretches fully
#' @param loading  (flg) whether the elements are loading
#'
#' @export
bulma_form_control <- function(...,
                               icons    = NULL,
                               expanded = FALSE,
                               loading  = FALSE,
                               tag = htmltools::tags$div) {

  tags <- unnamed(...)
  assert_function(tag)
  assert_flag(expanded)
  assert_flag(loading)
  walk(tags,
       assert_multi_class,
       c("bulma_form_input", "bulma_form_select",
         "bulma_form_button", "bulma_form_icon",
         "bulma_form_textarea", "bulma_form_radio",
         "bulma_form_checkbox", "bulma_form_file",
         "bulma_button", "bulma_tags", "bulma_form_label"))
  assert_subset(icons, c("left", "right"))

  if (expanded) {
    tags <- tags %>%
      map(~if (inherits(., "bulma_form_select")) {
        bulma_fullwidth(.)
      } else {
        .
      }) %>%
      tagList()
  }

  exec(tag, class = "control", !!!tags) %>%
    when(
      !is.null(icons),
      reduce(
        icons,
        ~bulma_has(.x, glue("icons-{.y}")),
        .init = .
      )
    ) %>%
    when(expanded, bulma_is(., "expanded")) %>%
    when(loading, bulma_is(., "loading")) %>%
    add_class("bulma_form_control")

}

#' @describeIn bulma_form label text inside a `bulma_form_field()`
#' @export
bulma_form_label <- function(..., tag = tags$label) {

  assert_function(tag)

  tag(class = "label", ...) %>%
    add_class("bulma_form_label")

}

#' @describeIn bulma_form help text inside a `bulma_form_field()`.
#' @export
bulma_form_help <- function(...,
                            color = c("primary", "link", "info",
                                      "success", "warning", "danger"),
                            tag = tags$p) {

  assert_function(tag)

  tag(class = "help", ...) %>%
    bulma_color(color) %>%
    add_class("bulma_form_help")

}

#' @describeIn bulma_form Icons to insert into the inputs
#'
#' @param icon icon class for the icon set
#' @param align,size,color styling parameters
#'
#' @export
bulma_form_icon <- function(icon,
                            ...,
                            align = c("left", "right"),
                            size  = c("small", "normal", "medium", "large"),
                            color = c("primary", "link", "info",
                                      "success", "warning", "danger",
                                      "white", "black", "light", "dark",
                                      "black-bis", "black-ter", "grey-darker",
                                      "grey-dark", "grey-light", "grey-lighter",
                                      "white-ter", "white-bis"),
                            tag = tags$span) {

  bulma_icon(icon = icon,
             size = size,
             color = color,
             ...,
             tag = tag) %>%
    bulma_align(align) %>%
    bulma_color(color) %>%
    add_class("bulma_form_icon")

}