Merge branch 'isDirectory' into AI

DESCRIPTION

@@ -19,8 +19,8 @@ SystemRequirements: 'unrar' (Linux/macOS) or '7-Zip' (Windows) to work with '.ra
 URL: 
     https://reproducible.predictiveecology.org,
     https://github.com/PredictiveEcology/reproducible
-Date: 2024-12-03
-Version: 2.1.1.9012
+Date: 2024-12-07
+Version: 2.1.1.9014
 Authors@R: 
     c(person(given = "Eliot J B",
              family = "McIntire",

NEWS.md

@@ -1,6 +1,7 @@
 # reproducible 2.1.1
 
-* replace `httr` --> convert to use `httr2`
+* replace `httr` --> convert to use `httr2`;
+* `url` in `prepInputs` can now point to a directory; use `alsoExtract` to pick files by regular expression;
 * improved handling of symlinks in `remapFileNames()`;
 * pass `terra::project()` arguments `use_gdal` and `by_util` through `projectTo()` to `terra::project()`;
 

R/download.R

@@ -606,6 +606,8 @@ dlGeneric <- function(url, destinationPath, verbose = getOption("reproducible.ve
           break
         }
       }
+    } else {
+      messagePreProcess("If downloads fail; please install httr2 and try again")
     }
   }
 
@@ -628,6 +630,8 @@ dlGeneric <- function(url, destinationPath, verbose = getOption("reproducible.ve
 #' @param checkSums TODO
 #' @param fileToDownload TODO
 #' @inheritParams loadFromCache
+#' @inheritParams prepInputs
+#' @inheritParams preProcess
 #'
 downloadRemote <- function(url, archive, targetFile, checkSums, dlFun = NULL,
                            fileToDownload, messSkipDownload,

R/preProcess.R

@@ -719,7 +719,7 @@ preProcess <- function(targetFile = NULL, url = NULL, archive = NULL, alsoExtrac
   }
 
   failStop <- FALSE
-  if (isDirectory(url, mustExist = FALSE)) {
+  if (isTRUE(isDirectory(url, mustExist = FALSE))) {
     messagePrepInputs("url pointed to a directory; using targetFilePath:\n",
                       paste0(downloadFileResult$downloaded, collapse = "\n"))
     targetFilePath <- downloadFileResult$downloaded
@@ -836,7 +836,7 @@ preProcess <- function(targetFile = NULL, url = NULL, archive = NULL, alsoExtrac
                          verbose = getOption("reproducible.verbose", 1), team_drive = NULL) {
   # if (is.null(targetFile)) {
   guessedFile <- if (!is.null(url)) {
-    if (isDirectory(url, FALSE)) {
+    if (isTRUE(isDirectory(url, FALSE))) {
       gf <- NULL
     } else {
       gf <- file.path(destinationPath, basename2(url))

R/prepInputs.R

@@ -1382,7 +1382,8 @@ process <- function(out, funCaptured,
   args <- NULL
   # keep the ones for theFun
   # need to differentiate sf::st_read from sf::st_read(targetFile, TRUE) -- both are calls, both length 3; both have pkgColon
-  isAlreadyQuoted <- any(grepl("quote", theFun))
+  isAlreadyQuoted <- tryCatch(any(grepl("quote", theFun)), silent = TRUE,
+                              error = function(e) FALSE)
   if (isAlreadyQuoted) {
     theFun <- eval(theFun)
   }

R/robustDigest.R

@@ -1,3 +1,7 @@
+utils::globalVariables(c(
+  "..cnNotPaths", "..cnPaths"
+))
+
 ################################################################################
 #' Create reproducible digests of objects in R
 #'
@@ -367,10 +371,22 @@ setMethod(
     dig <- character(length(object))
     whNotPaths <- which(!Paths)
     whPaths <- which(Paths)
-    if (any(!Paths))
-      dig[whNotPaths] <- lapply(object[whNotPaths], .robustDigest, algo = algo, quick = TRUE, classOptions = classOptions)
-    if (any(Paths))
-      dig[whPaths] <- lapply(object[which(Paths)], .robustDigest, algo = algo, quick = quick, classOptions = classOptions)
+    # Can't use whNotPaths because data.table wouyld need ..whNotPaths ... so calculate it in the data.table
+    cn <- colnames(object)
+    cnNotPaths <- cn[whNotPaths]
+    cnPaths <- cn[whPaths]
+    if (any(!Paths)) {
+      if (is.data.table(object))
+        dig[whNotPaths] <- lapply(object[, ..cnNotPaths], .robustDigest, algo = algo, quick = TRUE, classOptions = classOptions)
+      else
+        dig[whNotPaths] <- lapply(object[, cnNotPaths], .robustDigest, algo = algo, quick = TRUE, classOptions = classOptions)
+    }
+    if (any(Paths)) {
+      if (is.data.table(object))
+        dig[whPaths] <- lapply(object[, ..cnPaths], .robustDigest, algo = algo, quick = TRUE, classOptions = classOptions)
+      else
+        dig[whPaths] <- lapply(object[, cnPaths], .robustDigest, algo = algo, quick = TRUE, classOptions = classOptions)
+    }
     .robustDigest(unlist(dig), quick = TRUE, algo = algo, classOptions = classOptions)
   }
 )