tests/testthat/test-stimulus.R

In tjpalanca/hotwire.R: Hotwire for R

test_that("Stimulus Plugin initializes", {

  stimulus <- expect_r6(
    Stimulus$new(pkg_inst("demo_app"), pkg_vers()),
    "Stimulus"
  )

})

test_that("Stimulus assets can be generated", {

  # Plain assets
  stimulus <- Stimulus$new(
    controllers = pkg_inst("demo_app"),
    app_version = pkg_vers()
  )
  expect_class(stimulus$assets(TRUE), "shiny.tag.list")
  expect_null(stimulus$assets(FALSE))

  stimulus <- Stimulus$new(
    controllers = pkg_inst("demo_app/hello_controller.js"),
    app_version = pkg_vers()
  )
  # Modified with default
  assets <- expect_class(
    stimulus$assets(c("default", pkg_inst("demo_app/demo_controller.js"))),
    "shiny.tag.list"
  )
  expect_equal(
    map_chr(assets[[2]]$script, "src"),
    c("hello_controller.js", "demo_controller.js")
  )
  # Modified without default
  assets <- expect_class(
    stimulus$assets(c(pkg_inst("demo_app/demo_controller.js"))),
    "shiny.tag.list"
  )
  expect_equal(
    map_chr(assets[[2]]$script, "src"),
    c("demo_controller.js")
  )

})

test_that("Stimulus routers can be added", {

  app <- App$new(HTMLPlugin$new(), TestPlugin$new(), Stimulus$new(
    app_version = pkg_vers(),
    controllers = pkg_inst("demo_app")
  ))
  app$stimulus$router("/", function(request, response, keys, ...) {
    response$body <- html_tags(h1("Hello World"))
  })
  res <- app$test$request("/")
  expect_equal(res$status, 200L)
  expect_equal(res$headers$`Content-Type`, "text/html")
  expect_string(res$body, "slideshow-controller")

})