Improve build_vignettes() (#2425)

* Extract out `local_install()` code from build_rmd() and use in `build_vignettes()`

* Implement `local_package_copy()` and use in tests. This means we don't modify directories inside the package making cleaning up much easier, and avoiding a buglet in `usethis_use_directory()`

* Use more consistent messaging

* Change default to `quiet = FALSE`. Fixes #2360

Author: hadley

R/build-readme.R

@@ -28,9 +28,7 @@ build_rmd <- function(files, path = ".", output_options = list(), ..., quiet = T
     cli::cli_abort("Can't find file{?s}: {.path {files[!ok]}}.")
   }
 
-  cli::cli_inform(c(i = "Installing {.pkg {pkg$package}} in temporary library"))
-  withr::local_temp_libpaths()
-  install(pkg, upgrade = "never", reload = FALSE, quick = TRUE, quiet = quiet)
+  local_install(pkg, quiet = TRUE)
 
   # Ensure rendering github_document() doesn't generate HTML file
   output_options$html_preview <- FALSE

R/install.R

@@ -177,3 +177,11 @@ install_dev_deps <- function(pkg = ".",
     ...
   )
 }
+
+local_install <- function(pkg = ".", quiet = TRUE, env = parent.frame()) {
+  pkg <- as.package(pkg)
+
+  cli::cli_inform(c(i = "Installing {.pkg {pkg$package}} in temporary library"))
+  withr::local_temp_libpaths(.local_envir = env)
+  install(pkg, upgrade = "never", reload = FALSE, quick = TRUE, quiet = quiet)
+}

R/vignette-r.R

@@ -23,11 +23,11 @@ copy_vignettes <- function(pkg, keep_md) {
   ))
   out_cp <- vignettes$docs
 
-  cli::cli_alert_info("Moving {.file {path_file(out_mv)}} to {.path doc/}")
+  cli::cli_inform(c(i = "Moving {.file {path_file(out_mv)}} to {.path doc/}"))
   file_copy(out_mv, doc_dir, overwrite = TRUE)
   file_delete(out_mv)
 
-  cli::cli_alert_info("Copying {.file {path_file(out_cp)}} to {.path doc/}")
+  cli::cli_inform(c(i = "Copying {.file {path_file(out_cp)}} to {.path doc/}"))
   file_copy(out_cp, doc_dir, overwrite = TRUE)
 
   # Copy extra files, if needed
@@ -36,7 +36,7 @@ copy_vignettes <- function(pkg, keep_md) {
     return(invisible())
   }
 
-  cli::cli_alert_info("Copying extra files {.file {path_file(extra_files)}} to {.path doc/}")
+  cli::cli_inform(c(i = "Copying extra files {.file {path_file(extra_files)}} to {.path doc/}"))
   file_copy(extra_files, doc_dir)
 
   invisible()

R/vignettes.R

@@ -31,59 +31,52 @@ build_vignettes <- function(pkg = ".",
                             dependencies = "VignetteBuilder",
                             clean = TRUE,
                             upgrade = "never",
-                            quiet = TRUE,
+                            quiet = FALSE,
                             install = TRUE,
                             keep_md = TRUE) {
   pkg <- as.package(pkg)
-
-  deps <- remotes::dev_package_deps(pkg$path, dependencies)
-  update(deps, upgrade = upgrade)
+  save_all()
 
   vigns <- tools::pkgVignettes(dir = pkg$path)
   if (length(vigns$docs) == 0) return()
 
-  cli::cli_alert_info("Building {.pkg {pkg$package}} vignettes")
+  deps <- remotes::dev_package_deps(pkg$path, dependencies)
+  update(deps, upgrade = upgrade)
 
   if (isTRUE(install)) {
-    build <- function(pkg_path, clean, quiet, upgrade) {
-      withr::with_temp_libpaths(action = "prefix", {
-        devtools::install(pkg_path, upgrade = upgrade, reload = FALSE, quiet = quiet)
-        tools::buildVignettes(dir = pkg_path, clean = clean, tangle = TRUE, quiet = quiet)
-      })
-    }
-  } else {
-    build <- function(pkg_path, clean, quiet, upgrade) {
-      tools::buildVignettes(dir = pkg_path, clean = clean, tangle = TRUE, quiet = quiet)
-    }
+    local_install(pkg, quiet = TRUE)
   }
 
+  cli::cli_inform(c(i = "Building vignettes for {.pkg {pkg$package}}"))
   callr::r(
-    build,
-    args = list(pkg_path = pkg$path, clean = clean, upgrade = upgrade, quiet = quiet),
+    function(...) tools::buildVignettes(...),
+    args = list(
+      dir = pkg$path,
+      clean = clean,
+      tangle = TRUE,
+      quiet = quiet
+    ),
     show = !quiet,
-    spinner = FALSE,
-    stderr = "2>&1"
+    spinner = FALSE
   )
 
   # We need to re-run pkgVignettes now that they are built to get the output
   # files as well
+  cli::cli_inform(c(i = "Copying vignettes"))
   vigns <- tools::pkgVignettes(dir = pkg$path, source = TRUE, output = TRUE)
-
   copy_vignettes(pkg, keep_md)
-
   create_vignette_index(pkg, vigns)
 
   invisible(TRUE)
 }
 
 create_vignette_index <- function(pkg, vigns) {
+  cli::cli_inform(c(i = "Building vignette index"))
+
   usethis_use_directory(pkg, "Meta", ignore = TRUE)
   usethis_use_git_ignore(pkg, "/Meta/")
 
-  cli::cli_alert_info("Building vignette index")
-
   vignette_index <- ("tools" %:::% ".build_vignette_index")(vigns)
-
   vignette_index_path <- path(pkg$path, "Meta", "vignette.rds")
 
   saveRDS(vignette_index, vignette_index_path, version = 2L)
@@ -101,7 +94,7 @@ clean_vignettes <- function(pkg = ".") {
   vigns <- tools::pkgVignettes(dir = pkg$path)
   if (path_file(vigns$dir) != "vignettes") return()
 
-  cli::cli_alert_info("Cleaning built vignettes and index from {.pkg {pkg$package}}")
+  cli::cli_inform(c(i = "Cleaning built vignettes and index from {.pkg {pkg$package}}"))
 
   doc_path <- path(pkg$path, "doc")
 
@@ -117,7 +110,7 @@ clean_vignettes <- function(pkg = ".") {
 
   to_remove <- c(vig_rm, extra_rm, vig_index_rm)
   if (length(to_remove) > 0) {
-    cli::cli_alert_warning("Removing {.file {path_file(to_remove)}}")
+    cli::cli_inform(c(x = "Removing {.file {path_file(to_remove)}}"))
     file_delete(to_remove)
   }
 
@@ -129,7 +122,7 @@ clean_vignettes <- function(pkg = ".") {
 dir_delete_if_empty <- function(x) {
   if (dir_exists(x) && rlang::is_empty(dir_ls(x))) {
     dir_delete(x)
-    cli::cli_alert_warning("Removing {.file {path_file(x)}}")
+    cli::cli_inform(c(x = "Removing {.file {path_file(x)}}"))
   }
 }
 

man/build_vignettes.Rd

@@ -8,3 +8,10 @@ local_package_create <- function(envir = parent.frame()) {
 
   dir
 }
+
+local_package_copy <- function(path, env = parent.frame()) {
+  temp_path <- withr::local_tempdir(.local_envir = env)
+
+  dir_copy(path, temp_path, overwrite = TRUE)
+  temp_path
+}

tests/testthat/helper.R

@@ -111,3 +111,20 @@ test_that("install_dev_deps passes ellipsis args to remotes::install_deps", {
 })
 
 })
+
+test_that("vignettes built on install", {
+  skip_on_cran()
+
+  if (!pkgbuild::has_latex()) {
+    skip("pdflatex not available")
+  }
+
+  pkg <- local_package_copy(test_path("testVignettesBuilt"))
+
+  withr::local_temp_libpaths()
+  install(pkg, reload = FALSE, quiet = TRUE, build_vignettes = TRUE)
+
+  vigs <- vignette(package = "testVignettesBuilt")$results
+  expect_equal(nrow(vigs), 1)
+  expect_equal(vigs[3], "new")
+})

tests/testthat/test-install.R

@@ -2,105 +2,58 @@ test_that("Sweave vignettes copied into doc", {
   if (!pkgbuild::has_latex()) {
     skip("pdflatex not available")
   }
-  pkg <- test_path("testVignettes")
-  doc <- path(pkg, "doc")
-
-  suppressMessages(clean_vignettes(pkg))
-  expect_false(dir_exists(doc))
 
-  suppressMessages(build_vignettes(pkg))
-  expect_setequal(path_file(dir_ls(doc)), c("new.pdf", "new.R", "new.Rnw"))
+  pkg <- local_package_copy(test_path("testVignettes"))
 
-  suppressMessages(clean_vignettes(pkg))
-  expect_false(dir_exists(doc))
+  suppressMessages(build_vignettes(pkg, quiet = TRUE))
+  expect_setequal(
+    path_file(dir_ls(path(pkg, "doc"))),
+    c("new.pdf", "new.R", "new.Rnw")
+  )
 })
 
 test_that("Built files are updated", {
   # This test is time dependant and sometimes fails on CRAN because the systems are under heavy load.
   skip_on_cran()
-  if (!pkgbuild::has_latex()) {
-    skip("pdflatex not available")
-  }
-  pkg <- test_path("testVignettes")
-
-  suppressMessages(clean_vignettes(pkg))
-  suppressMessages(build_vignettes(pkg))
-  on.exit(suppressMessages(clean_vignettes(pkg)))
+  pkg <- local_package_copy(test_path("testMarkdownVignettes"))
 
+  suppressMessages(build_vignettes(pkg, quiet = TRUE))
   output <- dir_ls(path(pkg, "doc"), regexp = "new")
   first <- file_info(output)$modification_time
 
   Sys.sleep(.01)
-  suppressMessages(build_vignettes(pkg))
+  suppressMessages(build_vignettes(pkg, quiet = TRUE))
   second <- file_info(output)$modification_time
 
   expect_true(all(second > first))
 })
 
 test_that("Rmarkdown vignettes copied into doc", {
-  pkg <- test_path("testMarkdownVignettes")
+  pkg <- local_package_copy(test_path("testMarkdownVignettes"))
   doc <- path(pkg, "doc")
 
-  suppressMessages(clean_vignettes(pkg))
-  expect_false(dir_exists(doc))
-
-  suppressMessages(build_vignettes(pkg))
+  suppressMessages(build_vignettes(pkg, quiet = TRUE))
   expect_setequal(path_file(dir_ls(doc)), c("test.html", "test.R", "test.Rmd"))
-
-  suppressMessages(clean_vignettes(pkg))
-  expect_false(dir_exists(doc))
 })
 
-test_that("Extra files copied and removed", {
-  if (!pkgbuild::has_latex()) {
-    skip("pdflatex not available")
-  }
-
-  pkg <- test_path("testVignetteExtras")
-  doc <- path(pkg, "doc")
+test_that("extra files copied and removed", {
+  pkg <- local_package_copy(test_path("testMarkdownVignettes"))
+  writeLines("a <- 1", path(pkg, "vignettes", "a.R"))
 
   extras_path <- path(pkg, "vignettes", ".install_extras")
   writeLines("a.R", extras_path)
-  on.exit(file_delete(extras_path))
 
-  suppressMessages(clean_vignettes(pkg))
-  expect_false(file_exists(path(doc, "a.R")))
-
-  suppressMessages(build_vignettes(pkg))
-  expect_true(file_exists(path(doc, "a.R")))
+  suppressMessages(build_vignettes(pkg, quiet = TRUE))
+  expect_true(file_exists(path(pkg, "doc", "a.R")))
 
   suppressMessages(clean_vignettes(pkg))
-  expect_false(file_exists(path(doc, "a.R")))
-})
-
-test_that("vignettes built on install", {
-  skip_on_cran()
-
-  if (!pkgbuild::has_latex()) {
-    skip("pdflatex not available")
-  }
-
-  pkg <- test_path("testVignettesBuilt")
-
-  withr::local_temp_libpaths()
-  install(pkg, reload = FALSE, quiet = TRUE, build_vignettes = TRUE)
-
-  vigs <- vignette(package = "testVignettesBuilt")$results
-  expect_equal(nrow(vigs), 1)
-  expect_equal(vigs[3], "new")
+  expect_false(file_exists(path(pkg, "doc", "a.R")))
 })
 
 test_that(".gitignore updated when building vignettes", {
-  if (!pkgbuild::has_latex()) {
-    skip("pdflatex not available")
-  }
-
-  pkg <- test_path("testVignettes")
+  pkg <- local_package_copy(test_path("testMarkdownVignettes"))
   gitignore <- path(pkg, ".gitignore")
 
-  suppressMessages(clean_vignettes(pkg))
-  suppressMessages(build_vignettes(pkg))
-  on.exit(suppressMessages(clean_vignettes(pkg)))
-
+  suppressMessages(build_vignettes(pkg, quiet = TRUE))
   expect_true(all(c("/Meta/", "/doc/") %in% readLines(gitignore)))
 })