Merge pull request #59 from r-lib/f-abs

- In `find_root_file()`, if the first path component is already an absolute path, the path is returned unchanged without referring to the root. This allows mixing root-relative and absolute paths in `here::here()` (#59).

Author: krlmlr

R/absolute.R

@@ -0,0 +1,4 @@
+# adapted from fs
+is_absolute_path <- function(x) {
+  grepl("^[/\\\\~]|^[a-zA-Z]:[/\\\\]", x)
+}

R/criterion.R

@@ -11,7 +11,11 @@ make_fix_root_file <- function(criterion, path, subdir = NULL) {
     root <- file.path(root, subdir)
   }
   eval(bquote(function(...) {
-    file.path(.(root), ...)
+    if (!missing(..1) && is_absolute_path(..1)) {
+      file.path(...)
+    } else {
+      file.path(.(root), ...)
+    }
   }))
 }
 
@@ -73,17 +77,21 @@ root_criterion <- function(testfun, desc, subdir = NULL) {
     class = "root_criterion"
   )
 
-  #'   \item{`find_file`}{A function with `...` argument that returns
-  #'     for a path relative to the root specified by this criterion.
+  #'   \item{`find_file`}{A function with `...` and `path` arguments
+  #'     that returns a path relative to the root,
+  #'     as specified by this criterion.
   #'     The optional `path` argument specifies the starting directory,
   #'     which defaults to `"."`.
+  #'     The function forwards to [find_root_file()],
+  #'     which passes `...` directly to `file.path()`
+  #'     if the first argument is an absolute path.
   #'   }
   criterion$find_file <- make_find_root_file(criterion)
   #'   \item{`make_fix_file`}{A function with a `path` argument that
   #'      returns a function that finds paths relative to the root.  For a
   #'      criterion `cr`, the result of `cr$make_fix_file(".")(...)`
   #'      is identical to `cr$find_file(...)`. The function created by
-  #'      `make_fix_file` can be saved to a variable to be more independent
+  #'      `make_fix_file()` can be saved to a variable to be more independent
   #'      of the current working directory.
   #'   }
   #' }

R/file.R

@@ -1,13 +1,15 @@
 #' File paths relative to the root of a directory hierarchy
 #'
-#' Append an arbitrary number of path components to the root using
-#' [base::file.path()].
-#'
-#' The `find_root_file()` function is a simple wrapper around
-#' [find_root()] that
+#' `find_root_file()` is a wrapper around [find_root()] that
 #' appends an arbitrary number of path components to the root using
 #' [base::file.path()].
 #'
+#' This function operates on the notion of relative paths.
+#' The `...` argument is expected to contain a path relative to the root.
+#' If the first path component passed to `...` is already an absolute path,
+#' the `criterion` and `path` arguments are ignored,
+#' and `...` is forwarded to [file.path()].
+#'
 #' @param criterion A criterion, one of the predefined [criteria]
 #'   or created by [root_criterion()].
 #'   Will be coerced using [as_root_criterion()].
@@ -28,6 +30,10 @@
 #'
 #' @export
 find_root_file <- function(..., criterion, path = ".") {
+  if (!missing(..1) && is_absolute_path(..1)) {
+    return(file.path(...))
+  }
+
   root <- find_root(criterion = criterion, path = path)
   file.path(root, ...)
 }

README.Rmd

@@ -60,6 +60,16 @@ is_r_package$find_file()
 is_r_package$find_file("tests", "testthat")
 ```
 
+There is one exception: if the first component passed to `find_file()` is already an absolute path.
+This allows safely applying this function to paths that may be absolute or relative:
+
+```{r}
+setwd(file.path(pkg, "R"))
+path <- is_r_package$find_file()
+is_r_package$find_file(path, "tests", "testthat")
+```
+
+
 As long as you are sure that your working directory is somewhere inside your project, you can retrieve the project root.
 
 

README.md

@@ -12,7 +12,7 @@
 This package helps accessing files relative to a *project root* to [stop the working directory insanity](https://gist.github.com/jennybc/362f52446fe1ebc4c49f). It is a low-level helper package for the [here](https://here.r-lib.org/) package.
 
 <pre class='chroma'>
-<span class='kr'><a href='https://rdrr.io/r/base/library.html'>library</a></span><span class='o'>(</span><span class='nv'><a href='https://github.com/r-lib/rprojroot'>rprojroot</a></span><span class='o'>)</span></pre>
+<span class='kr'><a href='https://rdrr.io/r/base/library.html'>library</a></span><span class='o'>(</span><span class='nv'><a href='https://rprojroot.r-lib.org/'>rprojroot</a></span><span class='o'>)</span></pre>
 
 ## Example
 
@@ -21,11 +21,11 @@ The rprojroot package works best when you have a “project”: all related file
 <pre class='chroma'>
 <span class='nv'>dir</span> <span class='o'>&lt;-</span> <span class='nf'><a href='https://rdrr.io/r/base/tempfile.html'>tempfile</a></span><span class='o'>(</span><span class='o'>)</span>
 <span class='nv'>pkg</span> <span class='o'>&lt;-</span> <span class='nf'>usethis</span><span class='nf'>::</span><span class='nf'><a href='https://usethis.r-lib.org/reference/create_package.html'>create_package</a></span><span class='o'>(</span><span class='nv'>dir</span><span class='o'>)</span>
-<span class='c'>#&gt; <span style='color: #00BB00;'>✓</span><span> Creating </span><span style='color: #0000BB;'>'/tmp/RtmpG04Wy1/file2d4962962cd9/'</span></span>
-<span class='c'>#&gt; <span style='color: #00BB00;'>✓</span><span> Setting active project to </span><span style='color: #0000BB;'>'/tmp/RtmpG04Wy1/file2d4962962cd9'</span></span>
+<span class='c'>#&gt; <span style='color: #00BB00;'>✓</span><span> Creating </span><span style='color: #0000BB;'>'/tmp/RtmpBLE08t/file294c3c8acca7/'</span></span>
+<span class='c'>#&gt; <span style='color: #00BB00;'>✓</span><span> Setting active project to </span><span style='color: #0000BB;'>'/tmp/RtmpBLE08t/file294c3c8acca7'</span></span>
 <span class='c'>#&gt; <span style='color: #00BB00;'>✓</span><span> Creating </span><span style='color: #0000BB;'>'R/'</span></span>
 <span class='c'>#&gt; <span style='color: #00BB00;'>✓</span><span> Writing </span><span style='color: #0000BB;'>'DESCRIPTION'</span></span>
-<span class='c'>#&gt; <span style='color: #0000BB;'>Package</span><span>: file2d4962962cd9</span></span>
+<span class='c'>#&gt; <span style='color: #0000BB;'>Package</span><span>: file294c3c8acca7</span></span>
 <span class='c'>#&gt; <span style='color: #0000BB;'>Title</span><span>: What the Package Does (One Line, Title Case)</span></span>
 <span class='c'>#&gt; <span style='color: #0000BB;'>Version</span><span>: 0.0.0.9000</span></span>
 <span class='c'>#&gt; <span style='color: #0000BB;'>Date</span><span>: 2020-11-08</span></span>
@@ -50,18 +50,26 @@ R packages satisfy the `is_r_package` criterion. A criterion is an object that c
 <span class='nv'>is_r_package</span>
 <span class='c'>#&gt; Root criterion: contains a file `DESCRIPTION` with contents matching `^Package: `</span>
 <span class='nv'>is_r_package</span><span class='o'>$</span><span class='nf'>find_file</span><span class='o'>(</span><span class='o'>)</span>
-<span class='c'>#&gt; [1] "/tmp/RtmpG04Wy1/file2d4962962cd9"</span>
+<span class='c'>#&gt; [1] "/tmp/RtmpBLE08t/file294c3c8acca7"</span>
 <span class='nv'>is_r_package</span><span class='o'>$</span><span class='nf'>find_file</span><span class='o'>(</span><span class='s'>"tests"</span>, <span class='s'>"testthat"</span><span class='o'>)</span>
-<span class='c'>#&gt; [1] "/tmp/RtmpG04Wy1/file2d4962962cd9/tests/testthat"</span></pre>
+<span class='c'>#&gt; [1] "/tmp/RtmpBLE08t/file294c3c8acca7/tests/testthat"</span></pre>
 
 This works identically when starting from a subdirectory:
 
 <pre class='chroma'>
 <span class='nf'><a href='https://rdrr.io/r/base/getwd.html'>setwd</a></span><span class='o'>(</span><span class='nf'><a href='https://rdrr.io/r/base/file.path.html'>file.path</a></span><span class='o'>(</span><span class='nv'>pkg</span>, <span class='s'>"R"</span><span class='o'>)</span><span class='o'>)</span>
 <span class='nv'>is_r_package</span><span class='o'>$</span><span class='nf'>find_file</span><span class='o'>(</span><span class='o'>)</span>
-<span class='c'>#&gt; [1] "/tmp/RtmpG04Wy1/file2d4962962cd9"</span>
+<span class='c'>#&gt; [1] "/tmp/RtmpBLE08t/file294c3c8acca7"</span>
 <span class='nv'>is_r_package</span><span class='o'>$</span><span class='nf'>find_file</span><span class='o'>(</span><span class='s'>"tests"</span>, <span class='s'>"testthat"</span><span class='o'>)</span>
-<span class='c'>#&gt; [1] "/tmp/RtmpG04Wy1/file2d4962962cd9/tests/testthat"</span></pre>
+<span class='c'>#&gt; [1] "/tmp/RtmpBLE08t/file294c3c8acca7/tests/testthat"</span></pre>
+
+There is one exception: if the first component passed to `find_file()` is already an absolute path. This allows safely applying this function to paths that may be absolute or relative:
+
+<pre class='chroma'>
+<span class='nf'><a href='https://rdrr.io/r/base/getwd.html'>setwd</a></span><span class='o'>(</span><span class='nf'><a href='https://rdrr.io/r/base/file.path.html'>file.path</a></span><span class='o'>(</span><span class='nv'>pkg</span>, <span class='s'>"R"</span><span class='o'>)</span><span class='o'>)</span>
+<span class='nv'>path</span> <span class='o'>&lt;-</span> <span class='nv'>is_r_package</span><span class='o'>$</span><span class='nf'>find_file</span><span class='o'>(</span><span class='o'>)</span>
+<span class='nv'>is_r_package</span><span class='o'>$</span><span class='nf'>find_file</span><span class='o'>(</span><span class='nv'>path</span>, <span class='s'>"tests"</span>, <span class='s'>"testthat"</span><span class='o'>)</span>
+<span class='c'>#&gt; [1] "/tmp/RtmpBLE08t/file294c3c8acca7/tests/testthat"</span></pre>
 
 As long as you are sure that your working directory is somewhere inside your project, you can retrieve the project root.
 

tests/testthat/test-absolute.R

@@ -0,0 +1,24 @@
+# From fs
+describe("is_absolute_path", {
+  it("detects windows absolute paths", {
+    expect_true(is_absolute_path("c:\\"))
+    expect_true(is_absolute_path("c:/"))
+    expect_true(is_absolute_path("P:/"))
+    expect_true(is_absolute_path("P:\\"))
+    expect_true(is_absolute_path("\\\\server\\mountpoint\\"))
+    expect_true(is_absolute_path("\\foo"))
+    expect_true(is_absolute_path("\\foo\\bar"))
+  })
+  it("detects posix absolute paths", {
+    expect_false(is_absolute_path(""))
+    expect_false(is_absolute_path("foo/bar"))
+    expect_false(is_absolute_path("./foo/bar"))
+    expect_false(is_absolute_path("../foo/bar"))
+
+    expect_true(is_absolute_path("/"))
+    expect_true(is_absolute_path("/foo"))
+    expect_true(is_absolute_path("/foo/bar"))
+    expect_true(is_absolute_path("~/foo/bar"))
+  })
+})
+

tests/testthat/test-make.R

@@ -7,11 +7,17 @@ test_that("Shortcuts", {
   )
 
   R <- make_fix_root_file("testthat.R", getwd())
-  oldwd <- setwd("~")
-  on.exit(setwd(oldwd))
+
+  oldwd <- withr::local_dir("~")
 
   expect_equal(
     normalizePath(R("testthat"), mustWork = TRUE),
     normalizePath(oldwd, mustWork = TRUE)
   )
+
+  path <- R()
+  expect_equal(
+    normalizePath(R(path, "testthat"), mustWork = TRUE),
+    normalizePath(oldwd, mustWork = TRUE)
+  )
 })

tests/testthat/test-root.R

@@ -102,6 +102,11 @@ test_that("has_dir", {
       find_root_file("c", criterion = has_dir("b"), path = path),
       file.path(hierarchy(2L), "c")
     ),
+    # Absolute paths are stripped
+    expect_equal(
+      find_root_file(hierarchy(3L), "c", criterion = has_dir("b"), path = path),
+      hierarchy(4L)
+    ),
     expect_equal(find_root(has_dir("c"), path = path), hierarchy(3L)),
     expect_error(
       find_root(has_dir("e"), path = path),

vignettes/rprojroot.Rmd

@@ -60,12 +60,22 @@ root <- rprojroot::is_r_package
 The `root` object contains a function that helps locating files below the root
 of your package, regardless of your current working directory.
 If you are sure that your working directory is somewhere below your project's root,
-use the `root$find_file()` function:
+use the `root$find_file()` function.
+In this example here, we're starting in the `vignettes` subdirectory and find the original `DESCRIPTION` file:
 
 ```{r}
+basename(getwd())
 readLines(root$find_file("DESCRIPTION"), 3)
 ```
 
+There is one exception: if the first component passed to `find_file()` is already an absolute path.
+This allows safely applying this function to paths that may be absolute or relative:
+
+```{r}
+path <- root$find_file()
+readLines(root$find_file(path, "DESCRIPTION"), 3)
+```
+
 You can also
 construct an accessor to your root using the `root$make_fix_file()` function: