Simplify navbar setup

[DivadNojnarg]

Way too complex for what it does...

[DivadNojnarg]

Invoking @kamilzyla. The way navbar works bothers me because to get nav links properly highlighted, I have to re-render the whole navbar within renderReact (https://github.com/RinteRface/shinyNextUI/blob/main/inst/examples/navbar/app.R). NextUI navbar components don't have many JS events so that made my work quite challenging.

I suppose one would have to use react router for this kind of thing but I used shiny.router which work well on the R side.

On the JS side (https://github.com/RinteRface/shinyNextUI/blob/main/js/src/inputs.js#L84), whenever I click on a link, I recover the parent attribute which contains the right input reference and update its value by the current link value attribute:

NavbarLink = InputAdapter(NextUI.Navbar.Link, (value, setValue, props) => ({
  value: value,
  onPress: (e) => {
    const navId = $(e.target).attr('parent');
    Shiny.setInputValue(navId, $(e.target).attr('value'), {priority: 'event'});
  }
}))

On the R side, links are re-rendered according to input$<NAVBAR_ID>. If the input value is equal to the link value, then the link is set to isActive and conversely. I initially tried to only re-render the links and have a fix navbar which did not work.

library(shiny)
library(shinyNextUI)
library(shiny.react)
library(shiny.router)

sections <- c("main", "other")

layout <- function(..., content) {
  tags$div(
    css = JS("
      {
        maxW: '100%',
        boxSizing: 'border-box',
      }"
    ),
    ..., # Navbar
    # Content
    tags$div(
      css = JS(
        "{
          boxSizing: 'border-box',
          px: '$12',
          mt: '$8',
          '@xsMax': {px: '$10'}
        }"
      ),
      content
    )
  )
}

# TO DO: create wrapper for enduser to simplify all this mess.
create_navbar <- function(id) {

  input <- get("input", envir = parent.frame())

  nav_links <- lapply(seq_along(sections), function(i) {
    # Li elements
    navbar_link(
      inputId = sprintf("link_%s", i),
      href = route_link(sections[[i]]),
      key = i,
      value = i,
      # Necessary on the JS side to recover the right input id
      parent = sprintf("navbar_%s", sections[[i]]),
      # Apply correct active style
      isActive = if (is.null(input[[sprintf("navbar_%s", id)]])) {
        if (i == 1) TRUE else FALSE
      } else {
        if (input[[sprintf("navbar_%s", id)]] == i) TRUE else FALSE
      },
      sprintf("Link to %s", sections[[i]])
    )
  })

  nav <- navbar(
    id = sprintf("navbar_%s", id),
    maxWidth = "lg",
    variant = "floating",
    isBordered = TRUE,
    navbar_brand(text(b = TRUE, "Brand", color = "inherit", hideIn = "xs")),
    # Ul element
    navbar_content(
      variant = "highlight",
      activeColor = "success",
      nav_links,
      navbar_item(
        action_button(
          inputId = sprintf("navbar_button-%s", id),
          "Click me",
          auto = TRUE,
          flat = TRUE
        )
      )
    )
  )

  if (is.null(input[[sprintf("navbar_%s", id)]])) {
    tagList(
      tags$script(
        sprintf("Shiny.setInputValue('navbar_%s', 0)", id)
      ),
      nav
    )
  } else {
    nav
  }
}

page <- function(id, content) {
  layout(
    reactOutput(sprintf("nav_%s", id)),
    content = content
  )
}

home <- page(
  id = "main",
  grid_container(
    gap = 2,
    grid(
      xs = 12,
      card(
        variant = "bordered",
        card_header(text("Amazing plot", as = "h3")),
        card_divider(),
        card_body(
          row(
            justify = "center",
            align = "center",
            gap = 1,
            col(
              span = 2,
              collapse_panel(
                shadow = TRUE,
                bordered = TRUE,
                css = JS("{
                  background: 'gainsboro'
                }"),
                title = "Plot options",
                subtitle = "A panel containing options",
                inputId = "options",
                value = TRUE,
                numeric_input(
                  inputId = "obs",
                  label = "Number of observations:",
                  value = 500
                )
              )
            ),
            col(
              span = 10,
              plotOutput("distPlot")
            )
          )
        )
      )
    )
  )
)
other <- page(
  id = "other",
  grid_container(
    gap = 2,
    grid(
      xs = 12,
      card(
        css = JS(
          "{
           maxHeight: '400px',
          overflowY: 'scroll'
          }"
        ),
        variant = "bordered",
        tableOutput('table')
      )
    )
  )
)

ui <- nextui_page(
  router_ui(
    route("main", home),
    route("other", other)
  )
)

server <- function(input, output, session) {
  observe(print(input$navbar))
  output$nav_main <- renderReact({
    create_navbar("main")
  })

  output$nav_other <- renderReact({
    create_navbar("other")
  })

  output$distPlot <- renderPlot({
    hist(rnorm(input$obs))
  })
  output$table <- renderTable(iris)

  router_server("main")
}

if (interactive() || is_testing()) shinyApp(ui, server)

TO DO:

• find a way to have only 1 navbar so we only have 1 input
• Only re-render nav links