Checks if the project looks like an R project and asks for confirmati…

…on. #227

R/checkpoint.R

@@ -54,8 +54,10 @@
 #'
 #' @param verbose If TRUE, displays progress messages.
 #' 
-#' @param forceInstall If TRUE. forces the re-installation of all discovered packages and their dependencies. This is useful if, for some reason, the checkpoint archive becomes corrupted.
+#' @param forceInstall If TRUE, forces the re-installation of all discovered packages and their dependencies. This is useful if, for some reason, the checkpoint archive becomes corrupted.
 #'
+#' @param forceProject If TRUE, forces the checkpoint process, even if the provided project folder doesn't look like an R project. A commonly reported user problem is that they accidentally trigger the checkpoint process from their home folder, resulting in scanning many R files and downloading many packages. To prevent this, we use a heuristic to determine if the project folder looks like an R project. If the project folder is the home folder, and also contains no R files, then \code{checkpoint()} asks for confirmation to continue.
+
 #'
 #' @return Checkpoint is called for its side-effects (see the details section), but invisibly returns a list with elements:
 #' \itemize{
@@ -78,7 +80,10 @@ checkpoint <- function(snapshotDate, project = getwd(), R.version, scanForPackag
                        use.knitr = system.file(package="knitr") != "", 
                        auto.install.knitr = TRUE,
                        scan.rnw.with.knitr = FALSE,
-                       forceInstall = FALSE) {
+                       forceInstall = FALSE, 
+                       forceProject = FALSE) {
+
+  if(interactive()) validateProjectFolder(project)
 
   stopIfInvalidDate(snapshotDate)
 
@@ -240,3 +245,28 @@ mssg <- function(x, ...) if(x) message(...)
 
 correctR <- function(x) compareVersion(as.character(utils::packageVersion("base")), x) == 0
 
+
+# Scans for R files in a folder and the first level subfolders.
+#
+anyRfiles <- function(path = "."){
+  findRfiles <- function(path = "."){
+    pattern <- "\\.[rR]$|\\.[rR]nw$|\\.[rR]md$|\\.[rR]pres$|\\.[rR]proj$"
+    z <- list.files(path = path, pattern = pattern, full.names = TRUE)
+    normalizePath(z, winslash = "/")
+  }
+  dirs <- list.dirs(path = path, recursive = FALSE)
+  rfiles <- as.vector(unlist(sapply(dirs, findRfiles)))
+  length(rfiles) > 0
+}
+
+validateProjectFolder <- function(project) {
+  if(normalizePath(project) == normalizePath("~/") && !anyRfiles(project)){
+    message("This doesn't look like an R project directory.\n", 
+                 "Use forceProject = TRUE to force scanning"
+    )
+    answer = readline("Continue (y/n)? ")
+    if(tolower(answer) != "y"){
+      stop("Scanning stopped.", call. = FALSE)
+    }
+  }
+}

R/checkpoint_paths.R

@@ -44,7 +44,8 @@ authorizeFileSystemUse =
         stop("Can't use a non-directory as checkpoint root")}
     else {
       if(interactive()) {
-        answer = readline(paste("Can I create directory", checkpointRoot, "for internal checkpoint use?(y/n)\n"))
+        message(paste("Can I create directory", checkpointRoot, "for internal checkpoint use?\n"))
+        answer = readline("Continue (y/n)? ")
         if(tolower(answer) != "y")
           stop("Cannot proceed without access to checkpoint directory")}
       else {