Improves badge border and look

[averissimo]

Pull Request

Companion of insightsengineering/teal#1713 (can be merged before teal PR is merged)

Changes description

• Fixes visual disappearance of red border when clicking picks
  • Previous implementation of red border looks for existing error class in children
  • Current adds an additional class to wrapper element that keeps it visible

Screencast.From.2026-05-11.14-45-37.mp4

Example app

Please use teal PR to see full range of improvements

#
pkgload::load_all("../teal.picks")
pkgload::load_all("../teal")

data <- within(teal_data(), letters <- data.frame(letter = head(LETTERS)))

picks_letters <- picks(
  datasets("letters", "letters"),
  variables("letter", "letter"),
  values(selected = NULL)
)

my_module <- module(
  label = "My Module",
  datanames = NULL,
  ui = function(id) {
    ns <- NS(id)
    teal.widgets::standard_layout(
      encoding = tagList(
        tags$h3("Letters"),
        teal.picks::picks_ui(ns("letters"), picks_letters),
        tags$h3("Letters2"),
        checkboxGroupInput(ns("letters2"), "Select letters:", choices = head(LETTERS), inline = TRUE),
      ),
      output = tagList(
        tags$h3("Sample plot"),
        plotOutput(ns("plot"))
      )
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      selectors <- list(letters = picks_letters)
      anl_inputs <- picks_srv(picks = selectors, data = data)

      validated_q <- reactive({
        validate_input(
          "letters-values-selected",
          condition = length(anl_inputs$letters()$values$selected) > 0,
          message = "Select at least one letter."
        )
        validate_input(
          c("letters-values-selected", "letters2"),
          condition = all(!anl_inputs$letters()$values$selected %in% input$letters2),
          message = "Letters in the first group should not be in the second group."
        )
        data()
      })

      output$plot <- renderPlot({
        letters <- validated_q()$letters$letter
        tab <- rbind(
          Group1 = as.integer(letters %in% anl_inputs$letters()$values$selected),
          Group2 = as.integer(letters %in% input$letters2)
        )
        colnames(tab) <- letters
        barplot(
          tab,
          beside = TRUE, legend.text = TRUE, main = "Selected letters per group",
          col = c("steelblue", "tomato")
        )
      })
    })
  }
)

init(data = data, modules = my_module) |> shiny::runApp()