From c38c485a6cb695e40f1f24180d1c0df2342b2019 Mon Sep 17 00:00:00 2001 From: pvictor Date: Wed, 13 May 2020 19:44:13 +0200 Subject: [PATCH] bootstrap utils --- NAMESPACE | 2 + R/bootstrap-utils.R | 100 +++++++++++++++++++ R/panel.R | 78 --------------- examples/alert.R | 47 +++++++++ examples/list_group.R | 30 ++++++ examples/panel.R | 60 ++++++++++++ man/bootstrap-utils.Rd | 185 ++++++++++++++++++++++++++++++++++++ man/panel.Rd | 62 ------------ tests/testthat/test-panel.R | 7 +- 9 files changed, 427 insertions(+), 144 deletions(-) create mode 100644 R/bootstrap-utils.R delete mode 100644 R/panel.R create mode 100644 examples/alert.R create mode 100644 examples/list_group.R create mode 100644 examples/panel.R create mode 100644 man/bootstrap-utils.Rd delete mode 100644 man/panel.Rd diff --git a/NAMESPACE b/NAMESPACE index 7e7dc0bf..48fcdebf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(addSpinner) export(airDatepickerInput) export(airMonthpickerInput) export(airYearpickerInput) +export(alert) export(animateOptions) export(appendVerticalTab) export(ask_confirmation) @@ -34,6 +35,7 @@ export(execute_safely) export(hideDropMenu) export(inputSweetAlert) export(knobInput) +export(list_group) export(materialSwitch) export(multiInput) export(noUiSliderInput) diff --git a/R/bootstrap-utils.R b/R/bootstrap-utils.R new file mode 100644 index 00000000..a02b23f9 --- /dev/null +++ b/R/bootstrap-utils.R @@ -0,0 +1,100 @@ + +#' @title Bootstrap panel / alert +#' +#' @description Create a panel (box) with basic border and padding, +#' you can use Bootstrap status to style the panel, +#' see \url{http://getbootstrap.com/components/#panels}. +#' +#' @param ... UI elements to include inside the panel or alert. +#' @param heading Title for the panel in a plain header. +#' @param footer Footer for the panel. +#' @param extra Additional elements to include like a table or a \code{list_group}, see examples. +#' @param status Bootstrap status for contextual alternative. +#' +#' @return A UI definition. +#' @export +#' +#' @name bootstrap-utils +#' +#' @importFrom htmltools tags +#' +#' @example examples/panel.R +#' @example examples/alert.R +#' @example examples/list_group.R +panel <- function(..., + heading = NULL, footer = NULL, extra = NULL, + status = c("default", "primary", "success", "info", "warning", "danger")) { + status <- match.arg( + arg = status, + choices = c("default", "primary", "success", "info", "warning", "danger") + ) + if (...length() > 0) { + body <- tags$div(class = "panel-body", ...) + } else { + body <- NULL + } + if (!is.null(heading)) { + heading <- tags$div( + class = "panel-heading", + if (is.character(heading)) + tags$h3(class = "panel-title", heading) + else + heading + ) + } + tags$div( + class = paste0("panel panel-", status), + heading, body, extra, + if (!is.null(footer)) tags$div(class = "panel-footer", footer) + ) +} + + +#' @param dismissible Add the possiblity to close the alert. +#' @export +#' @rdname bootstrap-utils +#' @importFrom htmltools tags HTML +alert <- function(..., status = c("info", "success", "danger", "warning"), dismissible = FALSE) { + status <- match.arg(status) + tags$div( + class = paste0("alert alert-", status), + class = if (isTRUE(dismissible)) "alert-dismissible", + if (isTRUE(dismissible)) { + tags$button( + type = "button", + class = "close", + `data-dismiss` = "alert", + `aria-label` = "Close", + tags$span(`aria-hidden` = "true", HTML("×")) + ) + }, + ... + ) +} + + +#' @export +#' @rdname bootstrap-utils +#' @importFrom htmltools tags +list_group <- function(...) { + tags$ul( + class = "list-group", + lapply( + X = list(...), + FUN = function(x) { + # tags$li(class = "list-group-item", x) + do.call(tags$li, c(list(class = "list-group-item"), x)) + } + ) + ) +} + + + + + + + + + + diff --git a/R/panel.R b/R/panel.R deleted file mode 100644 index 57f8fd77..00000000 --- a/R/panel.R +++ /dev/null @@ -1,78 +0,0 @@ -#' @title Create a panel -#' -#' @description Create a panel (box) with basic border and padding, -#' you can use Bootstrap status to style the panel, -#' see \url{http://getbootstrap.com/components/#panels}. -#' -#' @param ... UI elements to include inside the panel. -#' @param heading Title for the panel in a plain header. -#' @param footer Footer for the panel. -#' @param status Bootstrap status for contextual alternative. -#' -#' @return A UI definition. -#' @export -#' -#' @importFrom htmltools tags -#' -#' @examples -#' if (interactive()) { -#' library("shiny") -#' library("shinyWidgets") -#' -#' ui <- fluidPage( -#' -#' # Default -#' panel( -#' "Content goes here", -#' checkboxInput(inputId = "id1", label = "Label") -#' ), -#' -#' # With header and footer -#' panel( -#' "Content goes here", -#' checkboxInput(inputId = "id2", label = "Label"), -#' heading = "My title", -#' footer = "Something" -#' ), -#' -#' # With status -#' panel( -#' "Content goes here", -#' checkboxInput(inputId = "id3", label = "Label"), -#' heading = "My title", -#' status = "primary" -#' ) -#' ) -#' -#' server <- function(input, output, session) { -#' -#' } -#' -#' shinyApp(ui = ui, server = server) -#' } -panel <- function(..., heading = NULL, footer = NULL, status = "default") { - status <- match.arg( - arg = status, - choices = c("default", "primary", "success", "info", "warning", "danger") - ) - if (!is.null(heading)) { - heading <- htmltools::tags$div( - class="panel-heading", - if (is.character(heading)) - htmltools::tags$h3(class="panel-title", heading) - else - heading - ) - } - htmltools::tags$div( - class=paste0("panel panel-", status), heading, - htmltools::tags$div(class="panel-body", ...), - if (!is.null(footer)) htmltools::tags$div(class="panel-footer", footer) - ) -} - - - - - - diff --git a/examples/alert.R b/examples/alert.R new file mode 100644 index 00000000..5d577213 --- /dev/null +++ b/examples/alert.R @@ -0,0 +1,47 @@ + +# Alerts --------------------------------- + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + tags$h2("Alerts"), + fluidRow( + column( + width = 6, + alert( + status = "success", + tags$b("Well done!"), "You successfully read this important alert message." + ), + alert( + status = "info", + tags$b("Heads up!"), "This alert needs your attention, but it's not super important." + ), + alert( + status = "info", + dismissible = TRUE, + tags$b("Dismissable"), "You can close this one." + ) + ), + column( + width = 6, + alert( + status = "warning", + tags$b("Warning!"), "Better check yourself, you're not looking too good." + ), + alert( + status = "danger", + tags$b("Oh snap!"), "Change a few things up and try submitting again." + ) + ) + ) +) + +server <- function(input, output, session) { + +} + +if (interactive()) + shinyApp(ui, server) + + diff --git a/examples/list_group.R b/examples/list_group.R new file mode 100644 index 00000000..01b048f4 --- /dev/null +++ b/examples/list_group.R @@ -0,0 +1,30 @@ + +# List group ----------------------------- + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + tags$h2("List group"), + + tags$b("List of item:"), + list_group( + "First item", + "Second item", + "And third item" + ), + + tags$b("Set active item:"), + list_group( + list(class = "active", "First item"), + "Second item", + "And third item" + ) +) + +server <- function(input, output, session) { + +} + +if (interactive()) + shinyApp(ui, server) diff --git a/examples/panel.R b/examples/panel.R new file mode 100644 index 00000000..a969476a --- /dev/null +++ b/examples/panel.R @@ -0,0 +1,60 @@ + +# Panels --------------------------------- + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + + tags$h2("Bootstrap panel"), + + # Default + panel( + "Content goes here", + ), + + # With header and footer + panel( + "Content goes here", + heading = "My title", + footer = "Something" + ), + + # With status + panel( + "Content goes here", + heading = "My title", + status = "primary" + ), + + # With table + panel( + heading = "A famous table", + extra = tableOutput(outputId = "table") + ), + + # With list group + panel( + heading = "A list of things", + extra = list_group( + "First item", + "Second item", + "And third item" + ) + ) +) + +server <- function(input, output, session) { + + output$table <- renderTable({ + head(mtcars) + }, width = "100%") + +} + +if (interactive()) + shinyApp(ui = ui, server = server) + + + + diff --git a/man/bootstrap-utils.Rd b/man/bootstrap-utils.Rd new file mode 100644 index 00000000..9947af4a --- /dev/null +++ b/man/bootstrap-utils.Rd @@ -0,0 +1,185 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bootstrap-utils.R +\name{bootstrap-utils} +\alias{bootstrap-utils} +\alias{panel} +\alias{alert} +\alias{list_group} +\title{Bootstrap panel / alert} +\usage{ +panel( + ..., + heading = NULL, + footer = NULL, + extra = NULL, + status = c("default", "primary", "success", "info", "warning", "danger") +) + +alert( + ..., + status = c("info", "success", "danger", "warning"), + dismissible = FALSE +) + +list_group(...) +} +\arguments{ +\item{...}{UI elements to include inside the panel or alert.} + +\item{heading}{Title for the panel in a plain header.} + +\item{footer}{Footer for the panel.} + +\item{extra}{Additional elements to include like a table or a \code{list_group}, see examples.} + +\item{status}{Bootstrap status for contextual alternative.} + +\item{dismissible}{Add the possiblity to close the alert.} +} +\value{ +A UI definition. +} +\description{ +Create a panel (box) with basic border and padding, +you can use Bootstrap status to style the panel, +see \url{http://getbootstrap.com/components/#panels}. +} +\examples{ + +# Panels --------------------------------- + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + + tags$h2("Bootstrap panel"), + + # Default + panel( + "Content goes here", + ), + + # With header and footer + panel( + "Content goes here", + heading = "My title", + footer = "Something" + ), + + # With status + panel( + "Content goes here", + heading = "My title", + status = "primary" + ), + + # With table + panel( + heading = "A famous table", + extra = tableOutput(outputId = "table") + ), + + # With list group + panel( + heading = "A list of things", + extra = list_group( + "First item", + "Second item", + "And third item" + ) + ) +) + +server <- function(input, output, session) { + + output$table <- renderTable({ + head(mtcars) + }, width = "100\%") + +} + +if (interactive()) + shinyApp(ui = ui, server = server) + + + + + +# Alerts --------------------------------- + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + tags$h2("Alerts"), + fluidRow( + column( + width = 6, + alert( + status = "success", + tags$b("Well done!"), "You successfully read this important alert message." + ), + alert( + status = "info", + tags$b("Heads up!"), "This alert needs your attention, but it's not super important." + ), + alert( + status = "info", + dismissible = TRUE, + tags$b("Dismissable"), "You can close this one." + ) + ), + column( + width = 6, + alert( + status = "warning", + tags$b("Warning!"), "Better check yourself, you're not looking too good." + ), + alert( + status = "danger", + tags$b("Oh snap!"), "Change a few things up and try submitting again." + ) + ) + ) +) + +server <- function(input, output, session) { + +} + +if (interactive()) + shinyApp(ui, server) + + + +# List group ----------------------------- + +library(shiny) +library(shinyWidgets) + +ui <- fluidPage( + tags$h2("List group"), + + tags$b("List of item:"), + list_group( + "First item", + "Second item", + "And third item" + ), + + tags$b("Set active item:"), + list_group( + list(class = "active", "First item"), + "Second item", + "And third item" + ) +) + +server <- function(input, output, session) { + +} + +if (interactive()) + shinyApp(ui, server) +} diff --git a/man/panel.Rd b/man/panel.Rd deleted file mode 100644 index 8462afc2..00000000 --- a/man/panel.Rd +++ /dev/null @@ -1,62 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/panel.R -\name{panel} -\alias{panel} -\title{Create a panel} -\usage{ -panel(..., heading = NULL, footer = NULL, status = "default") -} -\arguments{ -\item{...}{UI elements to include inside the panel.} - -\item{heading}{Title for the panel in a plain header.} - -\item{footer}{Footer for the panel.} - -\item{status}{Bootstrap status for contextual alternative.} -} -\value{ -A UI definition. -} -\description{ -Create a panel (box) with basic border and padding, -you can use Bootstrap status to style the panel, -see \url{http://getbootstrap.com/components/#panels}. -} -\examples{ -if (interactive()) { -library("shiny") -library("shinyWidgets") - -ui <- fluidPage( - - # Default - panel( - "Content goes here", - checkboxInput(inputId = "id1", label = "Label") - ), - - # With header and footer - panel( - "Content goes here", - checkboxInput(inputId = "id2", label = "Label"), - heading = "My title", - footer = "Something" - ), - - # With status - panel( - "Content goes here", - checkboxInput(inputId = "id3", label = "Label"), - heading = "My title", - status = "primary" - ) -) - -server <- function(input, output, session) { - -} - -shinyApp(ui = ui, server = server) -} -} diff --git a/tests/testthat/test-panel.R b/tests/testthat/test-panel.R index bab73923..250e36ef 100644 --- a/tests/testthat/test-panel.R +++ b/tests/testthat/test-panel.R @@ -21,8 +21,8 @@ test_that("With header and footer", { heading = "My title", footer = "Something" ) - expect_identical(tagp$children[[1]]$attribs$class, "panel-heading") - expect_identical(tagp$children[[3]]$attribs$class, "panel-footer") + expect_true(grepl(pattern = "panel-heading", x = as.character(tagp))) + expect_true(grepl(pattern = "panel-footer", x = as.character(tagp))) }) @@ -34,6 +34,5 @@ test_that("With status", { heading = "My title", status = "primary" ) - expect_identical(tagp$attribs$class, "panel panel-primary") - + expect_true(grepl(pattern = "panel panel-primary", x = as.character(tagp))) })