feat(build-a-box): Add example value box builder app

.github/workflows/R-CMD-check.yaml

@@ -40,10 +40,6 @@ jobs:
       - name: Install bslib from GitHub
         shell: Rscript {0}
         run: |
-          # rsconnect 1.0 introduced an issue with deploying from CI
-          # Once a proper fix is CRAN, we can go back install.packages
-          if (!require('remotes')) install.packages('remotes')
-          remotes::install_version("rsconnect", "0.8.29")
           pak::pkg_install("rstudio/bslib", dependencies = TRUE, upgrade = TRUE)
 
       # Workaround for this (probably spurious error):
@@ -58,18 +54,26 @@ jobs:
         run: |
           install.packages("cpp11")
 
-      - name: Register account
+      - name: Register account(s)
         shell: Rscript {0}
         run: |
           rsconnect::setAccountInfo(
             name   = '${{ secrets.SHINYAPPS_NAME }}',
             token  = '${{ secrets.SHINYAPPS_TOKEN }}',
             secret = '${{ secrets.SHINYAPPS_SECRET }}'
           )
+          rsconnect::setAccountInfo(
+            name   = 'bslib',
+            token  = '${{ secrets.SHINYAPPS_BSLIB_TOKEN }}',
+            secret = '${{ secrets.SHINYAPPS_BSLIB_SECRET }}'
+          )
 
       - name: Deploy
+        shell: bash
         run: |
-          Rscript 'inst/themer-demo/deploy.R'
-          Rscript 'inst/examples/card/deploy.R'
-          Rscript 'inst/examples/value_box/deploy.R'
-          Rscript 'inst/examples/flights/deploy.R'
+          deployScripts=$(find inst -name "deploy.R" -type f)
+
+          for deployScript in $deployScripts; do
+            echo "Deploying $deployScript"
+            Rscript $deployScript
+          done

DESCRIPTION

@@ -53,8 +53,10 @@ Suggests:
     testthat,
     thematic,
     withr
-Config/Needs/deploy: 
+Config/Needs/deploy:
     BH,
+    colourpicker,
+    commonmark,
     cpp11,
     dplyr,
     DT,
@@ -63,6 +65,7 @@ Config/Needs/deploy:
     gt,
     hexbin,
     histoslider,
+    htmlwidgets,
     lattice,
     leaflet,
     lubridate,
@@ -73,9 +76,11 @@ Config/Needs/deploy:
     reshape2,
     rprojroot,
     rsconnect,
-    scales
+    scales,
+    styler,
+    tibble
 Config/Needs/routine: chromote, desc, renv
-Config/Needs/website: 
+Config/Needs/website:
     brio,
     crosstalk,
     dplyr,

R/value-box.R

@@ -5,6 +5,17 @@
 #' `value` represents (for example, it could hold a [bsicons::bs_icon()], or
 #' even a [shiny::plotOutput()]).
 #'
+#' @section Build a Box App:
+#'
+#'   Explore all of the `value_box()` options and layouts interactively with the
+#'   [Build a Box app](https://bslib.shinyapps.io/build-a-box/), available
+#'   online thanks to [shinyapps.io](https://www.shinyapps.io/). Or, you can
+#'   run the app locally with:
+#'
+#'   ```r
+#'   shiny::runApp(system.file("examples", "build-a-box", package = "bslib"))
+#'   ```
+#'
 #' @section Themes:
 #'
 #'   ```{r child="man/fragments/value-box-themes.Rmd"}

inst/examples/build-a-box/R/code_modal.R

@@ -0,0 +1,34 @@
+code_modal <- function(code) {
+  if (rlang::is_call(code)) {
+    code <- rlang::expr_text(code)
+  }
+
+  if (requireNamespace("styler", quietly = TRUE)) {
+    code <- styler::style_text(code)
+  }
+
+  code <- paste(code, collapse = "\n")
+
+  showModal(
+    modalDialog(
+      HTML(sprintf(
+        '<pre><code id="value-box-code">%s</code></pre>',
+        code
+      )),
+      p(
+        id = "copy-clipboard-not-supported",
+        class = "text-muted d-none",
+        HTML("Press <kbd>Ctrl</kbd>/<kbd>Cmd</kbd> + <kbd>C</kbd> to copy the value box example code.")
+      ),
+      tags$button(
+        id = "copy-code-to-clipboard",
+        class = "btn btn-outline-primary",
+        onclick = "copyValueBoxCode()",
+        "Copy to clipboard"
+      ),
+      singleton(tags$script(src = "code-modal.js")),
+      footer = modalButton("Done"),
+      easyClose = TRUE
+    )
+  )
+}

inst/examples/build-a-box/R/colors.R

@@ -0,0 +1,37 @@
+theme_colors <- list(
+  "primary",
+  "secondary",
+  "success",
+  "danger",
+  "warning",
+  "info",
+  "light",
+  "dark"
+)
+
+named_colors <- c(
+  "blue",
+  "indigo",
+  "purple",
+  "pink",
+  "red",
+  "orange",
+  "yellow",
+  "green",
+  "teal",
+  "cyan"
+)
+
+gc <- expand.grid(named_colors, named_colors)
+gc <- gc[gc$Var1 != gc$Var2,]
+gradient_classes <- sprintf("bg-gradient-%s-%s", gc$Var1, gc$Var2)
+
+
+all_themes <- c(
+  "Default" = "",
+  theme_colors,
+  named_colors,
+  paste0("text-", theme_colors),
+  paste0("text-", named_colors),
+  sort(gradient_classes)
+)

inst/examples/build-a-box/R/mod-global-controls.R

@@ -0,0 +1,123 @@
+ui_global_controls <- function(id) {
+  ns <- shiny::NS(id)
+
+  tagList(
+    layout_columns(
+      class = "align-items-end",
+      selectizeInput(
+        ns("theme_style"),
+        "Theme style",
+        list(
+          "Default" = "default",
+          "All" = "all",
+          "Semantic Colors" = list(
+            "Semantic Background" = "semantic-bg",
+            "Semantic Text" = "semantic-fg"
+          ),
+          "Theme Colors" = list(
+            "Colored Background" = "colors-bg",
+            "Colored Text" = "colors-fg"
+          ),
+          "Vibrant" = list(
+            "Gradient Background" = "gradient"
+          )
+        )
+      ),
+      shuffleButton(ns("random_theme"), "Theme"),
+      shuffleButton(ns("random_stat"), "Stats")
+    ),
+    layout_columns(
+      class = "align-items-start",
+      div(
+        radioButtons(
+          ns("showcase_item"),
+          "Showcase Item",
+          choices = c("Plot", "Icon"),
+          inline = TRUE
+        ),
+        conditionalPanel(
+          "input.showcase_item == 'Plot'",
+          ns = ns,
+          p(
+            class = "text-muted",
+            "See",
+            tags$a(href = "https://rstudio.github.io/bslib/articles/value-boxes/index.html#expandable-sparklines", "Expandable Sparklines"),
+            "for example plot code."
+          )
+        ),
+        conditionalPanel(
+          "input.showcase_item == 'Icon'",
+          ns = ns,
+          shuffleButton(ns("random_icon"), "Icons")
+        )
+      ),
+      radioButtons(
+        ns("showcase_layout"),
+        "Showcase Layout",
+        choices = c("Left center", "Top right", "Bottom"),
+        inline = TRUE
+      )
+    )
+  )
+}
+
+server_global_controls <- function(input, output, sessions, one, two, three) {
+  observeEvent(c(input$random_theme, input$theme_style), {
+    new_values <- switch(
+      input$theme_style,
+      all = {
+        one$theme$shuffle()
+        two$theme$shuffle()
+        three$theme$shuffle()
+        NULL
+      },
+      default = {
+        one$theme$set("Default")
+        two$theme$set("Default")
+        three$theme$set("Default")
+        NULL
+      },
+      "semantic-bg" = sample(setdiff(theme_colors, c("light", "dark")), 3),
+      "semantic-fg" = paste0("text-", sample(setdiff(theme_colors, c("light", "dark")), 3)),
+      "colors-bg" = sample(named_colors, 3, replace = TRUE),
+      "colors-fg" = paste0("text-", sample(named_colors, 3, replace = TRUE)),
+      gradient = sample(gradient_classes, 3)
+    )
+
+    if (is.null(new_values)) return()
+
+    one$theme$set(new_values[[1]])
+    two$theme$set(new_values[[2]])
+    three$theme$set(new_values[[3]])
+  }, ignoreInit = TRUE)
+
+  observeEvent(input$random_stat, {
+    one$random_stat()
+    two$random_stat()
+    three$random_stat()
+  })
+
+  observeEvent(input$random_icon, {
+    one$showcase_icon$shuffle()
+    two$showcase_icon$shuffle()
+    three$showcase_icon$shuffle()
+  })
+
+  observeEvent(input$showcase_item, {
+    item <- tolower(input$showcase_item)
+    one$set_showcase_item(item)
+    two$set_showcase_item(item)
+    three$set_showcase_item(item)
+  }, ignoreInit = TRUE)
+
+  observeEvent(input$showcase_layout, {
+    layout <- tolower(input$showcase_layout)
+    one$set_showcase_layout(layout)
+    two$set_showcase_layout(layout)
+    three$set_showcase_layout(layout)
+  }, ignoreInit = TRUE)
+}
+
+module_global_controls <- function(id, one, two, three) {
+  callModule(server_global_controls, id, one = one, two = two, three = three)
+}