tests/testthat/test-sidebar.R

In leaflet.extras2: Extra Functionality for 'leaflet' Package

test_that("sidebar", {
  ## Check HTML ####################
  m <- sidebar_pane(
    title = "messages", id = "messages_id", icon = tags$i(class = "person"),
    tagList(tags$div("Some Shiny Inputs"))
  )
  expect_is(m, "shiny.tag")

  m <- sidebar_tabs(
    id = "sidebar",
    list(tags$i(class = "car"), tags$i(class = "user"), tags$i(class = "car")),
    sidebar_pane(
      title = "home", id = "home_id", icon = tags$i(class = "home"),
      tagList(tags$div("Some Shiny Inputs"))
    ),
    sidebar_pane(
      title = "profile", id = "profile_id", icon = tags$i(class = "wrench"),
      tagList(tags$div("Some Shiny Inputs"))
    ),
    sidebar_pane(
      title = "messages", id = "messages_id", icon = tags$i(class = "person"),
      tagList(tags$div("Some Shiny Inputs"))
    )
  )
  expect_is(m, "shiny.tag")

  ## Leaflet ####################
  m <- leaflet() %>%
    addSidebar()
  expect_is(m, "leaflet")

  deps <- findDependencies(m)
  expect_equal(deps[[length(deps)]]$name, "lfx-sidebar")

  m <- m %>%
    removeSidebar()
  expect_equal(
    m$x$calls[[length(m$x$calls)]]$method,
    "removeSidebar"
  )

  m <- m %>%
    openSidebar("tab1")
  expect_equal(
    m$x$calls[[length(m$x$calls)]]$method,
    "openSidebar"
  )

  m <- m %>%
    closeSidebar()
  expect_equal(
    m$x$calls[[length(m$x$calls)]]$method,
    "closeSidebar"
  )

  ## Check For Modules ##########
  m <- leaflet() %>%
    addSidebar(ns = shiny::NS("modul"))
  expect_is(m, "leaflet")
  expect_equal(
    m$x$calls[[length(m$x$calls)]]$args[[1]],
    "modul-sidebar"
  )

  m <- leaflet() %>%
    addSidebar(ns = shiny::NS("modul")) %>%
    openSidebar(id = "sidebar", ns = shiny::NS("modul"))
  expect_is(m, "leaflet")
  expect_equal(
    m$x$calls[[length(m$x$calls)]]$args[[1]]$id,
    "modul-sidebar"
  )
})

test_that("sidebar-error", {
  expect_error(
    sidebar_pane(
      icon = tags$i(class = "person"),
      tagList()
    )
  )

  expect_error(
    sidebar_tabs(
      list(tags$i(class = "person"), tags$i(class = "person")),
      sidebar_pane(
        id = "home_id",
        icon = tags$i(class = "person"), tagList()
      ),
      sidebar_pane(
        id = "profile_id",
        icon = tags$i(class = "person"), tagList()
      ),
      sidebar_pane(
        id = "messages_id",
        icon = tags$i(class = "person"), tagList()
      )
    )
  )
})