Merge pull request #61 from PredictiveEcology/nestedGHmodules

dealing with nested GH modules
PredictiveEcology · Jul 3, 2024 · 0249e86 · 0249e86
2 parents 7b97808 + 7639812
commit 0249e86
Show file tree

Hide file tree

Showing 3 changed files with 126 additions and 17 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -5,8 +5,8 @@ Description: Quickly setup a 'SpaDES' project directories and add modules using
 URL:
     https://spades-project.predictiveecology.org/,
     https://github.com/PredictiveEcology/SpaDES.project
-Date: 2024-06-05
-Version: 0.1.0.9003
+Date: 2024-06-21
+Version: 0.1.0.9004
 Authors@R: c(
     person("Eliot J B", "McIntire", email = "[email protected]",
            role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6914-8316")),

diff --git a/R/setupProject.R b/R/setupProject.R
@@ -570,12 +570,12 @@ setupProject <- function(name, paths, modules, packages,
   if (length(dotsSUB) > 1)
     dotsSUB <- dotsSUB[na.omit(match(origArgOrder, names(dotsSUB)))]
 
+  ## Ceres:  no longer necessary as setupModules now pulls "inner" modules into modulePath
+  # anyInnerModules <- unique(fileRelPathFromFullGHpath(names(modules)))
 
-  anyInnerModules <- unique(fileRelPathFromFullGHpath(names(modules)))
-
-  if (any(nzchar(anyInnerModules))) {
-    paths[["modulePath"]] <- unique(c(paths[["modulePath"]], file.path(paths[["modulePath"]], anyInnerModules)))
-  }
+  # if (any(nzchar(anyInnerModules))) {
+  #   paths[["modulePath"]] <- unique(c(paths[["modulePath"]], file.path(paths[["modulePath"]], anyInnerModules)))
+  # }
 
   pathsOrig <- paths
   extras <- setdiff(names(paths), spPaths)
@@ -1382,8 +1382,42 @@ setupModules <- function(name, paths, modules, inProject, useGit = getOption("Sp
     # modulePackages <- packagesInModules(modulePath = file.path(paths[["modulePath"]], dirname(m)),
     #                                     modules = modulesOrigNestedName)
     packages <- modulePackages[modulesOrigNestedName]
-    messageVerbose(yellow("  done setting up modules"), verbose = verbose, verboseLevel = 0)
 
+    ## check that we keep only the modules needed
+    actualModPaths <- normPath(file.path(paths$modulePath, m, modulesOrigNestedName))
+    wantedModPath <- normPath(file.path(paths$modulePath, modulesOrigNestedName))
+
+    isNested <- which(!actualModPaths %in% wantedModPath)
+
+    if (length(isNested)) {
+      ## subset to nest modules
+      actualModPaths2 <- actualModPaths[isNested]
+      wantedModPath2 <- wantedModPath[isNested]
+      modulesOrigNestedName2 <- modulesOrigNestedName[isNested]
+      modulesOrigPkgName2 <- modulesOrigPkgName[isNested]
+
+      moduleSuperFolder <- unique(normPath(file.path(paths$modulePath, modulesOrigPkgName2)))
+
+      ## modules were probably nested in a GH repo
+      actualModFiles <- sapply(actualModPaths2, list.files, recursive = TRUE, all.files = TRUE, full.names = TRUE, USE.NAMES = FALSE) |>
+        unlist()
+      newModFiles <- actualModFiles
+      for (ddir in dirname(actualModPaths2)) {
+        newModFiles <- sub(ddir, paths$modulePath, newModFiles)
+      }
+
+      invisible(sapply(unique(dirname(newModFiles)), dir.create, recursive = TRUE, showWarnings = FALSE))
+      out <- suppressWarnings(file.copy(actualModFiles, newModFiles, recursive = TRUE, overwrite = overwrite))
+
+      if (all(file.exists(newModFiles)) & all(dir.exists(wantedModPath2))) {
+        unlink(moduleSuperFolder, recursive = TRUE)
+      } else {
+        warnings("Could not copy module files to 'modulePath', leaving in original, potentially nested directory")
+        unlink(dirname(newModFiles), recursive = TRUE)
+      }
+    }
+
+    messageVerbose(yellow("  done setting up modules"), verbose = verbose, verboseLevel = 0)
   }
   names(packages) <- modulesOrig
   return(packages)
@@ -2888,6 +2922,10 @@ getStudyArea <- function(studyArea, paths, verbose = verbose) {
       studyArea <- reproducible::prepInputs(url = "https://drive.google.com/file/d/1DdtWeFYEhSRxXcAaJ_J6i8hP8YbfoC1q/view?usp=drive_link",
                                             destinationPath = paths$inputPath)
 
+      if (!is(studyArea, "SpatVector")) {
+        studyArea <- terra::vect(studyArea)
+      }
+
       # otherURL <- "https://www12.statcan.gc.ca/census-recensement/2021/geo/sip-pis/boundary-limites/files-fichiers/lpr_000a21a_e.zip"
       # message(otherURL)
       # a <- reproducible::prepInputs(url = otherURL)

diff --git a/tests/testthat/test-setupProject.R b/tests/testthat/test-setupProject.R
@@ -185,7 +185,6 @@ test_that("test setupProject - load packages using require argument", {
 })
 
 test_that("test setupProject - studyArea in lonlat", {
-
   skip_on_cran()
   setupTest(c("geodata", "filelock", "reproducible")) # filelock is unnecessary "first time", but errors if run again
   jurs <- "Al|Brit"
@@ -194,7 +193,7 @@ test_that("test setupProject - studyArea in lonlat", {
     out <- setupProject(studyArea = list(jurs), updateRprofile = FALSE, verbose = -2)
   )
 
-  expect_true(length(mess) == 0)
+  expect_true(length(mess) == 0)   ## failing. verbose = -2 not suppressing messages completely.
   expect_true(!is.null(out$studyArea))
   expect_true(is(out$studyArea, "SpatVector"))
   expect_true(NROW(unique(out$studyArea[["NAME_1"]])) == length(strsplit(jurs, "\\|")[[1]]))
@@ -255,7 +254,6 @@ test_that("projectPath is in a tempdir", {
 
 test_that("test setupProject - nested GH modules", {
   skip_on_cran()
-  skip("nested castor GH modules")
   setupTest() # setwd, sets .libPaths() to a temp
   ## set relative paths & modules
   warn <- capture_warnings(
@@ -268,7 +266,7 @@ test_that("test setupProject - nested GH modules", {
       )
     })
   )
-  expect_true(dir(out$paths$modulePath) %in% "dataCastor")   ## failing -- castor repo and module exist in m/
+  expect_true(dir(out$paths$modulePath) %in% "dataCastor")
 
   warn <- capture_warnings(
     mess <- capture_messages({
@@ -281,10 +279,9 @@ test_that("test setupProject - nested GH modules", {
       )
     })
   )
-  expect_true(all(dir(out$paths$modulePath) %in% c("dataCastor", "Biomass_borealDataPrep")))   ## failing -- someother issue.
+  expect_true(all(dir(out$paths$modulePath) %in% c("dataCastor", "Biomass_borealDataPrep")))
 })
 
-
 test_that("test setupProject - nested modulePath scfm B_bDP", {
   skip_on_cran()
   nam <- "test_SpaDES_project"
@@ -322,8 +319,6 @@ test_that("test setupProject - nested modulePath scfm B_bDP", {
   expect_true(length(out$params) == 4) # .globals for .studyAreaName
 })
 
-
-
 test_that("test setupProject - nested modulePath castorExamples", {
   skip_on_cran()
   nam <- "test_SpaDES_project4"
@@ -356,7 +351,7 @@ test_that("test setupProject - nested modulePath castorExamples", {
   # SpaDES.core::simInit2(out)
 })
 
-test_that("test setupProject - nested modulePath castorExamples", {
+test_that("test setupProject - install pkgs from .R script", {
   skip_on_cran()
   nam <- "test_SpaDES_project3"
   setupTest(name = nam) # setwd, sets .libPaths() to a temp
@@ -375,3 +370,79 @@ test_that("test setupProject - nested modulePath castorExamples", {
   pkgs <- extractPkgName(pkgList)
   expect_true(all(pkgs %in% ip$Package))
 })
+
+test_that("test setupProject - two types of nested GH modules + non-nested; rerun fewer modules", {
+  skip_on_cran()
+  setupTest() # setwd, sets .libPaths() to a temp
+
+  projName <- paste0("test_SpaDES_project_", .rndstr(1))
+
+  warn <- capture_warnings(
+    mess <- capture_messages({
+      out <- setupProject(
+        name = projName,
+        paths = list(modulePath = "m",
+                     scratchPath = tempdir()),
+        modules = c("bcgov/castor@main/R/SpaDES-modules/dataCastor",
+                    "bcgov/castor@main/R/SpaDES-modules/blockingCastor",
+                    "PredictiveEcology/Biomass_borealDataPrep@development",
+                    "PredictiveEcology/Biomass_core@development",
+                    "PredictiveEcology/scfm@development/modules/scfmLandcoverInit",
+                    "PredictiveEcology/scfm@development/modules/scfmRegime")
+      )
+    })
+  )
+
+  expect_true(all(dir(out$paths$modulePath) %in%
+                    c("dataCastor", "blockingCastor", "Biomass_borealDataPrep", "Biomass_core",
+                      "scfmLandcoverInit", "scfmRegime")))
+
+  ## test if modules previously downloaded disappear
+  warn <- capture_warnings(
+    mess <- capture_messages({
+      out <- setupProject(
+        name = projName,
+        paths = list(modulePath = "m",
+                     scratchPath = tempdir()),
+        modules = c("bcgov/castor@main/R/SpaDES-modules/dataCastor",
+                    "PredictiveEcology/Biomass_core@development",
+                    "PredictiveEcology/scfm@development/modules/scfmLandcoverInit")
+      )
+    })
+  )
+  expect_true(all(dir(out$paths$modulePath) %in%
+                    c("dataCastor", "blockingCastor", "Biomass_borealDataPrep", "Biomass_core",
+                      "scfmLandcoverInit", "scfmRegime")))
+  ## keep times of module files
+  fileRmds <- sapply(dir(out$paths$modulePath, full.names = TRUE), list.files, pattern = ".Rmd",
+         full.names = TRUE, USE.NAMES = FALSE) |>
+    unlist()
+  fileInfo <- file.info(fileRmds)
+
+  warn <- capture_warnings(
+    mess <- capture_messages({
+      out <- setupProject(
+        name = projName,
+        paths = list(modulePath = "m",
+                     scratchPath = tempdir()),
+        modules = c("bcgov/castor@main/R/SpaDES-modules/dataCastor",
+                    "PredictiveEcology/Biomass_core@development",
+                    "PredictiveEcology/scfm@development/modules/scfmLandcoverInit"),
+        overwrite = TRUE
+      )
+    })
+  )
+  ## still all there?
+  expect_true(all(dir(out$paths$modulePath) %in%
+                    c("dataCastor", "blockingCastor", "Biomass_borealDataPrep", "Biomass_core",
+                      "scfmLandcoverInit", "scfmRegime")))
+
+  ## have the right module files been updated?
+  fileInfo2 <- file.info(fileRmds)
+  rows <- grep("dataCastor|Biomass_core|scfmLandcoverInit", row.names(fileInfo))
+  expect_true(all(fileInfo[rows, "mtime"] < fileInfo2[rows, "mtime"]))
+
+  rows <- grep("dataCastor|Biomass_core|scfmLandcoverInit", row.names(fileInfo), invert = TRUE)
+  expect_true(all(fileInfo[rows, "mtime"] == fileInfo2[rows, "mtime"]))
+
+})