R/bulma-table.R

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

#' @title
#' Bulma Table
#'
#' @description
#' The inevitable HTML table, with special case cells.
#'
#' [Table](https://bulma.io/documentation/elements/table/)
#'
#' @family Bulma Elements
#' @name bulma_table
NULL

#' @describeIn bulma_table
#' the main container; contains header, footer, and body.
#'
#' @param ... (tags) content
#' @param bordered,striped,narrow,hoverable,fullwidth (flag) styling parameters.
#'
#' @export
bulma_table <- function(...,
                        bordered  = FALSE,
                        striped   = FALSE,
                        narrow    = FALSE,
                        hoverable = FALSE,
                        fullwidth = FALSE) {

  walk(tagList(...),
       assert_multi_class,
       c("bulma_table_header",
         "bulma_table_footer",
         "bulma_table_body"))

  tags$table(class = "table", ...) %>%
    when(bordered, bulma_is(., "bordered")) %>%
    when(striped, bulma_is(., "striped")) %>%
    when(narrow, bulma_is(., "narrow")) %>%
    when(hoverable, bulma_is(., "hoverable")) %>%
    when(fullwidth, bulma_is(., "fullwidth")) %>%
    add_class("bulma_table")

}

#' @describeIn bulma_table
#' wraps around `bulma_table()` in order to make it a scrollable element.
#'
#' @export
bulma_table_container <- function(...) {

  walk(tagList(...), assert_class, "bulma_table")
  tags$div(
    class = "table-container",
    ...
  ) %>%
    add_class("bulma_table")

}

#' @describeIn bulma_table
#' is the table header; contains a `bulma_table_row()`.
#'
#' @export
bulma_table_header <- function(...) {

  walk(
    tagList(...),
    ~assert_class(., "bulma_table_row")
  )

  tags$thead(...) %>%
    add_class("bulma_table_header")

}

#' @describeIn bulma_table
#' is the table footer; contains a `bulma_table_row()`.
#'
#' @export
bulma_table_footer <- function(...) {

  walk(
    tagList(...),
    ~assert_class(., "bulma_table_row")
  )

  tags$tfoot(...) %>%
    add_class("bulma_table_footer")

}

#' @describeIn bulma_table
#' is the main body and contains many `bulma_table_row()`s.
#'
#' @export
bulma_table_body <- function(...) {

  walk(
    tagList(...),
    ~assert_class(., "bulma_table_row")
  )

  tags$tbody(...) %>%
    add_class("bulma_table_body")

}

#' @describeIn bulma_table
#' creates a table row that contains `bulma_table_cells()`.
#'
#' @param selected (flag) highlight this row
#'
#' @export
bulma_table_row <- function(..., selected = FALSE) {

  walk(tagList(...),
       ~assert_multi_class(., c("bulma_table_heading", "bulma_table_cell")))

  tags$tr(...) %>%
    when(selected, bulma_is(., "selected")) %>%
    add_class("bulma_table_row")

}

#' @describeIn bulma_table
#' is a column inside the `bulma_table_row()`.
#'
#' @export
bulma_table_cell <- function(...) {

  tags$td(...) %>%
    add_class("bulma_table_cell")

}

#' @describeIn bulma_table
#' is a table cell for inside `bulma_table_header()`.
#'
#' @export
bulma_table_heading <- function(...) {

  tags$th(...) %>%
    add_class("bulma_table_heading")

}