Use nanonext http server for preview (#2975)

* Use nanonext http server for preview

* Update search docs section

* Add `stop_preview()`

* Add pkgdown reference entry

* Keywords internal `stop_preview()`

Author: shikokuchuo

DESCRIPTION

@@ -35,6 +35,7 @@ Imports:
     jsonlite,
     lifecycle,
     openssl,
+    nanonext (>= 1.8.0),
     purrr (>= 1.0.0),
     ragg (>= 1.4.0),
     rlang (>= 1.1.4),

NAMESPACE

@@ -138,6 +138,7 @@ export(pkgdown_sitrep)
 export(preview_site)
 export(rd2html)
 export(render_page)
+export(stop_preview)
 export(template_articles)
 export(template_navbar)
 export(template_reference)

NEWS.md

@@ -1,5 +1,7 @@
 # pkgdown (development version)
 
+* When previewing a site, it is now served via a local http server. This enables dynamic features such as search to work correctly (@shikokuchuo, #2975).
+
 * do not autolink code that is in a link (href) in Rd files (#2972)
 
 # pkgdown 2.2.0

R/build-search-docs.R

@@ -64,11 +64,7 @@ build_sitemap <- function(pkg = ".") {
 #' search:
 #'   exclude: ['news/index.html']
 #' ```
-#' # Debugging and local testing
-#'
-#' Locally (as opposed to on GitHub Pages or Netlify for instance),
-#' search won't work if you simply use pkgdown preview of the static files.
-#' You can use `servr::httw("docs")` instead.
+#' # Debugging
 #'
 #' If search is not working, run `pkgdown::pkgdown_sitrep()` to eliminate
 #' common issues such as the absence of URL in the pkgdown configuration file

R/pkgdown-package.R

@@ -18,3 +18,5 @@ release_bullets <- function() {
     "Update `vignette/translations.Rmd` with any new languages"
   )
 }
+
+the <- new.env(parent = emptyenv())

R/preview.R

@@ -1,41 +1,69 @@
 #' Open site in browser
 #'
-#' `preview_site()` opens your pkgdown site in your browser. pkgdown has been
-#' carefully designed to work even when served from the file system like
-#' this; the only part that doesn't work is search. You can use `servr::httw("docs/")`
-#'  to create a server to make search work locally.
+#' `preview_site()` opens your pkgdown site in your browser, served via a
+#' local HTTP server. This enables dynamic features such as search to work
+#' correctly in preview.
 #'
+#' @seealso [stop_preview()] to stop the server.
 #' @inheritParams build_article
 #' @param path Path relative to destination
 #' @export
 preview_site <- function(pkg = ".", path = ".", preview = TRUE) {
-  path <- local_path(pkg, path)
+  pkg <- as_pkgdown(pkg)
+  abs_path <- local_path(pkg, path)
 
   check_bool(preview, allow_na = TRUE)
   if (is.na(preview)) {
     preview <- interactive() && !is_testing()
   }
 
   if (preview) {
+    root <- pkg$dst_path
+
+    if (is.null(the$server) || !identical(the$server_root, root)) {
+      the$server <- nanonext::http_server(
+        url = "http://127.0.0.1:0",
+        handlers = nanonext::handler_directory("/", root)
+      )
+      the$server$start()
+      the$server_root <- root
+    }
+
     cli::cli_inform(c(i = "Previewing site"))
-    utils::browseURL(path)
+    url <- paste0(the$server$url, "/", if (path != ".") path)
+    utils::browseURL(url)
+  }
+
+  invisible()
+}
+
+#' Stop HTTP preview
+#'
+#' Stops the HTTP server started by [preview_site()], if active. This can be
+#' called manually, but is not strictly necessary as the server is
+#' automatically stopped when previewing a new site or ending the R session.
+#'
+#' @export
+#' @keywords internal
+stop_preview <- function() {
+  if (!is.null(the$server)) {
+    the$server$close()
+    the$server <- NULL
+    the$server_root <- NULL
+    cli::cli_inform(c(i = "Stopped preview"))
   }
 
   invisible()
 }
 
 local_path <- function(pkg, path, call = caller_env()) {
-  pkg <- as_pkgdown(pkg)
   check_string(path, call = call)
 
   abs_path <- path_abs(path, pkg$dst_path)
   if (!file_exists(abs_path)) {
     cli::cli_abort("Can't find file {.path {path}}.", call = call)
   }
 
-  if (is_dir(abs_path)) {
-    abs_path <- path(abs_path, "index.html")
-  }
   abs_path
 }
 

man/build_search.Rd

@@ -1,3 +1,8 @@
+local_preview_clean <- function(env = caller_env()) {
+  the$server <- NULL
+  withr::defer(the$server <- NULL, envir = env)
+}
+
 test_that("checks its inputs", {
   pkg <- local_pkgdown_site()
 
@@ -19,6 +24,85 @@ test_that("local_path adds index.html if needed", {
   dir_create(path(pkg$dst_path, "reference"))
   expect_equal(
     local_path(pkg, "reference"),
-    path(pkg$dst_path, "reference", "index.html")
+    path(pkg$dst_path, "reference")
   )
 })
+
+test_that("preview starts new server when none exists", {
+  pkg <- local_pkgdown_site()
+  local_preview_clean()
+  urls <- character()
+  withr::local_options(browser = function(url) urls <<- c(urls, url))
+
+  preview_site(pkg, preview = TRUE)
+
+  expect_false(is.null(the$server))
+  expect_equal(the$server_root, pkg$dst_path)
+  expect_length(urls, 1)
+  expect_equal(urls[[1]], paste0(the$server$url, "/"))
+})
+
+test_that("preview reuses server for same root", {
+  pkg <- local_pkgdown_site()
+  local_preview_clean()
+  urls <- character()
+  withr::local_options(browser = function(url) urls <<- c(urls, url))
+
+  preview_site(pkg, preview = TRUE)
+  server1 <- the$server
+
+  file_create(path(pkg$dst_path, "test.html"))
+  preview_site(pkg, path = "test.html", preview = TRUE)
+
+  expect_identical(the$server, server1)
+  expect_length(urls, 2)
+  expect_equal(urls[[2]], paste0(server1$url, "/test.html"))
+})
+
+test_that("preview starts new server for different root", {
+  pkg1 <- local_pkgdown_site()
+  pkg2 <- local_pkgdown_site()
+  local_preview_clean()
+  urls <- character()
+  withr::local_options(browser = function(url) urls <<- c(urls, url))
+
+  preview_site(pkg1, preview = TRUE)
+  server1 <- the$server
+
+  preview_site(pkg2, preview = TRUE)
+
+  expect_false(identical(the$server, server1))
+  expect_equal(the$server_root, pkg2$dst_path)
+})
+
+test_that("stop_preview stops server", {
+  pkg <- local_pkgdown_site()
+  local_preview_clean()
+  withr::local_options(browser = function(url) {})
+
+  preview_site(pkg, preview = TRUE)
+  expect_false(is.null(the$server))
+
+  stop_preview()
+  expect_null(the$server)
+  expect_null(the$server_root)
+})
+
+test_that("preview constructs correct URLs for sub-paths", {
+  pkg <- local_pkgdown_site()
+  local_preview_clean()
+  urls <- character()
+  withr::local_options(browser = function(url) urls <<- c(urls, url))
+
+  dir_create(path(pkg$dst_path, "reference"))
+  file_create(path(pkg$dst_path, "reference", "foo.html"))
+
+  preview_site(pkg, preview = TRUE)
+  base_url <- the$server$url
+
+  preview_site(pkg, path = "reference", preview = TRUE)
+  expect_equal(urls[[2]], paste0(base_url, "/reference"))
+
+  preview_site(pkg, path = "reference/foo.html", preview = TRUE)
+  expect_equal(urls[[3]], paste0(base_url, "/reference/foo.html"))
+})