inst/doc/testing.R

In brochure: Multipage 'Shiny' Apps

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = FALSE)

## -----------------------------------------------------------------------------
# library(shiny)
# library(brochure)
# library(testthat)

## -----------------------------------------------------------------------------
# app <- brochureApp(
#   page(href = "/", ui = tagList(h1("Home"))),
#   page(href = "/contact", ui = tagList(h1("Contact"))),
#   redirect(from = "/index.html", to = "/"),
#   content_404 = "Nothing here"
# )
# 
# res <- app$httpHandler(mock_req("/contact"))
# res$status
# #> [1] 200

## -----------------------------------------------------------------------------
# mock_req <- function(path, method = "GET") {
#   req <- new.env(parent = emptyenv())
#   req$REQUEST_METHOD <- method
#   req$PATH_INFO <- path
#   req$QUERY_STRING <- ""
#   # What makes the dispatch accept this as a request
#   req$rook.version <- "1.1-0"
#   req
# }

## -----------------------------------------------------------------------------
# test_that("each url reaches its own page", {
#   expect_match(app$httpHandler(mock_req("/"))$content, "Home")
#   expect_match(app$httpHandler(mock_req("/contact"))$content, "Contact")
# })
# 
# test_that("an unknown url gets the 404", {
#   res <- app$httpHandler(mock_req("/nope"))
#   expect_equal(res$status, 404)
#   expect_equal(res$content, "Nothing here")
# })
# 
# test_that("the old index redirects home", {
#   res <- app$httpHandler(mock_req("/index.html"))
#   expect_equal(res$status, 301)
#   expect_equal(res$headers$Location, "/")
# })

## -----------------------------------------------------------------------------
# test_that("/who/me is not caught by /who/:id", {
#   app <- brochureApp(
#     page(href = "/who/me", ui = tagList(h1("It's you"))),
#     page(href = "/who/:id", ui = tagList(h1("Someone else")))
#   )
#   expect_match(app$httpHandler(mock_req("/who/me"))$content, "It's you")
# })

## -----------------------------------------------------------------------------
# test_that("logging in sets the session cookie", {
#   app <- brochureApp(
#     page(
#       href = "/login",
#       ui = tagList(h1("Logged in")),
#       res_handlers = list(~ set_cookie(.x, "SESSION", "abc"))
#     )
#   )
#   res <- app$httpHandler(mock_req("/login"))
#   expect_match(res$headers$`Set-Cookie`, "SESSION=abc")
# })

## -----------------------------------------------------------------------------
# test_that("the healthcheck answers 200 without Shiny", {
#   expect_equal(
#     app$httpHandler(mock_req("/healthcheck"))$status,
#     200
#   )
# })

## -----------------------------------------------------------------------------
# test_that("links stay inside the app under a mount", {
#   app <- brochureApp(
#     page(href = "/", ui = tagList(tags$a(href = "/contact", "Contact"))),
#     basepath = "myapp"
#   )
#   content <- app$httpHandler(mock_req("/myapp/"))$content
#   expect_match(content, 'href="/myapp/contact"', fixed = TRUE)
# })

## -----------------------------------------------------------------------------
# mock_session <- function(path) {
#   list(
#     request = mock_req(path),
#     sendCustomMessage = function(type, message) NULL
#   )
# }
# 
# test_that("a session runs the server of its own page", {
#   ran <- character()
#   app <- brochureApp(
#     page(href = "/", ui = tagList(), server = function(i, o, s) ran <<- c(ran, "home")),
#     page(href = "/page2", ui = tagList(), server = function(i, o, s) ran <<- c(ran, "page2"))
#   )
#   app$serverFuncSource()(NULL, NULL, mock_session("/page2/websocket/"))
#   expect_equal(ran, "page2")
# })

## -----------------------------------------------------------------------------
# mod_profile_ui <- function(id) {
#   ns <- NS(id)
#   tagList(textOutput(ns("name")))
# }
# 
# mod_profile_server <- function(id, user) {
#   moduleServer(id, function(input, output, session) {
#     output$name <- renderText(sprintf("Hello %s", user))
#   })
# }
# 
# profile <- function() {
#   page(
#     href = "/who/:id",
#     ui = mod_profile_ui("profile"),
#     server = function(input, output, session) {
#       # The only line that needs a real session
#       mod_profile_server("profile", user = get_keys()$id)
#     }
#   )
# }

## -----------------------------------------------------------------------------
# test_that("the profile module greets the user", {
#   testServer(mod_profile_server, args = list(user = "colin"), {
#     expect_equal(output$name, "Hello colin")
#   })
# })