A card-forward tabbed container

[gadenbuie]

navs_tab_card() provides an easy and seamless way to go from a tabbed nav container

navs_tab(
  nav("One", "Content for panel one.")
  nav("Two", "Content for panel two.")
)

to a tabbed nav interface inside a card container

navs_tab_card(
  nav("One", "Content for panel one.")
  nav("Two", "Content for panel two.")
)

You can further augment the cards created for each nav() using card element functions like card_title(), card_body(), card_body_fill() and card_footer().

Here's an example from the bslib cards article:

library(leaflet)
navs_tab_card(
  height = 300, full_screen = TRUE,
  title = "HTML Widgets",
  nav(
    "Plotly", 
    card_title("A plotly plot", class = "pt-1"),
    card_body_fill(plotly_widget)
  ),
  nav(
    "Leaflet",
    card_title("A leaflet plot", class = "pt-1"),
    card_body_fill(leaflet_widget)
  ),
  nav(
    shiny::icon("circle-info"),
    "Learn more about",
    tags$a("htmlwidgets", href = "http://www.htmlwidgets.org/")
  )
)

For me, while learning the cards syntax, this formulation feels quite distant from the card() syntax, since it's primarily driven by the navs_tab() approach. In particular, navs_tab() with child nav() items is a new syntax that I had to learn in order to understand which card_*() helpers would fit into the navs_tab_card() model.

-  nav(
+  card(
-    "Plotly",
+    card_header("Plotly"),
     card_title("A plotly plot", class = "pt-1"),
     card_body_fill(plotly_widget)
   )

Furthermore, I think a very common development model will be to create a card, e.g.

card(
  card_header("Plotly"),
  card_title("A plotly plot", class = "pt-1"),
  card_body_fill(plotly_widget)
)

and then realize that we'd rather fold multiple cards into a single tabbed interface. Or in terms of discoverability, I think many people will first look for tabbed cards in the card_ autocomplete and may have trouble finding it under the navs_ prefix.

It could be helpful to provide a card_navs_tab() – a card() + navs_tab() – wrapper that would take multiple cards and convert them into a tabbed interface. We'd assert that cards used as part of a tabbed card must contain a card_header() from which we derive the nav item.

card_navs_tab(
  height = 300, full_screen = TRUE,
  title = "HTML Widgets",
  card(
    card_header("Plotly"),
    card_title("A plotly plot", class = "pt-1"),
    card_body_fill(plotly_widget)
  ),
  card(
    card_header("Leaflet"),
    card_title("A leaflet plot", class = "pt-1"),
    card_body_fill(leaflet_widget)
  ),
  card(
    card_header(shiny::icon("circle-info")),
    "Learn more about",
    tags$a("htmlwidgets", href = "http://www.htmlwidgets.org/")
  )
)

This would allow users to write complete cards inside tabbed interfaces and to move cards between containers without having to rewrite the card syntax. It also naturally builds on the concepts developers have already learned to use to create cards.

Here's a minimum viable example demonstrating the key behavior. In the example, the same 5 cards are used in the first row, wrapped in layout_column_wrap(), as are used in the second row, wrapped in the prototype card_nabs_tab().

app.R

library(shiny)
library(bslib)
library(plotly)
library(htmltools)

if (!rlang::is_installed("lorem")) {
  pak::pkg_install("gadenbuie/lorem")
}

plotly_widget <- plot_ly(x = diamonds$cut) %>%
  config(displayModeBar = FALSE) %>%
  layout(margin = list(t = 0, b = 0, l = 0, r = 0))

lorem1 <- lorem::ipsum(sentences = 2)
lorem2 <- lorem::ipsum(sentences = 2)

# ---- card_navs_tab() ----
card_navs_tab <- function(
  ...,
  id = NULL,
  selected = NULL,
  title = NULL,
  header = NULL,
  footer = NULL,
  height = NULL,
  full_screen = FALSE
) {
  cards <- rlang::dots_list(...)

  rewrite_card_as_nav <- function(x) {
    tq <- tagQuery(x)
    header <- tq$find(".card-header")$selectedTags()

    if (!length(header)) {
      stop("tabbed cards need to have `card_header()`")
    }

    header <- header[[1]]$children

    body <- tq$find(".card-header")$remove()$allTags()$children

    nav(header, !!!body)
  }

  nav_cards <- lapply(cards, rewrite_card_as_nav)

  navs_tab_card(
    !!!nav_cards,
    wrapper = as.card_item,
    id = id,
    selected = selected,
    title = title,
    header = header,
    footer = footer,
    height = height,
    full_screen = full_screen
  )
}

# ---- Cards ----
card1 <- card(
  card_header("One"),
  lorem1
)

card2 <- card(
  card_header("Two"),
  card_title("Two Title"),
  card_body_fill(lorem2),
  card_footer("Just some placeholder text")
)

card3 <- card(
  height = 200, full_screen = TRUE,
  card_header("Three"),
  "Try expanding full screen",
  card_body_fill(
    plotly_widget,
    max_height = "400px"
  )
)

card4 <- card(
  card_header(span(class = "text-danger", "Four")),
  div(class = "p-3 bg-warning text-white", "Not actually a card body, really."),
  wrapper = as.card_item
)

card5 <- card(
  card_header(shiny::icon("circle-info")),
  "Learn more about",
  tags$a("bslib", href = "https://github.com/rstudio/bslib")
)

ui <- page_fluid(
  theme = bs_theme(version = 5),
  h2("Plain Cards"),
  layout_column_wrap(
    width = 1/5,
    card1,
    card2,
    card3,
    card4,
    card5
  ),
  h2("Tabbed Cards"),
  card_navs_tab(
    title = "Cards, tabbed",
    card1,
    card2,
    card3,
    card4,
    card5,
    height = 300,
    full_screen = TRUE
  )
)

server <- function(...) {
  # No server in the example
}

shinyApp(ui, server)