Merge pull request #230 from phuse-org/nested

Resolve nested packages/projects error, new PR with CI for #217

R/file_and_path_utils.R

@@ -53,14 +53,14 @@ vt_path <- function(...){
 }
 
 
-#' @importFrom rprojroot find_root has_file is_r_package is_rstudio_project is_vcs_root
+#' @importFrom rprojroot find_root has_file is_r_package is_rstudio_project
 #' @rdname validation_paths
 #'
 #' @export
 vt_find_config <- function(){
 
   tryCatch({
-    root <- find_root(has_file(".here") | is_rstudio_project | is_r_package | is_vcs_root)
+    root <- find_root(has_file(".here") | is_rstudio_project | is_r_package )
   }, error = function(e){
     abort(
       paste0(
@@ -70,7 +70,8 @@ vt_find_config <- function(){
       class = "vt.validation_root_missing"
     )
   })
-
+
+
   tryCatch({
 
     config <- find_file("validation.yml", root, full_names = TRUE)
@@ -88,7 +89,9 @@ vt_find_config <- function(){
         abort(e)
       }
     })
-
+
+  check_for_child_projects_with_configs(root, config)
+
   if(length(config) > 1){
     config <- config_selector(config)
   }
@@ -113,13 +116,21 @@ vt_find_config <- function(){
 #' @importFrom withr with_dir
 #' @noRd
 #'
-find_file <- function(filename, ref = ".", full_names = FALSE){
+find_file <- function(filename, ref = ".", full_names = FALSE, regex = FALSE, include_hidden_files = FALSE){
 
   with_dir(new = normalizePath(ref,winslash = "/"), {
-    file_list <- list.files(path = ".", recursive = TRUE, full.names = TRUE)
+    file_list <- list.files(path = ".", recursive = TRUE, full.names = TRUE, all.files = include_hidden_files)
   })
-
-  file_path <- file_list[basename(file_list) %in% filename]
+
+  if(!regex){
+    file_path <- file_list[basename(file_list) %in% filename]
+  }else{
+    if(length(filename)>1){
+      abort("If `regex` is set to `TRUE`, filename is used as a pattern",
+            class = "vt.file_multiple_regex")
+    }
+    file_path <- file_list[grepl(pattern = filename,x = basename(file_list))]
+  }
 
   if(length(file_path) == 0){
     abort(paste0("File `",filename,"` not found."),
@@ -169,7 +180,62 @@ config_selector <- function(files, is_live = interactive()){
 }
 
 
+check_for_child_projects_with_configs <- function(root, configs){
+
+  if(length(configs) > 1){
+
+    root_files <- c(
+      tryCatch(find_file("[.]Rproj$", root, regex = TRUE, full_names = TRUE, include_hidden_files = TRUE),error = function(e){c()}),
+      tryCatch(find_file("[.]here$", root, regex = TRUE, full_names = TRUE, include_hidden_files = TRUE),error = function(e){c()}),
+      find_r_pkg_desc(root)
+    )
+
+    root_dirs <- unique(dirname(root_files))
+    root_child_dirs<- setdiff(root_dirs, root)
+
+    if(length(root_child_dirs) > 0){
+
+      roots_child_with_validation <- c()
+      for(root_path in root_child_dirs){
+        if(any(grepl(paste0(root_path,"/"),configs,fixed=TRUE))){
+          roots_child_with_validation <- c(
+            roots_child_with_validation,
+            root_path
+          )
+        }
+      }
+
+      roots_child_with_validation <- unique(roots_child_with_validation)
+
+      if(length(roots_child_with_validation) > 1){
+
+        ref_dirs <- gsub(paste0(normalizePath(getwd(),winslash = "/"),"/"),"",roots_child_with_validation,fixed = TRUE)
+
+        abort(
+          paste0("Nested projects with validation infrastructures exist. Set the working directory to one of:\n",
+               paste0("\t- `setwd(\"",ref_dirs,"\")`\n", collapse = "")),
+        class = "vt.multiple_validation_roots_found")
+      } 
+    }
+  }
 
+}
 
-
+find_r_pkg_desc <- function(root){
+
+  desc_files <- tryCatch(find_file("DESCRIPTION", root, regex = TRUE, full_names = TRUE, include_hidden_files = TRUE),error = function(e){c()})
+
+  if(is.null(desc_files)){
+    return(c())
+  }else{
+    desc_file_out <- c()
+    for(desc_file in desc_files){
+      contents <- readLines(con = desc_file)
+      if(any(grepl("^Package:", contents))){
+        desc_file_out <- c(desc_file_out, desc_file)
+      }
+    }
+    return(desc_file_out)
+  }
+}
 

R/validate.R

@@ -335,6 +335,7 @@ copy_validation_content <- function(pkg = ".", src = pkg){
 
   validation_directory <- file.path(get_config_working_dir(), "validation")
   validation_output_directory <- file.path(get_config_output_dir(),"validation")
+
 
   if(validation_directory != validation_output_directory){
     tryCatch({
@@ -343,20 +344,22 @@ copy_validation_content <- function(pkg = ".", src = pkg){
         dir.create(file.path(pkg, validation_output_directory),recursive = TRUE)
       }
 
+
       ## copy validation contents to validation output dir
       directory_copy(
         from = file.path(pkg, validation_directory),
         to = file.path(pkg, validation_output_directory),
         recursive = TRUE,
         overwrite = TRUE)
-
+      
       ## copy validation Rmd
       file.copy(
         from = file.path(pkg, "vignettes", get_config_report_rmd_name()),
         to = file.path(pkg, validation_output_directory),
         overwrite = TRUE
       )
-
+
+
       # copy and strip down code documentation to validation output dir
       roxygen_copy(
         from = file.path(pkg, "R"),

tests/testthat/test-find_config.R

@@ -1,13 +1,13 @@
 test_that("Find config when within a package with validation", {
-  
+
   withr::with_tempdir({
     quiet <- capture.output({
       vt_create_package(
-        "example.package", 
+        "example.package",
         open = FALSE)
     })
-    
-    
+
+
     withr::with_dir(new = "example.package", {
       expect_equal(
         vt_find_config(),
@@ -18,16 +18,16 @@ test_that("Find config when within a package with validation", {
 })
 
 test_that("Find config when within a package with validation when working dir is non-standard", {
-  
+
   withr::with_tempdir({
     quiet <- capture.output({
       vt_create_package(
-        "example.package", 
+        "example.package",
         working_dir = "inst",
         open = FALSE)
     })
-    
-    
+
+
     withr::with_dir(new = "example.package", {
       expect_equal(
         vt_find_config(),
@@ -40,15 +40,15 @@ test_that("Find config when within a package with validation when working dir is
 })
 
 test_that("Find config when within a validation packet", {
-  
+
   withr::with_tempdir({
       quiet <- capture.output({
-        vt_create_packet("example_packet", 
+        vt_create_packet("example_packet",
                          target = "example.package",
                          open = FALSE)
       })
-      
-      
+
+
       withr::with_dir(new = "example_packet", {
         expect_equal(
           vt_find_config(),
@@ -59,14 +59,14 @@ test_that("Find config when within a validation packet", {
       })
 
   })
-  
+
 })
 
 
 test_that("Informative error when outside a packet or package", {
-  
+
   withr::with_tempdir({
-    
+
     expect_error(
       vt_find_config(),
       paste0(
@@ -75,6 +75,37 @@ test_that("Informative error when outside a packet or package", {
       ),
       fixed = TRUE)
   })
+
+})
+
+test_that("Informative error when inside an Rproj, but multiple packets or packages are nested in a subfolders", {
+
+  withr::with_tempdir({
+
+    quiet <- capture.output({
+      usethis::create_project("test_project",open = FALSE)
+
+      vt_create_packet("test_project/example_packet", 
+                         target = "example.package",
+                         open = FALSE)
+      vt_create_packet("test_project/example_packet2", 
+                       target = "example.package2",
+                       open = FALSE)
+    })
+
+
+    withr::with_dir(new = "test_project", {
+
+      expect_error(
+        vt_find_config(),
+        "Nested projects with validation infrastructures exist. Set the working directory to one of:",
+        fixed = TRUE
+      )
+
+    })
+
+  })
 
 })
 
+

tests/testthat/test-validate_sequence.R

@@ -254,7 +254,8 @@ test_that("test building a validated bundle from source", {
         "")
     )
 
-  })})
+  })
+})
 
 test_that("test installing a validated bundle from source and rerunning report", {
   skip_if(!"valtools" %in% rownames(installed.packages()))