Announcing shiny.webawesome: a web UI package for R/Shiny
NoteTL;DR
shiny.webawesome brings Web Awesome to R Shiny through generated wrappers, reactive bindings, and a bundled runtime. It aims for complete component support while staying close enough to upstream that the Web Awesome docs and examples are directly useful in everyday package use.
Background
shiny.webawesome started from a perceived gap: Shiny would benefit from a UI library that feels modern, visually polished, and broad enough to support a full app coherently. Web Awesome was a strong fit because it combines rich components, layout and styling utilities, and detailed upstream documentation with a standards-based web-components structure that is straightforward to track from R. That makes it easier for the package to stay close to upstream while still fitting naturally into Shiny.
The Whole Game
Here’s a simple, complete example app, rendered via Shinylive.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 810
# Store this file as app.R next to app.css and app.js.
library(shiny)
library(shiny.webawesome)
library(htmltools)
library(ggplot2)
`%||%` <- function(x, y) {
if (is.null(x)) y else x
}
species_choices <- c(
"All species" = "all",
"Setosa" = "setosa",
"Versicolor" = "versicolor",
"Virginica" = "virginica"
)
variable_choices <- c(
"Sepal length" = "Sepal.Length",
"Sepal width" = "Sepal.Width",
"Petal length" = "Petal.Length",
"Petal width" = "Petal.Width"
)
select_choices <- function(id, label, value, choices) {
do.call(
wa_select,
c(
list(id, label = label, value = value),
lapply(names(choices), function(name) {
wa_option(name, value = choices[[name]])
})
)
)
}
stat_card <- function(label, output_id) {
wa_container(
class = "stat-card",
wa_container(
class = "wa-stack wa-gap-3xs",
style = "padding: 0;",
span(class = "stat-label", label),
span(class = "stat-value", textOutput(output_id, inline = TRUE))
)
)
}
show_shinylive_badge <- TRUE
css_text <- "/* Store this file next to app.R as app.css. */\n\nbody {\n margin: 0;\n background: var(--wa-color-surface-default);\n color: var(--wa-color-text-normal, #1f2937);\n font-family: var(--wa-font-family-body, 'Segoe UI', sans-serif);\n}\n\n.workbench-shell {\n padding: 14px;\n background:\n radial-gradient(circle at top left, color-mix(in srgb, var(--wa-color-brand-fill-loud) 16%, transparent), transparent 28%),\n linear-gradient(180deg, color-mix(in srgb, var(--wa-color-surface-default) 90%, white), var(--wa-color-surface-default));\n}\n\n.workbench-stage {\n width: min(1080px, 100%);\n margin: 0 auto;\n display: grid;\n gap: 12px;\n}\n\n.workbench-kicker {\n color: color-mix(in srgb, var(--wa-color-text-normal, #1f2937) 72%, white);\n font-size: 0.88rem;\n font-weight: 700;\n}\n\n.workbench-layout {\n display: grid;\n grid-template-columns: 280px minmax(0, 1fr);\n gap: 12px;\n align-items: stretch;\n}\n\n.title-card,\n.sidebar-card,\n.preview-card,\n.stat-card {\n --wa-panel-border-radius: 22px;\n border: 1px solid color-mix(in srgb, var(--wa-color-surface-border) 80%, white);\n box-shadow: 0 18px 48px rgba(15, 23, 42, 0.08);\n}\n\n.title-card,\n.preview-card {\n background: color-mix(in srgb, var(--wa-color-surface-default) 92%, white);\n}\n\n.preview-card {\n height: 100%;\n}\n\n.sidebar-card {\n background: color-mix(in srgb, var(--wa-color-neutral-fill-normal) 12%, white);\n position: sticky;\n top: 0;\n height: 100%;\n}\n\n.title-stack,\n.sidebar-stack,\n.preview-stack,\n.stats-grid,\n.tab-stack {\n display: grid;\n gap: 10px;\n}\n\n.title-line {\n margin: 0;\n font-size: 1.95rem;\n line-height: 1;\n letter-spacing: -0.03em;\n}\n\n.title-copy,\n.sidebar-note,\n.tab-copy,\n.details-copy {\n margin: 0;\n line-height: 1.45;\n}\n\n.preset-group {\n display: grid;\n gap: 0.55rem;\n}\n\n.stats-grid {\n grid-template-columns: repeat(3, minmax(110px, 150px));\n gap: 8px;\n align-items: start;\n}\n\n.stat-card {\n background: color-mix(in srgb, var(--wa-color-brand-fill-loud) 4%, white);\n box-shadow: none;\n border-radius: 18px;\n padding: 0.62rem 0.85rem;\n}\n\n.stat-label {\n color: color-mix(in srgb, var(--wa-color-text-normal, #1f2937) 60%, white);\n font-size: 0.68rem;\n text-transform: uppercase;\n font-weight: 800;\n letter-spacing: 0.08em;\n}\n\n.stat-value {\n font-size: 1rem;\n font-weight: 800;\n line-height: 1.1;\n}\n\n.preview-header {\n display: flex;\n flex-wrap: wrap;\n justify-content: space-between;\n gap: 10px;\n align-items: center;\n}\n\n.plot-shell,\n.table-shell {\n border-radius: 18px;\n background: color-mix(in srgb, var(--wa-color-surface-default) 96%, white);\n border: 1px solid color-mix(in srgb, var(--wa-color-surface-border) 80%, white);\n padding: 7px 9px;\n}\n\n.table-shell table {\n width: 100%;\n border-collapse: collapse;\n font-size: 0.92rem;\n}\n\n.table-shell th,\n.table-shell td {\n padding: 8px 10px;\n border-bottom: 1px solid color-mix(in srgb, var(--wa-color-surface-border) 70%, white);\n text-align: left;\n}\n\n.table-shell th:last-child,\n.table-shell td:last-child {\n text-align: right;\n}\n\n.table-shell th {\n font-size: 0.76rem;\n text-transform: uppercase;\n letter-spacing: 0.08em;\n color: color-mix(in srgb, var(--wa-color-text-normal, #1f2937) 58%, white);\n}\n\n.tab-shell {\n min-height: 330px;\n}\n\n.preset-label {\n margin: 0;\n text-transform: uppercase;\n letter-spacing: 0.08em;\n}\n\n.preset-radios {\n width: 100%;\n}\n\n.preset-radios::part(form-control-input) {\n gap: 1rem;\n}\n\n.preset-radios wa-radio {\n margin-right: 1rem;\n}\n\n@media (max-width: 860px) {\n .workbench-layout,\n .stats-grid {\n grid-template-columns: 1fr;\n }\n\n .sidebar-card {\n position: static;\n }\n}"
js_text <- "// Store this file next to app.R as app.js.\n\n(function() {\n function syncWorkbenchControls() {\n const tabs = document.getElementById('surface_tabs');\n const trend = document.getElementById('show_smoother');\n\n if (!tabs || !trend) {\n return;\n }\n\n trend.disabled = tabs.active !== 'chart';\n }\n\n function bindWorkbenchControls() {\n const tabs = document.getElementById('surface_tabs');\n\n if (!tabs || tabs.dataset.workbenchControlsBound) {\n syncWorkbenchControls();\n return;\n }\n\n tabs.dataset.workbenchControlsBound = 'true';\n tabs.addEventListener('wa-tab-show', syncWorkbenchControls);\n syncWorkbenchControls();\n }\n\n document.addEventListener('shiny:connected', function() {\n setTimeout(bindWorkbenchControls, 0);\n }, { once: true });\n\n setTimeout(bindWorkbenchControls, 0);\n})();"
show_shinylive_badge <- isTRUE(get0("show_shinylive_badge", ifnotfound = FALSE))
# Build the demo UI.
ui <- webawesomePage(
title = "Iris Workbench",
tags$style(HTML(css_text)),
wa_js(js_text),
# The drawer acts like a lightweight inspector for the current app state.
wa_drawer(
"help_drawer",
label = "Inspector",
placement = "end",
light_dismiss = FALSE,
wa_container(
class = "wa-stack wa-gap-m",
wa_callout(
variant = "brand",
appearance = "outlined",
icon = wa_icon(name = "circle-info"),
"This example keeps the controls visible and lets each tab react immediately."
),
wa_card(
header = "Current view",
wa_container(class = "wa-stack wa-gap-s", uiOutput("inspector_state"))
),
wa_card(
header = "What this demo shows",
wa_container(
class = "wa-stack wa-gap-s",
p(class = "details-copy", "One control rail drives three presentations of the same filtered state: chart, summary, and explanatory details.")
)
),
wa_card(
header = "shiny.webawesome facilities",
wa_container(
class = "wa-stack wa-gap-s",
tags$ul(
class = "details-copy",
style = "margin: 0; padding-left: 1.1rem;",
tags$li("Polished presentation elements with one coherent theme."),
tags$li("Built-in layout tools for compact app structure."),
tags$li("Shiny bindings for Web Awesome form and navigation components."),
tags$li("Package command helpers for browser-side property and method control.")
)
)
)
)
),
wa_container(
class = "workbench-shell",
wa_container(
class = "workbench-stage",
# This utility row is only shown in the live article embed.
if (show_shinylive_badge) {
wa_container(
class = "workbench-kicker wa-cluster wa-gap-xs wa-align-items-center",
wa_badge("Live in the browser", appearance = "accent"),
span("Powered by Shinylive: A compact iris workbench")
)
},
wa_card(
class = "title-card",
wa_container(
class = "title-stack",
h2(class = "title-line", "Polished analytics with shiny.webawesome"),
p(
class = "title-copy",
"Use the left rail to change the view. The chart, summary table, and details tab all respond."
)
)
),
wa_container(
class = "workbench-layout",
# Left rail for filters and small app actions.
wa_card(
class = "sidebar-card",
header = "Controls",
wa_container(
class = "sidebar-stack",
select_choices("species", "Species", "all", species_choices),
select_choices("x_var", "X variable", "Sepal.Length", variable_choices),
select_choices("y_var", "Y variable", "Sepal.Width", variable_choices),
wa_switch("show_smoother", "Show trend line"),
uiOutput("preset_controls"),
wa_button(
"open_help",
"Open inspector",
appearance = "accent",
`data-drawer` = "open help_drawer"
),
p(class = "sidebar-note wa-body-s wa-color-text-quiet", textOutput("sidebar_note"))
)
),
# Main stage for summary badges, tabs, and the live outputs.
wa_card(
class = "preview-card",
wa_container(
class = "preview-stack",
wa_container(
class = "preview-header",
wa_container(
class = "wa-cluster wa-gap-xs wa-align-items-center",
uiOutput("selection_badges")
),
wa_badge(textOutput("tab_badge", inline = TRUE), appearance = "filled")
),
wa_container(
class = "stats-grid",
stat_card("Rows", "row_count"),
stat_card("Correlation", "correlation_value"),
stat_card("Focus", "focus_value")
),
wa_tab_group(
class = "workbench-tab-group",
"surface_tabs",
active = "chart",
wa_tab("Chart", panel = "chart"),
wa_tab("Summary", panel = "summary"),
wa_tab("Details", panel = "details"),
wa_tab_panel(
name = "chart",
wa_container(
class = "tab-stack tab-shell",
p(
class = "tab-copy wa-body-s wa-color-text-quiet",
"Change a variable or species on the left and the plot responds immediately."
),
wa_container(
class = "plot-shell",
plotOutput("iris_plot", height = "245px")
)
)
),
wa_tab_panel(
name = "summary",
wa_container(
class = "tab-stack tab-shell",
p(
class = "tab-copy wa-body-s wa-color-text-quiet",
"The summary tab turns the same filtered data into a compact numeric view."
),
wa_select(
"focus_metric",
label = "Summary focus",
value = "mean",
wa_option("Mean", value = "mean"),
wa_option("Median", value = "median"),
wa_option("Maximum", value = "max")
),
wa_container(
class = "table-shell",
tableOutput("summary_table")
)
)
),
wa_tab_panel(
name = "details",
wa_container(
class = "tab-stack tab-shell",
p(
class = "tab-copy wa-body-s wa-color-text-quiet",
"The details tab uses expandable sections that explain the views."
),
wa_details(
"story_details",
summary = "What this view is showing",
open = TRUE,
p(class = "details-copy wa-body-s wa-color-text-quiet", textOutput("details_text"))
),
wa_details(
"change_details",
summary = "Settings",
p(class = "details-copy wa-body-s wa-color-text-quiet", textOutput("filters_text"))
)
)
)
)
)
)
)
)
)
)
# Server logic keeps the plot, summaries, details, and inspector in sync.
server <- function(input, output, session) {
current_x_var <- reactive(input$x_var %||% "Sepal.Length")
current_y_var <- reactive(input$y_var %||% "Sepal.Width")
trend_enabled <- reactiveVal(FALSE)
species_label <- reactive({
species <- input$species %||% "all"
if (species == "all") "All species" else tools::toTitleCase(species)
})
current_preset <- reactive({
x_var <- current_x_var()
y_var <- current_y_var()
if (identical(x_var, "Sepal.Length") && identical(y_var, "Sepal.Width")) {
"sepal"
} else if (identical(x_var, "Petal.Length") && identical(y_var, "Petal.Width")) {
"petal"
} else {
NULL
}
})
filtered_data <- reactive({
if (is.null(input$species) || input$species == "all") {
iris
} else {
iris[tolower(iris$Species) == input$species, , drop = FALSE]
}
})
output$preset_controls <- renderUI({
wa_container(
class = "preset-group",
p(class = "preset-label wa-form-control-label wa-font-size-s", "Presets"),
wa_radio_group(
"preset_mode",
class = "preset-radios",
orientation = "horizontal",
value = current_preset(),
wa_radio("Sepal", value = "sepal"),
wa_radio("Petal", value = "petal")
)
)
})
observeEvent(input$preset_mode, ignoreNULL = TRUE, ignoreInit = TRUE, {
if ((input$preset_mode %||% "sepal") == "sepal") {
update_wa_select(session, "x_var", value = "Sepal.Length")
update_wa_select(session, "y_var", value = "Sepal.Width")
} else {
update_wa_select(session, "x_var", value = "Petal.Length")
update_wa_select(session, "y_var", value = "Petal.Width")
}
})
observeEvent(input$show_smoother, ignoreInit = TRUE, {
trend_enabled(input$show_smoother)
})
# The badges mirror the current filter and variable choices.
output$selection_badges <- renderUI({
tagList(
wa_badge(species_label(), appearance = "filled"),
wa_badge(
sprintf("%s vs %s", current_x_var(), current_y_var()),
appearance = "filled"
)
)
})
output$tab_badge <- renderText({
tools::toTitleCase(input$surface_tabs %||% "chart")
})
output$row_count <- renderText(nrow(filtered_data()))
output$correlation_value <- renderText({
data <- filtered_data()
x_var <- current_x_var()
y_var <- current_y_var()
sprintf("%.2f", cor(data[[x_var]], data[[y_var]]))
})
output$focus_value <- renderText({
active_tab <- input$surface_tabs %||% "chart"
if (active_tab == "summary") {
tools::toTitleCase(input$focus_metric %||% "mean")
} else if (active_tab == "details") {
"Details"
} else {
if (isTRUE(trend_enabled())) "Trend on" else "Trend off"
}
})
output$sidebar_note <- renderText({
active_tab <- input$surface_tabs %||% "chart"
if (active_tab == "chart") {
"Preset buttons jump between sepal and petal views."
} else if (active_tab == "summary") {
"Summary focus changes the statistic."
} else {
"Details are tied to the current views and filter state."
}
})
output$iris_plot <- renderPlot({
data <- filtered_data()
x_var <- current_x_var()
y_var <- current_y_var()
palette <- c(setosa = "#2563eb", versicolor = "#ea580c", virginica = "#059669")
p <- ggplot(
data,
aes(x = .data[[x_var]], y = .data[[y_var]], color = Species)
) +
geom_point(size = 2.2, alpha = 0.82) +
scale_color_manual(values = palette) +
labs(x = x_var, y = y_var, color = NULL) +
theme_minimal(base_size = 12) +
theme(
legend.position = "top",
legend.justification = "left",
panel.grid.minor = element_blank(),
panel.grid.major = element_line(color = "#e2e8f0"),
axis.title = element_text(color = "#0f172a"),
axis.text = element_text(color = "#334155")
)
if (isTRUE(trend_enabled()) && nrow(data) > 1) {
p <- p + geom_smooth(
method = "lm",
se = FALSE,
color = "#1d4ed8",
linewidth = 0.9
)
}
p
})
output$summary_table <- renderTable({
data <- filtered_data()
focus <- input$focus_metric %||% "mean"
x_var <- current_x_var()
y_var <- current_y_var()
stat_fn <- switch(focus, mean = mean, median = median, max = max)
summary_df <- data.frame(
measure = c(x_var, y_var),
value = c(round(stat_fn(data[[x_var]]), 2), round(stat_fn(data[[y_var]]), 2)),
stringsAsFactors = FALSE
)
names(summary_df) <- c("Measure", tools::toTitleCase(focus))
summary_df
}, striped = TRUE, bordered = FALSE, width = "100%", rownames = FALSE)
# The details tab turns the current state into plain-language explanation.
output$details_text <- renderText({
x_var <- current_x_var()
y_var <- current_y_var()
data <- filtered_data()
paste("The current view compares", x_var, "against", y_var, "for", nrow(data), "rows.")
})
output$filters_text <- renderText({
paste(
"Species filter:", species_label(), ".",
"X variable:", current_x_var(), ".",
"Y variable:", current_y_var(), ".",
if (isTRUE(trend_enabled())) "Trend line: on." else "Trend line: off."
)
})
output$inspector_state <- renderUI({
wa_container(
class = "wa-stack wa-gap-s",
wa_badge(paste("Tab:", tools::toTitleCase(input$surface_tabs %||% "chart")), appearance = "filled"),
wa_badge(paste("Species:", species_label()), appearance = "filled"),
wa_badge(paste("X:", current_x_var()), appearance = "filled"),
wa_badge(paste("Y:", current_y_var()), appearance = "filled")
)
})
outputOptions(output, "summary_table", suspendWhenHidden = FALSE)
outputOptions(output, "details_text", suspendWhenHidden = FALSE)
outputOptions(output, "filters_text", suspendWhenHidden = FALSE)
outputOptions(output, "inspector_state", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)The code for the above example is shown below.
This example showcases many of the facilities available in the package:
- a visually rich component library
- direct use of Web Awesome layout utilities such as
wa-stack,wa-cluster,wa-gap-*, andwa-align-*classes - styling through Web Awesome design tokens and classes such as
--wa-color-*,--wa-font-*, andwa-body-* - reactive Shiny input bindings
- helpers for calling methods on HTML elements, setting properties, and injecting simple JavaScript snippets
# Store this file as app.R next to app.css and app.js.
library(shiny)
library(shiny.webawesome)
library(htmltools)
library(ggplot2)
`%||%` <- function(x, y) {
if (is.null(x)) y else x
}
species_choices <- c(
"All species" = "all",
"Setosa" = "setosa",
"Versicolor" = "versicolor",
"Virginica" = "virginica"
)
variable_choices <- c(
"Sepal length" = "Sepal.Length",
"Sepal width" = "Sepal.Width",
"Petal length" = "Petal.Length",
"Petal width" = "Petal.Width"
)
select_choices <- function(id, label, value, choices) {
do.call(
wa_select,
c(
list(id, label = label, value = value),
lapply(names(choices), function(name) {
wa_option(name, value = choices[[name]])
})
)
)
}
stat_card <- function(label, output_id) {
wa_container(
class = "stat-card",
wa_container(
class = "wa-stack wa-gap-3xs",
style = "padding: 0;",
span(class = "stat-label", label),
span(class = "stat-value", textOutput(output_id, inline = TRUE))
)
)
}
if (!exists("css_text", inherits = FALSE) || !exists("js_text", inherits = FALSE)) {
app_dir <- tryCatch(
dirname(normalizePath(sys.frame(1)$ofile)),
error = function(e) getwd()
)
css_text <- paste(readLines(file.path(app_dir, "app.css"), warn = FALSE), collapse = "\n")
js_text <- paste(readLines(file.path(app_dir, "app.js"), warn = FALSE), collapse = "\n")
}
show_shinylive_badge <- isTRUE(get0("show_shinylive_badge", ifnotfound = FALSE))
# Build the demo UI.
ui <- webawesomePage(
title = "Iris Workbench",
tags$style(HTML(css_text)),
wa_js(js_text),
# The drawer acts like a lightweight inspector for the current app state.
wa_drawer(
"help_drawer",
label = "Inspector",
placement = "end",
light_dismiss = FALSE,
wa_container(
class = "wa-stack wa-gap-m",
wa_callout(
variant = "brand",
appearance = "outlined",
icon = wa_icon(name = "circle-info"),
"This example keeps the controls visible and lets each tab react immediately."
),
wa_card(
header = "Current view",
wa_container(class = "wa-stack wa-gap-s", uiOutput("inspector_state"))
),
wa_card(
header = "What this demo shows",
wa_container(
class = "wa-stack wa-gap-s",
p(class = "details-copy", "One control rail drives three presentations of the same filtered state: chart, summary, and explanatory details.")
)
),
wa_card(
header = "shiny.webawesome facilities",
wa_container(
class = "wa-stack wa-gap-s",
tags$ul(
class = "details-copy",
style = "margin: 0; padding-left: 1.1rem;",
tags$li("Polished presentation elements with one coherent theme."),
tags$li("Built-in layout tools for compact app structure."),
tags$li("Shiny bindings for Web Awesome form and navigation components."),
tags$li("Package command helpers for browser-side property and method control.")
)
)
)
)
),
wa_container(
class = "workbench-shell",
wa_container(
class = "workbench-stage",
# This utility row is only shown in the live article embed.
if (show_shinylive_badge) {
wa_container(
class = "workbench-kicker wa-cluster wa-gap-xs wa-align-items-center",
wa_badge("Live in the browser", appearance = "accent"),
span("Powered by Shinylive: A compact iris workbench")
)
},
wa_card(
class = "title-card",
wa_container(
class = "title-stack",
h2(class = "title-line", "Polished analytics with shiny.webawesome"),
p(
class = "title-copy",
"Use the left rail to change the view. The chart, summary table, and details tab all respond."
)
)
),
wa_container(
class = "workbench-layout",
# Left rail for filters and small app actions.
wa_card(
class = "sidebar-card",
header = "Controls",
wa_container(
class = "sidebar-stack",
select_choices("species", "Species", "all", species_choices),
select_choices("x_var", "X variable", "Sepal.Length", variable_choices),
select_choices("y_var", "Y variable", "Sepal.Width", variable_choices),
wa_switch("show_smoother", "Show trend line"),
uiOutput("preset_controls"),
wa_button(
"open_help",
"Open inspector",
appearance = "accent",
`data-drawer` = "open help_drawer"
),
p(class = "sidebar-note wa-body-s wa-color-text-quiet", textOutput("sidebar_note"))
)
),
# Main stage for summary badges, tabs, and the live outputs.
wa_card(
class = "preview-card",
wa_container(
class = "preview-stack",
wa_container(
class = "preview-header",
wa_container(
class = "wa-cluster wa-gap-xs wa-align-items-center",
uiOutput("selection_badges")
),
wa_badge(textOutput("tab_badge", inline = TRUE), appearance = "filled")
),
wa_container(
class = "stats-grid",
stat_card("Rows", "row_count"),
stat_card("Correlation", "correlation_value"),
stat_card("Focus", "focus_value")
),
wa_tab_group(
class = "workbench-tab-group",
"surface_tabs",
active = "chart",
wa_tab("Chart", panel = "chart"),
wa_tab("Summary", panel = "summary"),
wa_tab("Details", panel = "details"),
wa_tab_panel(
name = "chart",
wa_container(
class = "tab-stack tab-shell",
p(
class = "tab-copy wa-body-s wa-color-text-quiet",
"Change a variable or species on the left and the plot responds immediately."
),
wa_container(
class = "plot-shell",
plotOutput("iris_plot", height = "245px")
)
)
),
wa_tab_panel(
name = "summary",
wa_container(
class = "tab-stack tab-shell",
p(
class = "tab-copy wa-body-s wa-color-text-quiet",
"The summary tab turns the same filtered data into a compact numeric view."
),
wa_select(
"focus_metric",
label = "Summary focus",
value = "mean",
wa_option("Mean", value = "mean"),
wa_option("Median", value = "median"),
wa_option("Maximum", value = "max")
),
wa_container(
class = "table-shell",
tableOutput("summary_table")
)
)
),
wa_tab_panel(
name = "details",
wa_container(
class = "tab-stack tab-shell",
p(
class = "tab-copy wa-body-s wa-color-text-quiet",
"The details tab uses expandable sections that explain the views."
),
wa_details(
"story_details",
summary = "What this view is showing",
open = TRUE,
p(class = "details-copy wa-body-s wa-color-text-quiet", textOutput("details_text"))
),
wa_details(
"change_details",
summary = "Settings",
p(class = "details-copy wa-body-s wa-color-text-quiet", textOutput("filters_text"))
)
)
)
)
)
)
)
)
)
)
# Server logic keeps the plot, summaries, details, and inspector in sync.
server <- function(input, output, session) {
current_x_var <- reactive(input$x_var %||% "Sepal.Length")
current_y_var <- reactive(input$y_var %||% "Sepal.Width")
trend_enabled <- reactiveVal(FALSE)
species_label <- reactive({
species <- input$species %||% "all"
if (species == "all") "All species" else tools::toTitleCase(species)
})
current_preset <- reactive({
x_var <- current_x_var()
y_var <- current_y_var()
if (identical(x_var, "Sepal.Length") && identical(y_var, "Sepal.Width")) {
"sepal"
} else if (identical(x_var, "Petal.Length") && identical(y_var, "Petal.Width")) {
"petal"
} else {
NULL
}
})
filtered_data <- reactive({
if (is.null(input$species) || input$species == "all") {
iris
} else {
iris[tolower(iris$Species) == input$species, , drop = FALSE]
}
})
output$preset_controls <- renderUI({
wa_container(
class = "preset-group",
p(class = "preset-label wa-form-control-label wa-font-size-s", "Presets"),
wa_radio_group(
"preset_mode",
class = "preset-radios",
orientation = "horizontal",
value = current_preset(),
wa_radio("Sepal", value = "sepal"),
wa_radio("Petal", value = "petal")
)
)
})
observeEvent(input$preset_mode, ignoreNULL = TRUE, ignoreInit = TRUE, {
if ((input$preset_mode %||% "sepal") == "sepal") {
update_wa_select(session, "x_var", value = "Sepal.Length")
update_wa_select(session, "y_var", value = "Sepal.Width")
} else {
update_wa_select(session, "x_var", value = "Petal.Length")
update_wa_select(session, "y_var", value = "Petal.Width")
}
})
observeEvent(input$show_smoother, ignoreInit = TRUE, {
trend_enabled(input$show_smoother)
})
# The badges mirror the current filter and variable choices.
output$selection_badges <- renderUI({
tagList(
wa_badge(species_label(), appearance = "filled"),
wa_badge(
sprintf("%s vs %s", current_x_var(), current_y_var()),
appearance = "filled"
)
)
})
output$tab_badge <- renderText({
tools::toTitleCase(input$surface_tabs %||% "chart")
})
output$row_count <- renderText(nrow(filtered_data()))
output$correlation_value <- renderText({
data <- filtered_data()
x_var <- current_x_var()
y_var <- current_y_var()
sprintf("%.2f", cor(data[[x_var]], data[[y_var]]))
})
output$focus_value <- renderText({
active_tab <- input$surface_tabs %||% "chart"
if (active_tab == "summary") {
tools::toTitleCase(input$focus_metric %||% "mean")
} else if (active_tab == "details") {
"Details"
} else {
if (isTRUE(trend_enabled())) "Trend on" else "Trend off"
}
})
output$sidebar_note <- renderText({
active_tab <- input$surface_tabs %||% "chart"
if (active_tab == "chart") {
"Preset buttons jump between sepal and petal views."
} else if (active_tab == "summary") {
"Summary focus changes the statistic."
} else {
"Details are tied to the current views and filter state."
}
})
output$iris_plot <- renderPlot({
data <- filtered_data()
x_var <- current_x_var()
y_var <- current_y_var()
palette <- c(setosa = "#2563eb", versicolor = "#ea580c", virginica = "#059669")
p <- ggplot(
data,
aes(x = .data[[x_var]], y = .data[[y_var]], color = Species)
) +
geom_point(size = 2.2, alpha = 0.82) +
scale_color_manual(values = palette) +
labs(x = x_var, y = y_var, color = NULL) +
theme_minimal(base_size = 12) +
theme(
legend.position = "top",
legend.justification = "left",
panel.grid.minor = element_blank(),
panel.grid.major = element_line(color = "#e2e8f0"),
axis.title = element_text(color = "#0f172a"),
axis.text = element_text(color = "#334155")
)
if (isTRUE(trend_enabled()) && nrow(data) > 1) {
p <- p + geom_smooth(
method = "lm",
se = FALSE,
color = "#1d4ed8",
linewidth = 0.9
)
}
p
})
output$summary_table <- renderTable({
data <- filtered_data()
focus <- input$focus_metric %||% "mean"
x_var <- current_x_var()
y_var <- current_y_var()
stat_fn <- switch(focus, mean = mean, median = median, max = max)
summary_df <- data.frame(
measure = c(x_var, y_var),
value = c(round(stat_fn(data[[x_var]]), 2), round(stat_fn(data[[y_var]]), 2)),
stringsAsFactors = FALSE
)
names(summary_df) <- c("Measure", tools::toTitleCase(focus))
summary_df
}, striped = TRUE, bordered = FALSE, width = "100%", rownames = FALSE)
# The details tab turns the current state into plain-language explanation.
output$details_text <- renderText({
x_var <- current_x_var()
y_var <- current_y_var()
data <- filtered_data()
paste("The current view compares", x_var, "against", y_var, "for", nrow(data), "rows.")
})
output$filters_text <- renderText({
paste(
"Species filter:", species_label(), ".",
"X variable:", current_x_var(), ".",
"Y variable:", current_y_var(), ".",
if (isTRUE(trend_enabled())) "Trend line: on." else "Trend line: off."
)
})
output$inspector_state <- renderUI({
wa_container(
class = "wa-stack wa-gap-s",
wa_badge(paste("Tab:", tools::toTitleCase(input$surface_tabs %||% "chart")), appearance = "filled"),
wa_badge(paste("Species:", species_label()), appearance = "filled"),
wa_badge(paste("X:", current_x_var()), appearance = "filled"),
wa_badge(paste("Y:", current_y_var()), appearance = "filled")
)
})
outputOptions(output, "summary_table", suspendWhenHidden = FALSE)
outputOptions(output, "details_text", suspendWhenHidden = FALSE)
outputOptions(output, "filters_text", suspendWhenHidden = FALSE)
outputOptions(output, "inspector_state", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)/* Store this file next to app.R as app.css. */
body {
margin: 0;
background: var(--wa-color-surface-default);
color: var(--wa-color-text-normal, #1f2937);
font-family: var(--wa-font-family-body, 'Segoe UI', sans-serif);
}
.workbench-shell {
padding: 14px;
background:
radial-gradient(circle at top left, color-mix(in srgb, var(--wa-color-brand-fill-loud) 16%, transparent), transparent 28%),
linear-gradient(180deg, color-mix(in srgb, var(--wa-color-surface-default) 90%, white), var(--wa-color-surface-default));
}
.workbench-stage {
width: min(1080px, 100%);
margin: 0 auto;
display: grid;
gap: 12px;
}
.workbench-kicker {
color: color-mix(in srgb, var(--wa-color-text-normal, #1f2937) 72%, white);
font-size: 0.88rem;
font-weight: 700;
}
.workbench-layout {
display: grid;
grid-template-columns: 280px minmax(0, 1fr);
gap: 12px;
align-items: stretch;
}
.title-card,
.sidebar-card,
.preview-card,
.stat-card {
--wa-panel-border-radius: 22px;
border: 1px solid color-mix(in srgb, var(--wa-color-surface-border) 80%, white);
box-shadow: 0 18px 48px rgba(15, 23, 42, 0.08);
}
.title-card,
.preview-card {
background: color-mix(in srgb, var(--wa-color-surface-default) 92%, white);
}
.preview-card {
height: 100%;
}
.sidebar-card {
background: color-mix(in srgb, var(--wa-color-neutral-fill-normal) 12%, white);
position: sticky;
top: 0;
height: 100%;
}
.title-stack,
.sidebar-stack,
.preview-stack,
.stats-grid,
.tab-stack {
display: grid;
gap: 10px;
}
.title-line {
margin: 0;
font-size: 1.95rem;
line-height: 1;
letter-spacing: -0.03em;
}
.title-copy,
.sidebar-note,
.tab-copy,
.details-copy {
margin: 0;
line-height: 1.45;
}
.preset-group {
display: grid;
gap: 0.55rem;
}
.stats-grid {
grid-template-columns: repeat(3, minmax(110px, 150px));
gap: 8px;
align-items: start;
}
.stat-card {
background: color-mix(in srgb, var(--wa-color-brand-fill-loud) 4%, white);
box-shadow: none;
border-radius: 18px;
padding: 0.62rem 0.85rem;
}
.stat-label {
color: color-mix(in srgb, var(--wa-color-text-normal, #1f2937) 60%, white);
font-size: 0.68rem;
text-transform: uppercase;
font-weight: 800;
letter-spacing: 0.08em;
}
.stat-value {
font-size: 1rem;
font-weight: 800;
line-height: 1.1;
}
.preview-header {
display: flex;
flex-wrap: wrap;
justify-content: space-between;
gap: 10px;
align-items: center;
}
.plot-shell,
.table-shell {
border-radius: 18px;
background: color-mix(in srgb, var(--wa-color-surface-default) 96%, white);
border: 1px solid color-mix(in srgb, var(--wa-color-surface-border) 80%, white);
padding: 7px 9px;
}
.table-shell table {
width: 100%;
border-collapse: collapse;
font-size: 0.92rem;
}
.table-shell th,
.table-shell td {
padding: 8px 10px;
border-bottom: 1px solid color-mix(in srgb, var(--wa-color-surface-border) 70%, white);
text-align: left;
}
.table-shell th:last-child,
.table-shell td:last-child {
text-align: right;
}
.table-shell th {
font-size: 0.76rem;
text-transform: uppercase;
letter-spacing: 0.08em;
color: color-mix(in srgb, var(--wa-color-text-normal, #1f2937) 58%, white);
}
.tab-shell {
min-height: 330px;
}
.preset-label {
margin: 0;
text-transform: uppercase;
letter-spacing: 0.08em;
}
.preset-radios {
width: 100%;
}
.preset-radios::part(form-control-input) {
gap: 1rem;
}
.preset-radios wa-radio {
margin-right: 1rem;
}
@media (max-width: 860px) {
.workbench-layout,
.stats-grid {
grid-template-columns: 1fr;
}
.sidebar-card {
position: static;
}
}// Store this file next to app.R as app.js.
(function() {
function syncWorkbenchControls() {
const tabs = document.getElementById('surface_tabs');
const trend = document.getElementById('show_smoother');
if (!tabs || !trend) {
return;
}
trend.disabled = tabs.active !== 'chart';
}
function bindWorkbenchControls() {
const tabs = document.getElementById('surface_tabs');
if (!tabs || tabs.dataset.workbenchControlsBound) {
syncWorkbenchControls();
return;
}
tabs.dataset.workbenchControlsBound = 'true';
tabs.addEventListener('wa-tab-show', syncWorkbenchControls);
syncWorkbenchControls();
}
document.addEventListener('shiny:connected', function() {
setTimeout(bindWorkbenchControls, 0);
}, { once: true });
setTimeout(bindWorkbenchControls, 0);
})();Design Philosophy
shiny.webawesome is designed to stay close to upstream Web Awesome. Most component wrappers are generated from Web Awesome metadata, which helps preserve upstream names, structure, and behavior while translating the interface into normal R conventions such as snake_case.
That close alignment has a practical benefit: when you want deeper details, examples, or component-specific guidance, you can usually go straight to the upstream Web Awesome documentation and apply what you find directly in shiny.webawesome. The package currently supports all Web Awesome components, so the upstream docs are a practical reference for day-to-day use.
To support the server-client model of Shiny, the package adds a small set of page and layout helpers, curated reactive bindings, and a narrow command layer for cases where browser-side interaction goes beyond the generated wrappers.
The result is a package with a clear default path. Use generated wrappers for ordinary UI, use bindings for meaningful reactive state, and reach for commands or small JavaScript glue when the app needs them.
Shiny Bindings
shiny.webawesome does not forward every browser event and every detail of component telemetry into Shiny. Much component state and interaction detail is better handled locally in the browser rather than turned into server messages. Consequently, the package exposes only a curated set of Shiny bindings that fit Shiny’s reactive model, with an emphasis on meaningful committed state rather than low-level browser event streams.
In the most common case, a binding publishes a durable semantic value. A select reports its current value, a dialog can report whether it is open, and a tree can report the currently selected item ids. The key idea is that Shiny receives the state the app actually cares about, not the raw event name that happened to produce it.
Some components are better treated as actions than values. A button is the clearest example: in Shiny, it behaves like a Shiny action input, with each click producing a new input event. A small number of components need both action semantics and a separate value. A dropdown, for example, may need to trigger reactivity on every choice, including repeated selections of the same item, while also exposing the latest selected value.
This design keeps reactive messaging to the server smaller, clearer, and easier to reason about. If an interaction belongs naturally in Shiny’s input model, shiny.webawesome will expose it as a binding. If it is more naturally a browser-side concern, it is usually a better fit for the command layer or a small amount of JavaScript glue.
For the full binding categories, semantics, and examples, see the package article: Shiny Bindings.
Command API
shiny.webawesome covers the most common interaction patterns through generated wrappers, Shiny bindings, and update helpers. But sometimes an app still needs to reach into a live browser element directly: set a property, call a method, or add a small browser-local JavaScript snippet.
For those cases, the package provides a narrow command API. The two main server-side helpers are wa_set_property() and wa_call_method(). They let Shiny code send one-way commands to a browser element identified by id, either by assigning a value to a live property or invoking a browser-side method.
If a component already has a binding or update helper, that should usually remain the first choice. The command layer is for the cases that fall just outside those built-in paths, where the simplest solution is still to tell the existing browser component to do one specific thing.
The package also includes wa_js() for a different kind of job: small, app-local JavaScript glue. That is useful when the missing piece is browser-side logic such as listening for an event, reading live component state, or publishing a derived value back to Shiny with Shiny.setInputValue().
For more detail and examples, see the package article: Command API.
Conclusion
shiny.webawesome brings a visually rich component library into Shiny while staying close to upstream Web Awesome. That combination gives polished components, useful layout and styling utilities, and a workflow where upstream documentation and examples remain directly relevant throughout app development.
For more examples, longer articles, and full reference material, see the package website: shiny-webawesome.org.