Add package_file. Fixes #985.

NAMESPACE

@@ -92,6 +92,7 @@ export(missing_s3)
 export(ns_env)
 export(on_path)
 export(package_deps)
+export(package_file)
 export(parse_deps)
 export(parse_ns_file)
 export(pkg_env)

NEWS.md

@@ -1,5 +1,9 @@
 # devtools 1.9.1.9000
 
+* `package_file()` lets you find files inside a package. It always first locates
+  the root directory of the package (i.e. the directory that contains 
+  `DESCRIPTION`) (#985).
+
 * `check(cran = TRUE)` also adds `--run-donttest` since you do need to test
   code in `\dontest()` for CRAN submission (#1002).
 

R/package.r

@@ -14,64 +14,63 @@
 as.package <- function(x = NULL, create = NA) {
   if (is.package(x)) return(x)
 
-  x <- check_dir(x)
+  x <- package_file(path = x)
   load_pkg_description(x, create = create)
 }
 
-
-check_dir <- function(x) {
-  if (is.null(x)) {
-    stop("Path is null", call. = FALSE)
+#' Find file in a package.
+#'
+#' It always starts by finding by walking up the path until it finds the
+#' root directory, i.e. a directory containing \code{DESCRIPTION}. If it
+#' cannot find the root directory, or it can't find the specified path, it
+#' will throw an error.
+#'
+#' @param ... Components of the path.
+#' @param path Place to start search for package directory.
+#' @export
+#' @examples
+#' \dontrun{
+#' package_file("figures", "figure_1")
+#' }
+package_file <- function(..., path = ".") {
+  if (!is.character(path) || length(path) != 1) {
+    stop("`path` must be a string.", call. = FALSE)
   }
-
-  # Normalise path and strip trailing slashes
-  x <- normalise_path(x)
-  x <- package_root(x) %||% x
-
-  if (!file.exists(x)) {
-    stop("Can't find directory ", x, call. = FALSE)
+  if (!file.exists(path)) {
+    stop("Can't find '", path, "'.", call. = FALSE)
   }
-  if (!file.info(x)$isdir) {
-    stop(x, " is not a directory", call. = FALSE)
+  if (!file.info(path)$isdir) {
+    stop("'", path, "' is not a directory.", call. = FALSE)
   }
 
-  x
-}
+  # Walk up to root directory
+  path <- strip_slashes(normalizePath(path))
+  while (!has_description(path)) {
+    path <- dirname(path)
 
-package_root <- function(path) {
-  if (is.package(path)) {
-    return(path$path)
+    if (is_root(path)) {
+      stop("Could not find package root.", call. = FALSE)
+    }
   }
-  stopifnot(is.character(path))
 
-  has_description <- function(path) {
-    file.exists(file.path(path, 'DESCRIPTION'))
-  }
-  path <- normalizePath(path, mustWork = FALSE)
-  while (!has_description(path) && !is_root(path)) {
-    path <- dirname(path)
-  }
+  file.path(path, ...)
+}
 
-  if (is_root(path)) {
-    NULL
-  } else {
-    path
-  }
+has_description <- function(path) {
+  file.exists(file.path(path, 'DESCRIPTION'))
 }
 
 is_root <- function(path) {
   identical(path, dirname(path))
 }
 
-normalise_path <- function(x) {
-  x <- sub("\\\\+$", "/", x)
+strip_slashes <- function(x) {
   x <- sub("/*$", "", x)
   x
 }
 
 # Load package DESCRIPTION into convenient form.
 load_pkg_description <- function(path, create) {
-  path <- normalizePath(path)
   path_desc <- file.path(path, "DESCRIPTION")
 
   if (!file.exists(path_desc)) {

tests/testthat/test-load.r

@@ -10,7 +10,7 @@ test_that("user is queried if no package structure present", {
     `devtools::interactive` = function() TRUE,
     `utils::menu` = function(...) stop("menu() called"),
     `devtools::setup` = function(...) stop("setup() called"),
-    `devtools::check_dir` = function(x) x,
+    `devtools::package_file` = function(..., path) file.path(path, ...),
     expect_error(load_all(file.path("testLoadDir", "R")),
                  "menu[(][)] called")
   )
@@ -21,7 +21,7 @@ test_that("setup is called upon user consent if no package structure present", {
     `devtools::interactive` = function() TRUE,
     `utils::menu` = function(choices, ...) match("Yes", choices),
     `devtools::setup` = function(...) stop("setup() called"),
-    `devtools::check_dir` = function(x) x,
+    `devtools::package_file` = function(..., path) file.path(path, ...),
     expect_error(load_all(file.path("testLoadDir", "R")),
                  "setup[(][)] called")
   )
@@ -31,7 +31,7 @@ test_that("setup is called if no package structure present", {
   with_mock(
     `utils::menu` = function(...) stop("menu() called"),
     `devtools::setup` = function(...) stop("setup() called"),
-    `devtools::check_dir` = function(x) x,
+    `devtools::package_file` = function(..., path) file.path(path, ...),
     expect_error(load_all(file.path("testLoadDir", "R"), create = TRUE),
                "setup[(][)] called")
   )
@@ -41,7 +41,7 @@ test_that("error is thrown if no package structure present", {
   with_mock(
     `utils::menu` = function(...) stop("menu() called"),
     `devtools::setup` = function(...) stop("setup() called"),
-    `devtools::check_dir` = function(x) x,
+    `devtools::package_file` = function(..., path) file.path(path, ...),
     expect_error(load_all(file.path("testLoadDir", "R"), create = FALSE),
                  "No description at")
   )