Use rprojroot rather than built in functions to find the rproj (if th…

…ere is one)

We were running into catastrophic performance taking 20+ minutes on
CRAN's check machines with the previous code, likely because when
searching for Rprojects a parent directory containing thousands of files
was being searched.

I believe using rprojroot should avoid this.

DESCRIPTION

@@ -32,6 +32,7 @@ Imports:
     jsonlite,
     knitr,
     rex,
+    rprojroot,
     stats,
     utils,
     xml2 (>= 1.0.0),

R/lint.R

@@ -370,39 +370,28 @@ reorder_lints <- function(lints) {
   )]
 }
 
-has_description <- function(path) {
-  desc_info <- file.info(file.path(path, "DESCRIPTION"))
-  !is.na(desc_info$size) && desc_info$size > 0.0 && !desc_info$isdir
-}
-
 find_package <- function(path) {
-  path <- normalizePath(path, mustWork = FALSE)
-
-  while (!has_description(path)) {
+  if (!dir.exists(path)) {
     path <- dirname(path)
-    if (is_root(path)) {
-      return(NULL)
-    }
   }
-
-  path
-}
-
-find_rproj_at <- function(path) {
-  head(list.files(path = path, pattern = "\\.Rproj$", full.names = TRUE), 1L)
+  tryCatch(
+    rprojroot::find_root(path = path, criterion = rprojroot::is_r_package),
+    error = function(e) NULL
+  )
 }
 
-find_rproj <- function(path) {
-  path <- normalizePath(path, mustWork = FALSE)
-
-  while (length(res <- find_rproj_at(path)) == 0L) {
+find_rproj_or_package <- function(path) {
+  if (!dir.exists(path)) {
     path <- dirname(path)
-    if (is_root(path)) {
-      return(NULL)
-    }
   }
+  tryCatch(
+    rprojroot::find_root(path = path, criterion = rprojroot::is_rstudio_project | rprojroot::is_r_package),
+    error = function(e) NULL
+  )
+}
 
-  res
+find_rproj_at <- function(path) {
+  head(Sys.glob(file.path(path, "*.Rproj")), n = 1L)
 }
 
 is_root <- function(path) {

R/settings.R

@@ -108,20 +108,12 @@ find_default_encoding <- function(filename) {
     return(NULL)
   }
 
-  pkg_path <- find_package(filename)
-  rproj_file <- find_rproj(filename)
-  pkg_enc <- get_encoding_from_dcf(file.path(pkg_path, "DESCRIPTION"))
-  rproj_enc <- get_encoding_from_dcf(rproj_file)
-
-  if (!is.null(rproj_file) && !is.null(pkg_path) && startsWith(rproj_file, pkg_path)) {
-    # Check precedence via directory hierarchy.
-    # Both paths are normalized so checking if rproj_file is within pkg_path is sufficient.
-    # Let Rproj file take precedence
-    return(rproj_enc %||% pkg_enc)
-  } else {
-    # Let DESCRIPTION file take precedence if .Rproj file is further up the directory hierarchy
-    return(pkg_enc %||% rproj_enc)
+  root_path <- find_rproj_or_package(filename)
+  rproj_enc <- get_encoding_from_dcf(find_rproj_at(root_path))
+  if (!is.null(rproj_enc)) {
+    return(rproj_enc)
   }
+  rproj_enc
 }
 
 get_encoding_from_dcf <- function(file) {

tests/testthat/test-settings.R

@@ -122,16 +122,16 @@ test_that("it has a smart default for encodings", {
   read_settings(NULL)
   expect_equal(settings$encoding, "UTF-8")
 
-  proj_file <- file.path("dummy_projects", "project", "metropolis-hastings-rho.R")
-  pkg_file <- file.path("dummy_packages", "cp1252", "R", "metropolis-hastings-rho.R")
+  proj_file <- test_path("dummy_projects", "project", "metropolis-hastings-rho.R")
+  pkg_file <- test_path("dummy_packages", "cp1252", "R", "metropolis-hastings-rho.R")
 
   expect_equal(
-    normalizePath(find_rproj(proj_file), winslash = "/"),
-    normalizePath(file.path("dummy_projects", "project", "project.Rproj"), winslash = "/")
+    normalizePath(find_rproj_at(find_rproj_or_package(proj_file)), winslash = "/"),
+    normalizePath(test_path("dummy_projects", "project", "project.Rproj"), winslash = "/")
   )
   expect_equal(
     normalizePath(find_package(pkg_file), winslash = "/"),
-    normalizePath(file.path("dummy_packages", "cp1252"), winslash = "/")
+    normalizePath(test_path("dummy_packages", "cp1252"), winslash = "/")
   )
 
   expect_equal(find_default_encoding(proj_file), "ISO8859-1")