tests/testthat/test-bs4ValueBox.R

In hiplot/bs4Dash2: A 'Bootstrap 4' Version of 'shinydashboard'

context("bs4ValueBox")

getCardWrapperCl <- function(card) {
  card$attribs$class
}

getCardCl <- function(card) {
  card$children[[1]]$attribs$class
}

getCardChildren <- function(card) {
  bs4Dash:::dropNulls(card$children[[1]]$children)
}


test_that("structure", {
  golem::expect_shinytag(bs4ValueBox(2, "Value"))
  expect_error(bs4ValueBox(2))
  expect_error(bs4ValueBox(subtitle = "Value"))
  expect_error(bs4ValueBox(2, "Value", href = "ppp", footer = "kkk"))
  
  # inner (value + footer). Footer is just here for styling purpose
  valueBoxTag <- bs4ValueBox(2, "Value")
  valueBoxChildren <- getCardChildren(valueBoxTag)
  expect_length(valueBoxChildren, 2)
  expect_match(valueBoxChildren[[1]]$attribs$class, "inner")
  expect_match(valueBoxChildren[[2]]$attribs$class, "small-box-footer")
  
  # inner + icon
  valueBoxTag <- bs4ValueBox(2, "Value", icon = shiny::icon("cogs"))
  valueBoxChildren <- getCardChildren(valueBoxTag)
  expect_length(valueBoxChildren, 3)
  expect_match(valueBoxChildren[[1]]$attribs$class, "inner")
  expect_match(valueBoxChildren[[2]]$attribs$class, "icon")
  expect_match(valueBoxChildren[[3]]$attribs$class, "small-box-footer")
  
  # wrong icon
  expect_error(
    bs4ValueBox(2, "Value", icon = "popoiiuu")
  )
  
  # inner + icon + footer
  valueBoxTag <- bs4ValueBox(2, "Value", footer = "test", icon = shiny::icon("cogs"))
  valueBoxChildren <- getCardChildren(valueBoxTag)
  expect_length(valueBoxChildren, 3)
  expect_match(valueBoxChildren[[1]]$attribs$class, "inner")
  expect_match(valueBoxChildren[[2]]$attribs$class, "icon")
  expect_match(valueBoxChildren[[3]]$attribs$class, "small-box-footer")
  
  # inner + href
  valueBoxTag <- bs4ValueBox(2, "Value", href = "test")
  valueBoxChildren <- getCardChildren(valueBoxTag)
  expect_length(valueBoxChildren, 2)
  expect_match(valueBoxChildren[[2]]$attribs$class, "small-box-footer")
})

test_that("box width", {
  expect_error(bs4ValueBox(2, "Value", width = "2"))
  expect_error(bs4ValueBox(2, "Value", width = -1))
  valueBoxTag <- bs4ValueBox(2, "Value", width = 4)
  wrapperTagCl <- getCardWrapperCl(valueBoxTag)
  expect_match(wrapperTagCl, "col-sm-4")
})

test_that("status css class", {
  valueBoxTag <- bs4ValueBox(2, "Value")
  valueBoxCl <- getCardCl(valueBoxTag)
  expect_match(valueBoxCl, "small-box")
  
  valueBoxTag <- bs4ValueBox(2, "Value", color = "primary")
  valueBoxCl <- getCardCl(valueBoxTag)
  expect_match(valueBoxCl, "small-box bg-primary")
  
  expect_error(
    bs4ValueBox(2, "Value", color = NULL, gradient = TRUE)
  )
  
  expect_error(bs4ValueBox(2, "Value", color = "prout"))
  
  valueBoxTag <- bs4ValueBox(2, "Value", color = "primary", gradient = TRUE)
  valueBoxCl <- getCardCl(valueBoxTag)
  expect_match(valueBoxCl, "small-box bg-gradient-primary")
})

test_that("box elevation", {
  valueBoxTag <- bs4ValueBox(2, "Value", elevation = 4)
  valueBoxCl <- getCardCl(valueBoxTag)
  expect_match(valueBoxCl, "elevation-4")
  
  expect_error(bs4ValueBox(2, "Value", elevation = 6))
  expect_error(bs4ValueBox(2, "Value", elevation = -1))
  expect_error(bs4ValueBox(2, "Value", elevation = "2"))
})