HTML/CSS not rendering in shiny r

Question

An MLE of my code is the following, where the background color of the link in nav_links should turn yellow when the link is chosen (the MLE is mostly taken from https://colinfay.me/brochure-r-package/):

css <- "
.nav > li.active > a { 
    background-color: yellow;
}
"

nav_links <- tags$ul(
  tags$head(
    tags$style(HTML(css))
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/"), "home"), 
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/page2"), "page2"), 
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/page3"), "page3"), 
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/page4"), "page4"), 
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/page5"), "page5"), 
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/page6"), "page6"), 
  ),
  tags$li(
    tags$a(href = paste0(baseurl,"/contact"), "contact"), 
  ),
)

page_1 <- function(){
  page(
    href = "/",
    ui = function(request){
      tagList(
        h1("This is my first page"),
        nav_links,
        plotOutput("plot")
      )
    },
    server = function(input, output, session){
      output$plot <- renderPlot({
        plot(mtcars)
      })
    }
  )
}

When the link "home" is active, the link background color does not change. Any ideas?

Answer 1

The issue is that your links don't have a class nav or a class active, i.e. to target your links via a nav or active class you have to add classes to your li tags.

While adding a nav class is easy to achieve, adding a active class requires some more effort as of course only the active nav link should have the active class. To this end I made nav_links a function which takes as as argument the id of the active nav link which could be used to conditionally add an active class. To this end I also use Map to create the list of li tags.

To make the example a bit more interesting I added a second page.

library(shiny)
library(brochure)

baseurl <- ""
css <- "
.nav.active > a {
    background-color: yellow;
}
"

nav_links <- function(active = NULL) {
  id <- c("home", paste0("page", 2:6), "contact")
  href <- c("/", paste0("/page", 2:6), "/contact")

  tags$ul(
    tags$head(
      tags$style(HTML(css))
    ),
    Map(
      \(id, href) {
        class <- if (id == active) "nav active" else "nav"
        tags$li(
          class = class,
          tags$a(href = paste0(baseurl, href), id)
        )
      },
      id, href
    )
  )
}

page_1 <- function() {
  page(
    href = "/",
    ui = function(request) {
      tagList(
        h1("This is my first page"),
        nav_links("home"),
        plotOutput("plot")
      )
    },
    server = function(input, output, session) {
      output$plot <- renderPlot({
        plot(mtcars)
      })
    }
  )
}

page_2 <- function() {
  page(
    href = "/page2",
    ui = function(request) {
      tagList(
        h1("This is my second page"),
        nav_links("page2"),
        tableOutput("table")
      )
    },
    server = function(input, output, session) {
      output$table <- renderTable({
        head(mtcars)
      })
    }
  )
}

brochureApp(
  page_1(),
  page_2()
)