Add use_criteria() for customizable root-finding criteria

NAMESPACE

@@ -1,7 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(default_criteria)
 export(dr_here)
 export(here)
 export(i_am)
 export(set_here)
+export(use_criteria)
 import(rprojroot)

NEWS.md

@@ -2,6 +2,12 @@
 
 # here 1.0.2.9006 (2026-03-12)
 
+## Features
+
+- New `use_criteria()` function to customize root-finding criteria, e.g. to exclude Quarto project detection (#136).
+- New `default_criteria()` function to retrieve the default criterion names.
+- New `"here.criteria"` option to configure root-finding criteria before package load.
+
 ## Chore
 
 - Auto-update from GitHub Actions (#167).

R/criteria.R

@@ -0,0 +1,123 @@
+#' Customize root-finding criteria
+#'
+#' `use_criteria()` allows customizing which root-finding criteria are used
+#' by [here()] to determine the project root.
+#' This is useful when the default set of criteria detects a false positive,
+#' e.g. a nested Quarto project or RStudio project that should not be
+#' treated as the project root.
+#'
+#' @param criteria `[root_criterion]` or `[character]`\cr
+#'   Either a [rprojroot::root_criterion] object,
+#'   or a character vector of criterion names.
+#'   Supported names include `"is_here"` and all names in
+#'   [rprojroot::criteria], such as
+#'   `"is_rstudio_project"`, `"is_r_package"`,
+#'   `"is_quarto_project"`, `"is_vcs_root"`, etc.
+#'   Use [default_criteria()] to retrieve the default criteria.
+#'
+#' @details
+#' By default, the [here()] package uses a set of criteria
+#' that covers the most common project types.
+#' Use `use_criteria()` to change the criteria after loading the package.
+#'
+#' To configure the criteria before the package is loaded,
+#' set the `"here.criteria"` option to a character vector
+#' or a [rprojroot::root_criterion] object.
+#'
+#' @seealso [default_criteria()], [here()], [dr_here()]
+#' @return This function is called for its side effects.
+#' @export
+#' @examples
+#' \dontrun{
+#' # Use only VCS-related and .here file criteria
+#' use_criteria(c("is_here", "is_vcs_root"))
+#'
+#' # Exclude Quarto detection from the defaults
+#' use_criteria(setdiff(default_criteria(), "is_quarto_project"))
+#'
+#' # Pass a root_criterion object directly
+#' use_criteria(rprojroot::is_rstudio_project | rprojroot::is_vcs_root)
+#'
+#' # Reset to defaults
+#' use_criteria(default_criteria())
+#'
+#' # Set via option (before loading the package)
+#' options(here.criteria = c("is_here", "is_rstudio_project", "is_vcs_root"))
+#' }
+use_criteria <- function(criteria) {
+  crit <- resolve_criteria(criteria)
+  set_root_crit(crit)
+  do_refresh_here(".")
+  dr_here(show_reason = FALSE)
+  invisible()
+}
+
+#' Default root-finding criteria
+#'
+#' `default_criteria()` returns the names of the root-finding criteria
+#' used by default.
+#' The returned value can be customized by removing elements
+#' and passing the result to [use_criteria()].
+#'
+#' @return A character vector of criterion names.
+#' @seealso [use_criteria()], [here()], [dr_here()]
+#' @export
+#' @examples
+#' default_criteria()
+#' setdiff(default_criteria(), "is_quarto_project")
+default_criteria <- function() {
+  .default_criteria_names
+}
+
+.default_criteria_names <- c(
+  "is_here",
+  "is_rstudio_project",
+  "is_vscode_project",
+  "is_quarto_project",
+  "is_renv_project",
+  "is_r_package",
+  "is_remake_project",
+  "is_projectile_project",
+  "is_vcs_root"
+)
+
+resolve_criteria <- function(criteria) {
+  if (is_root_criterion(criteria)) {
+    return(criteria)
+  }
+
+  if (is.character(criteria)) {
+    if (length(criteria) == 0) {
+      stop("At least one criterion must be provided.", call. = FALSE)
+    }
+    return(names_to_criterion(criteria))
+  }
+
+  stop(
+    "`criteria` must be a character vector of criterion names or a `root_criterion` object.",
+    call. = FALSE
+  )
+}
+
+names_to_criterion <- function(names) {
+  crits <- lapply(names, get_criterion_by_name)
+  Reduce(`|`, crits)
+}
+
+get_criterion_by_name <- function(name) {
+  if (identical(name, "is_here")) {
+    return(is_here)
+  }
+
+  all_criteria <- rprojroot::criteria
+  if (name %in% names(all_criteria)) {
+    return(all_criteria[[name]])
+  }
+
+  stop(
+    "Unknown criterion: \"", name, "\".\n",
+    "Available criteria: ",
+    paste0("\"", c("is_here", names(all_criteria)), "\"", collapse = ", "),
+    call. = FALSE
+  )
+}

R/zzz.R

@@ -1,7 +1,8 @@
 # nocov start
 #' @import rprojroot
 .onLoad <- function(libname, pkgname) {
-  set_root_crit(is_here | is_rstudio_project | is_vscode_project | is_quarto_project | is_renv_project | is_r_package | is_remake_project | is_projectile_project | is_vcs_root)
+  criteria <- getOption("here.criteria", default = default_criteria())
+  set_root_crit(resolve_criteria(criteria))
   do_refresh_here(".")
 }
 # nocov end

tests/testthat/helper-local.R

@@ -15,7 +15,7 @@ local_project <- function(..., .env = parent.frame()) {
 }
 
 local_here <- function(path, ..., .env = parent.frame()) {
-  old_root <- .root_env
+  old_root <- .root_env$root
   do_refresh_here(path)
   withr::defer(.root_env$root <- old_root, envir = .env)
   invisible()

tests/testthat/test-criteria.R

@@ -0,0 +1,78 @@
+test_that("default_criteria() returns expected names", {
+  dc <- default_criteria()
+  expect_type(dc, "character")
+  expect_true(length(dc) > 0)
+  expect_true("is_here" %in% dc)
+  expect_true("is_rstudio_project" %in% dc)
+  expect_true("is_quarto_project" %in% dc)
+  expect_true("is_vcs_root" %in% dc)
+})
+
+test_that("resolve_criteria() works with character vector", {
+  crit <- resolve_criteria(c("is_here", "is_vcs_root"))
+  expect_true(is_root_criterion(crit))
+})
+
+test_that("resolve_criteria() works with root_criterion object", {
+  crit <- resolve_criteria(is_rstudio_project | is_vcs_root)
+  expect_true(is_root_criterion(crit))
+})
+
+test_that("resolve_criteria() errors on empty character", {
+  expect_error(resolve_criteria(character(0)), "At least one criterion")
+})
+
+test_that("resolve_criteria() errors on unknown name", {
+  expect_error(resolve_criteria("not_a_real_criterion"), "Unknown criterion")
+})
+
+test_that("resolve_criteria() errors on invalid type", {
+  expect_error(resolve_criteria(42), "character vector")
+})
+
+test_that("use_criteria() works with character vector", {
+  local_project()
+  local_here(here())
+
+  expect_message(
+    use_criteria(c("is_here", "is_rstudio_project", "is_vcs_root")),
+    "starts at"
+  )
+})
+
+test_that("use_criteria() works with root_criterion object", {
+  local_project()
+  local_here(here())
+
+  expect_message(
+    use_criteria(is_rstudio_project | is_vcs_root),
+    "starts at"
+  )
+})
+
+test_that("use_criteria() excludes quarto correctly", {
+  skip_if_not_installed("withr")
+
+  # Create a temp dir with both .git and a nested quarto project
+  tmpdir <- tempfile("here_test")
+  dir.create(tmpdir)
+  dir.create(file.path(tmpdir, ".git"))
+  website_dir <- file.path(tmpdir, "website")
+  dir.create(website_dir)
+  writeLines("project:", file.path(website_dir, "_quarto.yml"))
+  withr::defer(unlink(tmpdir, recursive = TRUE))
+
+  # With default criteria, from website dir, root should be website/
+  crit_default <- resolve_criteria(default_criteria())
+  withr::with_dir(website_dir, {
+    root_default <- crit_default$find_file(path = ".")
+    expect_equal(normalizePath(root_default), normalizePath(website_dir))
+  })
+
+  # Without quarto, from website dir, root should be parent
+  crit_no_quarto <- resolve_criteria(setdiff(default_criteria(), "is_quarto_project"))
+  withr::with_dir(website_dir, {
+    root_no_quarto <- crit_no_quarto$find_file(path = ".")
+    expect_equal(normalizePath(root_no_quarto), normalizePath(tmpdir))
+  })
+})