From 3009505944493acdaeeec6ff819acede1f39250a Mon Sep 17 00:00:00 2001
From: Jim Hester <james.f.hester@gmail.com>
Date: Tue, 11 Oct 2022 15:01:18 -0400
Subject: [PATCH] Don't use rprojroot after all

Just implement a depth restriction, so hopefully we don't recurse into
directories with thousands of files.
---
 DESCRIPTION |  1 -
 R/lint.R    | 37 ++++++++++++++++++++++++++-----------
 2 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index be9c45d4a..2cdee596e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -32,7 +32,6 @@ Imports:
     jsonlite,
     knitr,
     rex,
-    rprojroot,
     stats,
     utils,
     xml2 (>= 1.0.0),
diff --git a/R/lint.R b/R/lint.R
index f8da4b276..a70e2f627 100644
--- a/R/lint.R
+++ b/R/lint.R
@@ -370,30 +370,45 @@ 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) {
-  if (!dir.exists(path)) {
+  depth <- 2
+  while(!has_description(path)) {
     path <- dirname(path)
+    if (is_root(path) || depth <= 0) {
+      return(NULL)
+    }
+    depth <- depth - 1
   }
-  tryCatch(
-    rprojroot::find_root(path = path, criterion = rprojroot::is_r_package),
-    error = function(e) NULL
-  )
+  path
 }
 
 find_rproj_or_package <- function(path) {
-  if (!dir.exists(path)) {
+  path <- normalizePath(path, mustWork = FALSE)
+
+  depth <- 2
+  while(!(has_description(path) || has_rproj(path))) {
     path <- dirname(path)
+    if (is_root(path) || depth <= 0) {
+      return(NULL)
+    }
+    depth <- depth - 1
   }
-  tryCatch(
-    rprojroot::find_root(path = path, criterion = rprojroot::is_rstudio_project | rprojroot::is_r_package),
-    error = function(e) NULL
-  )
+  path
+}
+
+has_rproj <- function(path) {
+  length(head(Sys.glob(file.path(path, "*.Rproj")), n = 1L)) == 1
 }
 
 find_rproj_at <- function(path) {
   head(Sys.glob(file.path(path, "*.Rproj")), n = 1L)
 }
-
 is_root <- function(path) {
   identical(path, dirname(path))
 }