From 0440cbf93680ea329a4308634b1f2d2ea02cc47f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sun, 15 Dec 2024 11:32:35 +0100 Subject: [PATCH] scan_deps(): bookdown, pkgdown, quarto --- R/scan-deps-dep-types.R | 7 +- R/scan-deps.R | 117 +++++++++++++++--- R/utils.R | 5 - tests/testthat/_snaps/scan-deps.md | 11 ++ .../fixtures/scan/project-2/DESCRIPTION | 2 + .../fixtures/scan/project-2/_pkgdown.yml | 0 .../scan/project-2/bookdown/_bookdown.yml | 0 .../scan/project-2/quarto/_quarto.yml | 0 tests/testthat/test-scan-deps.R | 8 ++ 9 files changed, 123 insertions(+), 27 deletions(-) create mode 100644 tests/testthat/fixtures/scan/project-2/DESCRIPTION create mode 100644 tests/testthat/fixtures/scan/project-2/_pkgdown.yml create mode 100644 tests/testthat/fixtures/scan/project-2/bookdown/_bookdown.yml create mode 100644 tests/testthat/fixtures/scan/project-2/quarto/_quarto.yml diff --git a/R/scan-deps-dep-types.R b/R/scan-deps-dep-types.R index e2ad9d40..67a177f4 100644 --- a/R/scan-deps-dep-types.R +++ b/R/scan-deps-dep-types.R @@ -5,12 +5,7 @@ get_dep_type_from_path <- function(paths, orig = NULL) { if (!is.null(orig)) { # for DESCRIPTION we detect the type from the file itself dsc <- basename(paths) == "DESCRIPTION" - if (sum(dsc) > 0) { - withCallingHandlers( - tps[dsc] <- orig[dsc], - warning = function(w) browser() - ) - } + tps[dsc] <- orig[dsc] } tps } diff --git a/R/scan-deps.R b/R/scan-deps.R index ab47fd71..e841869d 100644 --- a/R/scan-deps.R +++ b/R/scan-deps.R @@ -83,13 +83,16 @@ scan_deps <- function(path = ".") { path <- tryCatch(find_project_root(path), error = function(...) path) - paths <- dir(path, pattern = "[.](R|r|Rmd|rmd|qmd)$", recursive = TRUE) + paths <- dir(path, pattern = scan_deps_pattern(), recursive = TRUE) if (file.exists(file.path(path, "DESCRIPTION"))) { paths <- c(paths, "DESCRIPTION") } if (file.exists(file.path(path, "NAMESPACE"))) { paths <- c(paths, "NAMESPACE") } + if (file.exists(file.path(path, "_pkgdown.yml"))) { + paths <- c(paths, "_pkgdown.yml") + } full_paths <- normalizePath(file.path(path, paths)) deps_list <- lapply(full_paths, scan_path_deps) deps <- do.call("rbind", c(list(scan_deps_df()), deps_list)) @@ -100,6 +103,44 @@ scan_deps <- function(path = ".") { deps } +scan_deps_pattern <- function() { + ptrns <- c( + "[.]R$", + "[.]r$", + "[.]Rmd$", + "[.]rmd$", + "[.]qmd$", + "^_bookdown[.]yml$", + "^_quarto[.]yml$", + NULL + ) + paste0("(", paste0(collapse = "|", ptrns), ")") +} + +scan_deps_file_type_use_basename <- function() { + # for these we don't use the extension but the basename + # to decide which parser to use + c( + "DESCRIPTION", + "NAMESPACE", + "_bookdown.yml", + "_pkgdown.yml", + "_quarto.yml", + "renv.lock", + NULL + ) +} + +scan_deps_file_type <- function(paths) { + ext <- tolower(file_ext(paths)) + bsn <- basename(paths) + ifelse( + bsn %in% scan_deps_file_type_use_basename() | is.na(ext), + bsn, + ext + ) +} + # ------------------------------------------------------------------------- # needs to increase as the deps discovry code changes, otherwise we don't @@ -146,31 +187,36 @@ scan_path_deps <- function(path) { code <- readBin(path, "raw", file.size(path)) # check if already known, set path - hash <- cli::hash_raw_xxhash(code) - cache <- get_deps_cache_path(hash) - if (file.exists(cache)) { - deps <- readRDS(cache) - if (!is.null(deps) && nrow(deps) > 0) { - deps$path <- path - deps$type <- get_dep_type_from_path(deps$path, deps$type) + should_cache <- scan_path_should_cache(path) + if (should_cache) { + hash <- cli::hash_raw_xxhash(code) + cache <- get_deps_cache_path(hash) + if (file.exists(cache)) { + deps <- readRDS(cache) + if (!is.null(deps) && nrow(deps) > 0) { + deps$path <- path + deps$type <- get_dep_type_from_path(deps$path, deps$type) + } + return(deps) } - return(deps) } # scan it if it is worth it, based on a quick check - maybe_has_deps <- file_extx(path) != "r" || + maybe_has_deps <- scan_deps_file_type(path) != "r" || length(grepRaw(re_r_dep(), code)) > 0 deps <- if (maybe_has_deps) { scan_path_deps_do(code, path) } # save it to the cache, but anonimize it first. If no deps, save NULL - deps_no_path <- deps - if (!is.null(deps_no_path) && nrow(deps_no_path) > 0) { - deps_no_path$path <- "" + if (should_cache) { + deps_no_path <- deps + if (!is.null(deps_no_path) && nrow(deps_no_path) > 0) { + deps_no_path$path <- "" + } + dir.create(dirname(cache), showWarnings = FALSE, recursive = TRUE) + saveRDS(deps_no_path, cache) } - dir.create(dirname(cache), showWarnings = FALSE, recursive = TRUE) - saveRDS(deps_no_path, cache) deps } @@ -199,8 +245,18 @@ scan_deps_df <- function( ) } +scan_path_should_cache <- function(paths) { + # we don't want to cache the ones that depend on the file + # name, because caching is content-based. + ! basename(paths) %in% c( + "_bookdown.yml", + "_pkgdown.yml", + "_quarto.yml" + ) +} + scan_path_deps_do <- function(code, path) { - ext <- file_extx(path) + ext <- scan_deps_file_type(path) switch( ext, ".r" = scan_path_deps_do_r(code, path), @@ -208,6 +264,9 @@ scan_path_deps_do <- function(code, path) { ".rmd" = scan_path_deps_do_rmd(code, path), "DESCRIPTION" = scan_path_deps_do_dsc(code, path), "NAMESPACE" = scan_path_deps_do_namespace(code, path), + "_bookdown.yml" = scan_path_deps_do_bookdown(code, path), + "_pkgdown.yml" = scan_path_deps_do_pkgdown(code, path), + "_quarto.yml" = scan_path_deps_do_quarto(code, path), stop("Cannot parse ", ext, " file for dependencies, internal error") ) } @@ -921,3 +980,29 @@ scan_path_deps_do_namespace <- function(code, path) { code = pkg ) } + +# ------------------------------------------------------------------------- + +scan_path_deps_do_bookdown <- function(code, path) { + scan_deps_df( + path = path, + package = "bookdown", + code = NA_character_ + ) +} + +scan_path_deps_do_pkgdown <- function(code, path) { + scan_deps_df( + path = path, + package = "pkgdown", + code = NA_character_ + ) +} + +scan_path_deps_do_quarto <- function(code, path) { + # renv does not include anything for quarto + # Do we want a 'dev' dependency for the quarto package? + # Maybe that's too opinionated? +} + +# ------------------------------------------------------------------------- diff --git a/R/utils.R b/R/utils.R index 7753e3fd..c6a05665 100644 --- a/R/utils.R +++ b/R/utils.R @@ -510,11 +510,6 @@ file_ext <- function(x) { re_match(x, "[.]([[:alnum:]]+)$")[[".match"]] } -file_extx <- function(x) { - ext <- tolower(file_ext(x)) - ifelse(is.na(ext), basename(x), ext) -} - # drop a prefix and a postfix, vectorized omit_pre_post <- function(x, pre = 0, post = 0) { substr(x, 1L + pre, nchar(x) - post) diff --git a/tests/testthat/_snaps/scan-deps.md b/tests/testthat/_snaps/scan-deps.md index f797d989..9a6efac5 100644 --- a/tests/testthat/_snaps/scan-deps.md +++ b/tests/testthat/_snaps/scan-deps.md @@ -381,3 +381,14 @@ 1 fixtures/scan/NAMESPACE stats stats * prod stats 1 1 1 2 fixtures/scan/NAMESPACE utils utils * prod utils 1 1 1 +# scan_path_deps_do_{bookdown,pkgdown,quarto} + + Code + scan_deps(project)[] + Output + # A data frame: 2 x 9 + path ref package version type code start_row start_column start_byte + + 1 bookdown/_bookdown.yml bookdown bookdown * prod 1 1 1 + 2 _pkgdown.yml pkgdown pkgdown * prod 1 1 1 + diff --git a/tests/testthat/fixtures/scan/project-2/DESCRIPTION b/tests/testthat/fixtures/scan/project-2/DESCRIPTION new file mode 100644 index 00000000..3749a8f8 --- /dev/null +++ b/tests/testthat/fixtures/scan/project-2/DESCRIPTION @@ -0,0 +1,2 @@ +Package: testpackage +Version: 1.0.0 diff --git a/tests/testthat/fixtures/scan/project-2/_pkgdown.yml b/tests/testthat/fixtures/scan/project-2/_pkgdown.yml new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/fixtures/scan/project-2/bookdown/_bookdown.yml b/tests/testthat/fixtures/scan/project-2/bookdown/_bookdown.yml new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/fixtures/scan/project-2/quarto/_quarto.yml b/tests/testthat/fixtures/scan/project-2/quarto/_quarto.yml new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/test-scan-deps.R b/tests/testthat/test-scan-deps.R index 83cd0616..fdecc2e1 100644 --- a/tests/testthat/test-scan-deps.R +++ b/tests/testthat/test-scan-deps.R @@ -483,3 +483,11 @@ test_that("scan_path_deps_do_namespace", { ), n = Inf) }) }) + +test_that("scan_path_deps_do_{bookdown,pkgdown,quarto}", { + local_reproducible_output(width = 500) + project <- test_path("fixtures/scan/project-2") + expect_snapshot({ + scan_deps(project)[] + }) +})