Merge branch 'dev'

* dev:
  Checks if the project looks like an R project and asks for confirmation. #227
  Add functionality to force re-installation of all discovered packages and dependencies. #183
  Run Travis tests also for NOT_CRAN="false"
  Test if logfile exists must be skipped on CRAN #225
  Add function to list checkpoint archives and remove archives #228

.travis.yml

@@ -5,7 +5,9 @@ r:
 
 sudo: required
 
-env: NOT_CRAN="true"
+env: 
+  - NOT_CRAN="true"
+  - NOT_CRAN="false"
 
 r_binary_packages:
   - testthat

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 export(checkpoint)
+export(checkpointArchives)
+export(checkpointRemove)
 export(getValidSnapshots)
 export(setSnapshot)
 importFrom(utils,Stangle)

R/checkpoint.R

@@ -53,7 +53,11 @@
 #' @param scan.rnw.with.knitr If TRUE, uses \code{\link[knitr]{knit}} to parse \code{.Rnw} files, otherwise use \code{\link[utils]{Sweave}}
 #'
 #' @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 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{
@@ -75,7 +79,11 @@ checkpoint <- function(snapshotDate, project = getwd(), R.version, scanForPackag
                        verbose=TRUE,
                        use.knitr = system.file(package="knitr") != "", 
                        auto.install.knitr = TRUE,
-                       scan.rnw.with.knitr = FALSE) {
+                       scan.rnw.with.knitr = FALSE,
+                       forceInstall = FALSE, 
+                       forceProject = FALSE) {
+
+  if(interactive()) validateProjectFolder(project)
 
   stopIfInvalidDate(snapshotDate)
 
@@ -135,8 +143,20 @@ checkpoint <- function(snapshotDate, project = getwd(), R.version, scanForPackag
     files.not.parsed <- character(0)
   }
 
-
-  packages.to.install <- setdiff(packages.detected, c(packages.installed, exclude.packages))
+  if(forceInstall && packages.detected > 0){
+    to_remove <- as.vector(unlist(tools::package_dependencies(packages.detected)))
+    to_remove <- c(packages.detected, to_remove)
+    tryCatch(
+      suppressMessages(suppressWarnings(
+        utils::remove.packages(to_remove)
+      )),
+      error = function(e)e
+    )
+    packages.to.install <- packages.detected
+    packages.installed <- character(0)
+  } else {
+    packages.to.install <- setdiff(packages.detected, c(packages.installed, exclude.packages))
+  }
 
   # detach checkpointed pkgs already loaded
 
@@ -174,16 +194,16 @@ checkpoint <- function(snapshotDate, project = getwd(), R.version, scanForPackag
                                     INSTALL_opts = "--no-lock")
           )
         }, type = "message")
-      }
-      checkpoint_log(
-        download_messages,
-        snapshotDate = snapshotDate,
-        pkg,
-        file = file.path(
-          checkpointPath(snapshotDate, checkpointLocation, type = "root"),
-          "checkpoint_log.csv")
+        checkpoint_log(
+          download_messages,
+          snapshotDate = snapshotDate,
+          pkg,
+          file = file.path(
+            checkpointPath(snapshotDate, checkpointLocation, type = "root"),
+            "checkpoint_log.csv")
         )
-
+      }
+
     }
   } else if(length(packages.detected > 0)){
     mssg(verbose, "All detected packages already installed")
@@ -225,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 {

R/checkpoint_remove.R

@@ -0,0 +1,36 @@
+
+
+#' List checkpoint archives on disk.
+#' 
+#' @inheritParams checkpoint
+#' @export
+#' @seealso checkpointRemove
+#' @example inst/examples/example_remove.R
+checkpointArchives <- function(checkpointLocation = "~/"){
+  z <- list.files(path = paste0(normalizePath(checkpointLocation), ".checkpoint"), 
+                  pattern = "\\d{4}-\\d{2}-\\d{2}", 
+                  full.names = TRUE)
+  normalizePath(z, winslash = "/")
+}
+
+#' Remove checkpoint archive from disk.
+#' 
+#' @inheritParams checkpoint
+#' @export
+#' @seealso checkpointArchives
+#' @example inst/examples/example_remove.R
+checkpointRemove <- function(snapshotDate, checkpointLocation = "~/"){
+  z <- list.files(path = paste0(normalizePath(checkpointLocation), ".checkpoint"), 
+                  pattern = paste0(snapshotDate, "$"), 
+                  full.names = TRUE)
+  to_delete <- normalizePath(z, winslash = "/")
+  if(length(to_delete) == 0) {
+    warning("archive not found")
+    invisible(NULL)
+  } else {
+    res <- unlink(to_delete, recursive = TRUE)
+    if(res == 0) message("successfully removed archive")
+  }
+}
+
+

R/mranUrl.R

@@ -107,7 +107,7 @@ setCheckpointUrl <- function(url){
 
 
 tryUrl <- function(url){
-  con <- tryCatch(url(url), error = function(e)e)
+  con <- suppressWarnings(tryCatch(url(url), error = function(e)e))
   msg <- paste0(
     "Invalid value for mranRootUrl.\n", 
     "Ensure you use the correct http://,  https:// or file:/// prefix."
@@ -129,7 +129,7 @@ getValidSnapshots <- function(mranRootUrl = mranUrl()){
   text <- if (inherits(con, "file")) {
     dir(summary(con)$description)
   } else {
-    tryCatch(readLines(con, warn = TRUE), error = function(e) e)
+    suppressWarnings(tryCatch(readLines(con, warn = TRUE), error = function(e) e))
   }
   if (inherits(text, "error")) {
     stop(sprintf("Unable to download from MRAN: %s", 

inst/examples/example_remove.R

@@ -0,0 +1,5 @@
+checkpointArchives()
+\dontrun{
+checkpointRemove("2016-10-01")
+}
+

tests/testthat/test-3-checkpoint.R

@@ -86,12 +86,12 @@ test_checkpoint <- function(https = FALSE, snap.dates){
           expect_false(
             isTRUE(
               shows_message("Scanning for packages used in this project",
-                checkpoint(snap_date, checkpointLocation = checkpointLocation,
-                           project = project_root, scanForPackages=FALSE)
+                            checkpoint(snap_date, checkpointLocation = checkpointLocation,
+                                       project = project_root, scanForPackages=FALSE)
               )
             ))
         })
-
+        
         it("installs all packages correctly in local lib", {
           pdbMRAN <- available.packages(contriburl = contrib.url(repos = getSnapshotUrl(snap_date)))
           pdbLocal <- installed.packages(fields = "Date/Publication", noCache = TRUE)
@@ -130,7 +130,7 @@ test_checkpoint <- function(https = FALSE, snap.dates){
           )
 
         })
-
+        
         it("uses correct MRAN url", {
           expect_equal(
             getOption("repos"),
@@ -144,16 +144,19 @@ test_checkpoint <- function(https = FALSE, snap.dates){
             normalizePath(.libPaths()[1], winslash = "/")
           )
         })
+
+        it("writes log file in csv format", {
+          logfile <- file.path(checkpointLocation, ".checkpoint/checkpoint_log.csv")
+          expect_true(file.exists(logfile))
+          logdata <- read.csv(logfile, nrows = 5)
+          expect_is(logdata, "data.frame")
+          expect_length(names(logdata), 4)
+        })
+
       })
+
     })
 
-    test_that("checkpoint writes log file", {
-      logfile <- file.path(checkpointLocation, ".checkpoint/checkpoint_log.csv")
-      expect_true(file.exists(logfile))
-      logdata <- read.csv(logfile, nrows = 5)
-      expect_is(logdata, "data.frame")
-      expect_length(names(logdata), 4)
-    })
 
     # cleanup
     cleanCheckpointFolder(snap_date, checkpointLocation = checkpointLocation)