tests/testthat/test-mutate_tags.R

In learnr: Interactive Tutorials for R

has_class <- function(el, .class, ...) {
  class_idx <- which(names(el$attribs) == "class")
  if (!length(class_idx)) return(FALSE)
  el_class <- vapply(class_idx, function(i) el$attribs[[i]], FUN.VALUE = character(1))
  grepl(.class, paste(el_class, collapse = " "), ...)
}

test_that("finalize_tags() finalizes the question UI", {
  q_ui_final <- finalize_question(
    htmltools::div(
      class = "custom-question",
      htmltools::div("answer 1"),
      htmltools::div("answer 2")
    )
  )

  expect_true(has_class(q_ui_final, "question-final"))
  expect_true(has_class(q_ui_final, "disabled"))
  expect_true(has_class(q_ui_final$children[[1]], "disabled"))
  expect_true(has_class(q_ui_final$children[[2]], "disabled"))
  expect_true("disabled" %in% q_ui_final$attribs)
  expect_true("disabled" %in% names(q_ui_final$children[[1]]$attribs))
  expect_true("disabled" %in% names(q_ui_final$children[[2]]$attribs))

  q_ui_checkbox <-
    checkboxGroupInput(
      "q-checkbox",
      label = "check box question",
      choiceValues = letters,
      choiceNames = LETTERS,
      selected = "a"
    )

  q_ui_checkbox_final <- finalize_question(q_ui_checkbox)
  # before
  expect_false(has_class(q_ui_checkbox, "question-final"))
  expect_false(has_class(q_ui_checkbox, "disabled"))
  expect_false("disabled" %in% names(q_ui_checkbox$attribs))
  # after
  expect_true(has_class(q_ui_checkbox_final, "question-final"))
  expect_true(has_class(q_ui_checkbox_final, "disabled"))
  expect_true("disabled" %in% names(q_ui_checkbox_final$attribs))

  q_ui_radio <-
    radioButtons(
      "q-radio",
      label = "radio question",
      choiceValues = letters,
      choiceNames = LETTERS,
      selected = "b"
    )

  q_ui_radio_final <- finalize_question(q_ui_radio)
  # before
  expect_false(has_class(q_ui_radio, "question-final"))
  expect_false(has_class(q_ui_radio, "disabled"))
  expect_false("disabled" %in% names(q_ui_radio$attribs))
  # after
  expect_true(has_class(q_ui_radio_final, "question-final"))
  expect_true(has_class(q_ui_radio_final, "disabled"))
  expect_true("disabled" %in% names(q_ui_radio_final$attribs))
})

test_that("finalize_question() works with a shiny.tag.list, too", {
  q_ui_final <- finalize_question(
    htmltools::tagList(
      htmltools::div("thing 1"),
      htmltools::div("thing 2")
    )
  )

  expect_s3_class(q_ui_final, "shiny.tag.list")
  expect_true(has_class(q_ui_final[[1]], "question-final"))
  expect_true(has_class(q_ui_final[[1]], "disabled"))
  expect_true(has_class(q_ui_final[[2]], "question-final"))
  expect_true(has_class(q_ui_final[[2]], "disabled"))
})