@@ -6,7 +6,7 @@
Loading
6 6
#' Determine package dependencies
7 7
#'
8 8
#' This will first look in local filesystem (in \code{.libPaths()}) and will use
9 -
#' a local package to find its dependencies. If the package doesn't exist locally, 
9 +
#' a local package to find its dependencies. If the package does not exist locally, 
10 10
#' including whether it is the correct version, then it will look in (currently) 
11 11
#' \code{CRAN} and its archives (if the current \code{CRAN} version is not
12 12
#' the desired version to check). It will also look on \code{GitHub} if the 
@@ -238,7 +238,6 @@
Loading
238 238
  needed <- Map(desc_path = desc_paths, pkg = packagesToCheck, 
239 239
                pkgNoVersion = pkgsNoVersionToCheck, 
240 240
                function(desc_path, pkg, pkgNoVersion) {
241 -
    browser(expr = exists("aaaaa"))
242 241
    if (!file.exists(desc_path)) {
243 242
      pkgDT <- parseGitHub(pkg)
244 243
      if ("GitHub" %in% pkgDT$repoLocation) {
@@ -290,7 +289,7 @@
Loading
290 289
          td <- tempdir2(pkgName)
291 290
          packageTD <- file.path(td, pkgName)
292 291
          if (!dir.exists(packageTD)) {
293 -
            message("available.packages() doesn't have correct information on package dependencies for ", pkgName, 
292 +
            message("available.packages() does not have correct information on package dependencies for ", pkgName, 
294 293
                    "; downloading tar.gz")
295 294
            verNum <- extractVersionNumber(pkg)
296 295
            if (is.na(verNum)) {

@@ -10,7 +10,7 @@
Loading
10 10
  toset <- !(names(opts.Require) %in% names(opts))
11 11
  if (any(toset)) options(opts.Require[toset])
12 12
  if (!is.null(getOption("Require.RPackageCache")))
13 -
    checkPath(getOption("Require.RPackageCache"), create = TRUE)
13 +
    checkPath(rpackageFolder(getOption("Require.RPackageCache")), create = TRUE)
14 14
15 15
  if (getOption("Require.persistentPkgEnv")) {
16 16
    if (file.exists(.thePersistentFile)) {

@@ -5,8 +5,21 @@
Loading
5 5
#' @export
6 6
#' @param packageVersionFile A filename to save the packages and their currently
7 7
#'        installed version numbers. Defaults to \code{".packageVersions.txt"}.
8 +
#'        If this is specified to be \code{NULL}, the function will return the exact
9 +
#'        \code{Require} call needed to install all the packages at their current
10 +
#'        versions. This can be useful to add to a script to allow for reproducibility of
11 +
#'        a script.
8 12
#' @param libPaths The path to the local library where packages are installed.
9 13
#'        Defaults to the \code{.libPaths()[1]}.
14 +
#' @param exact Logical. If \code{TRUE}, the default, then for GitHub packages, it
15 +
#'        will install the exact SHA, rather than the head of the account/repo@branch. For
16 +
#'        CRAN packages, it will install the exact version. If \code{FALSE}, then GitHub
17 +
#'        packages will identify their branch if that had been specified upon installation, 
18 +
#'        not a SHA. If the package had been installed with reference to a SHA, then it
19 +
#'        will return the SHA as it does not know what branch it came from. 
20 +
#'        Similarly, CRAN packages will
21 +
#'        report their version and specify with a \code{>=}, allowing a subsequent user
22 +
#'        to install with a minimum version number, as opposed to an exact version number.
10 23
#' @details
11 24
#' A file is written with the package names and versions of all packages within \code{libPaths}.
12 25
#' This can later be passed to \code{Require}.
@@ -39,10 +52,22 @@
Loading
39 52
#' setLibPaths("~/RPackages") # start with an empty folder for new 
40 53
#'                            # library to minimize package version conflicts
41 54
#' Require(packageVersionFile = fileName)
55 +
#' 
56 +
#' # Passing NULL --> results in output to console with exact Require call to 
57 +
#' #   achieve the packages installations
58 +
#' pkgSnapshot(NULL, libPaths = .libPaths()[1], exact = FALSE)
59 +
#' 
60 +
#' # Or shunt it to a file
61 +
#' sink("packages2.R")
62 +
#' pkgSnapshot(NULL, libPaths = .libPaths()[1])
63 +
#' sink()
64 +
#' 
65 +
#' # Will show "minimum package version"
66 +
#' pkgSnapshot(NULL, libPaths = .libPaths()[1], exact = FALSE)
42 67
#' }
43 68
#'
44 69
pkgSnapshot <- function(packageVersionFile = "packageVersions.txt", libPaths, standAlone = FALSE,
45 -
                        purge = getOption("Require.purge", FALSE)) {
70 +
                        purge = getOption("Require.purge", FALSE), exact = TRUE) {
46 71
  if (missing(libPaths))
47 72
    libPaths <- .libPaths()
48 73
  origLibPaths <- suppressMessages(setLibPaths(libPaths, standAlone))
@@ -50,8 +75,32 @@
Loading
50 75
51 76
  ip <- as.data.table(.installed.pkgs(lib.loc = libPaths, which = character(), other = "GitHubSha",
52 77
                                      purge = purge))
53 -
  fwrite(ip, file = packageVersionFile, row.names = FALSE, na = NA)
54 -
  message("package version file saved in ",packageVersionFile)
78 +
  if (is.null(packageVersionFile)) {
79 +
    # aa <- pkgDep("SpaDES", recursive = T)
80 +
    tmpPkgSnapshotFile <- ".tmppackageVersions.txt"
81 +
    on.exit({try(unlink(tmpPkgSnapshotFile), silent = TRUE)}, add = TRUE)
82 +
    co <- suppressMessages(pkgSnapshot(tmpPkgSnapshotFile, libPaths = libPaths, standAlone = standAlone,
83 +
                purge = purge))
84 +
    cc <- data.table::fread(tmpPkgSnapshotFile)
85 +
    # cc <- bb[bb$Package %in% extractPkgName(aa$SpaDES) & bb$LibPath == bb$LibPath[1],]
86 +
    if (isTRUE(exact)) {
87 +
      ref <- cc$GithubSHA1
88 +
      dd <- paste0(ifelse(!is.na(cc$GithubRepo), paste0(cc$GithubUsername, "/", cc$GithubRepo, "@", ref), 
89 +
                          paste0(cc$Package, " (==", cc$Version, ")")))
90 +
    } else {
91 +
      ref <- cc$GithubRef
92 +
      dd <- paste0(ifelse(!is.na(cc$GithubRepo), paste0(cc$GithubUsername, "/", cc$GithubRepo, "@", ref), 
93 +
                          paste0(cc$Package, " (>=", cc$Version, ")")))
94 +
    }
95 +
    ee <- paste0("Require(c('", paste(dd, collapse = "',\n'"), "'), require = FALSE, dependencies = FALSE, upgrades = FALSE)")
96 +
    cat(ee)
97 +
    # cat(ee, file = "packages.R")
98 +
    # source("packages.R")
99 +
  } else {
100 +
    fwrite(ip, file = packageVersionFile, row.names = FALSE, na = NA)
101 +
    message("package version file saved in ",packageVersionFile)    
102 +
  }
103 +
55 104
  return(invisible(ip))
56 105
}
57 106

@@ -179,10 +179,12 @@
Loading
179 179
                                          "ctime", "atime", "uid", "gid", "uname", "grname"),
180 180
            NULL)
181 181
        setDT(oldAvailableVersions)
182 -
        if (NROW(oldAvailableVersions)) {
182 +
        if (NROW(oldAvailableVersions) && "PackageUrl" %in% colnames(oldAvailableVersions)) {
183 183
          oldAvailableVersions[, OlderVersionsAvailable := gsub(".*_(.*)\\.tar\\.gz", "\\1", PackageUrl)]
184 184
          needOlderDT <- notCorrectVersions[needOlder & repoLocation != "GitHub"]
185 -
          oldAvailableVersions[, OlderVersionsAvailableCh := as.character(package_version(OlderVersionsAvailable))]
185 +
          
186 +
          # packages installed locally via devtools::install will have no known source -- will be NA
187 +
          oldAvailableVersions[!is.na(OlderVersionsAvailable), OlderVersionsAvailableCh := as.character(package_version(OlderVersionsAvailable))]
186 188
          
187 189
          oldAvailableVersions <- needOlderDT[oldAvailableVersions, on = c("Package"), roll = TRUE, allow.cartesian = TRUE]
188 190
          oldAvailableVersions[, compareVersionAvail := .compareVersionV(OlderVersionsAvailableCh, versionSpec)]
@@ -277,8 +279,8 @@
Loading
277 279
  }
278 280
279 281
  # Check for local copy of src or binary first
280 -
  if (!is.null(getOption("Require.RPackageCache"))) {
281 -
    localFiles <- dir(getOption("Require.RPackageCache"), full.names = TRUE)
282 +
  if (!is.null(rpackageFolder(getOption("Require.RPackageCache")))) {
283 +
    localFiles <- dir(rpackageFolder(getOption("Require.RPackageCache")), full.names = TRUE)
282 284
    # sanity check -- there are bad files, quite often
283 285
    fileSizeEq0 <- file.size(localFiles) == 0
284 286
    if (any(fileSizeEq0)) {
@@ -294,12 +296,16 @@
Loading
294 296
      }
295 297
      if (any(neededVersions$installFrom == "CRAN" & is.na(neededVersions$correctVersionAvail))) {
296 298
        wh <- neededVersions[, which(installFrom == "CRAN")]
297 -
        nf <- if ("AvailableVersion" %in% colnames(pkgDT)) { 
298 -
          paste0(neededVersions$Package[wh], "_", neededVersions$AvailableVersion[wh]) 
299 +
        if ("AvailableVersion" %in% colnames(pkgDT)) { 
300 +
          av <- which(!is.na(neededVersions$AvailableVersion))
301 +
          av <- intersect(av, wh)
302 +
          nf <- paste0(neededVersions$Package[av], "_", neededVersions$AvailableVersion[av]) 
303 +
          neededVersions[av, neededFiles := nf]
299 304
        } else {
300 -
          neededVersions$Package[wh]
305 +
          nf <- neededVersions$Package[wh]
306 +
          neededVersions[installFrom == "CRAN", neededFiles := nf]
301 307
        }
302 -
        neededVersions[installFrom == "CRAN", neededFiles := nf]
308 +
        
303 309
      }
304 310
      if (any(neededVersions$installFrom == "GitHub")) {
305 311
        neededVersions[installFrom == "GitHub", neededFiles := paste0(Package, "_", Branch)]
@@ -311,8 +317,43 @@
Loading
311 317
          cachedAvailablePackages <- available.packagesCached(repos = repos, purge = purge)
312 318
          cachedAvailablePackages <- cachedAvailablePackages[, c("Package", "Version")]
313 319
          dontKnowVersion <- cachedAvailablePackages[dontKnowVersion, on = "Package"][, list(Package, Version)]
314 -
          dontKnowVersion[, neededFiles := paste0(Package, "_", Version)][, Version := NULL]
315 -
          neededVersions[dontKnowVersion, neededFiles := i.neededFiles , on = "Package"] # join -- keeping dontKnowVersion column
320 +
          dontKnowVersion[, neededFiles := paste0(Package, "_", Version)]
321 +
          # Here, we don't know what version it should be, so take latest from CRAN as the needed version
322 +
          neededVersions[dontKnowVersion, neededFiles := i.neededFiles , 
323 +
              on = c("Package")] # join -- keeping dontKnowVersion column
324 +
          
325 +
          otherPoss1 <- nchar(neededVersions$neededFiles) == 0 | endsWith(neededVersions$neededFiles, "NA")
326 +
          if (any(otherPoss1)) {
327 +
            dontKnowVersion <- neededVersions[otherPoss1]
328 +
            
329 +
            set(neededVersions, NULL, "lineNumber", seq(NROW(neededVersions)))
330 +
            nv <- data.table::copy(neededVersions)
331 +
            neededVersions[dontKnowVersion, neededFiles := i.neededFiles , 
332 +
                           on = c("Package", "versionSpec" = "Version")] # join -- keeping dontKnowVersion column
333 +
            # Checks -- if there is no versionSpec, it will be NA --> check "Version" next
334 +
            naVS <- is.na(neededVersions$versionSpec)
335 +
            if (any(naVS)) {
336 +
              neededVersions1 <- neededVersions[!naVS]
337 +
              nv1 <- nv[naVS]
338 +
              nv1[dontKnowVersion, neededFiles := i.neededFiles , 
339 +
                             on = c("Package", "Version" = "Version")] # join -- keeping dontKnowVersion column
340 +
              neededVersions <- rbindlist(list(neededVersions1, nv1))
341 +
              setorderv(neededVersions, "lineNumber")
342 +
            }
343 +
            
344 +
            # Checks -- if there is no versionSpec or Version, it will be "" --> check "AvailableVersion" next
345 +
            stillEmpty <- nchar(neededVersions$neededFiles) == 0
346 +
            if (any(stillEmpty & neededVersions$correctVersionAvail)) { # means version number is not precise, but CRAN fulfills the inequality
347 +
              neededVersions <- neededVersions[!stillEmpty]
348 +
              nv <- nv[stillEmpty]
349 +
              nv[dontKnowVersion, neededFiles := i.neededFiles , 
350 +
                 on = c("Package", "AvailableVersion" = "Version")] # join -- keeping dontKnowVersion column]
351 +
              neededVersions <- rbindlist(list(neededVersions, nv))
352 +
              setorderv(neededVersions, "lineNumber")
353 +
            }
354 +
            set(neededVersions, NULL, "lineNumber", NULL)
355 +
          }
356 +
          
316 357
        }
317 358
      }
318 359
@@ -336,9 +377,12 @@
Loading
336 377
            messageDF(neededVersions[srcFromCRAN, c("packageFullName", "Package", "localFileName")])
337 378
            message(paste0("Local *source* file(s) exist for the above package(s).\nWould you like to delete it/them ",
338 379
                           "and let Require try to find the binary on CRAN (or MRAN if older)? Y or N: "))
339 -
            out <- readline()
380 +
            out <- if (interactive())
381 +
              readline()
382 +
            else 
383 +
              "Y"
340 384
            if (identical("y", tolower(out))) {
341 -
              unlink(file.path(getOption("Require.RPackageCache"), 
385 +
              unlink(file.path(rpackageFolder(getOption("Require.RPackageCache")), 
342 386
                               neededVersions[srcFromCRAN]$localFileName))
343 387
            }
344 388
          }
@@ -398,7 +442,7 @@
Loading
398 442
399 443
#' @rdname DESCRIPTION-helpers
400 444
#' @param file A file path to a DESCRIPTION file
401 -
#' @param other Any other keyword in a DESCRIPTION file that preceeds a ":". The rest of the line will be
445 +
#' @param other Any other keyword in a DESCRIPTION file that precedes a ":". The rest of the line will be
402 446
#'   retrieved.
403 447
DESCRIPTIONFileOtherV <- function(file, other = "RemoteSha") {
404 448
  # origLocal <- Sys.setlocale(locale = "C") # required to deal with non English characters in Author names
@@ -510,9 +554,11 @@
Loading
510 554
      warn <- names(warn)
511 555
    }
512 556
    warnOut <- unlist(lapply(installPkgNames, function(ip) grepl(ip, warn) || grepl(ip, warn[[1]])))
513 -
    if (isTRUE(any(!warnOut) || length(warnOut) == 0) || is.null(warn)) {
557 +
    if (isTRUE(any(!warnOut) || length(warnOut) == 0 || is.na(warnOut)) && is.null(warn) ) {
514 558
      set(pkgDT, which(pkgDT$Package %in% installPkgNames), "installed", TRUE)
515 559
      # pkgDT[pkgDT$Package %in% installPkgNames, `:=`(installed = TRUE)]
560 +
    } else if (!is.null(warn)) {
561 +
      set(pkgDT, which(pkgDT$Package %in% extractPkgName(names(warn))), "installed", FALSE)
516 562
    }
517 563
  }
518 564
  pkgDT[]
@@ -544,15 +590,15 @@
Loading
544 590
      #   message("Performing a topological sort of packages to install them in the right order; this may take some time")
545 591
      topoSorted <- pkgDepTopoSort(toInstall$packageFullName, returnFull = TRUE)
546 592
      toInstall <- toInstall[match(names(topoSorted), packageFullName)]
547 -
      pkgsCleaned <- gsub(.grepTooManySpaces, " ", toInstall$packageFullName)
548 -
      pkgsCleaned <- gsub(.grepTabCR, "", pkgsCleaned)
549 -
      message("Installing: ", paste0(pkgsCleaned, sep = ", "))
593 +
      
594 +
      pkgsCleaned <- preparePkgNameToReport(toInstall$Package, toInstall$packageFullName)
595 +
      
596 +
      message("Installing: ", paste(pkgsCleaned, collapse = ", "))
550 597
      toInstall[, installOrder := seq(NROW(toInstall))]
551 598
      Package <- toInstall$Package
552 599
      names(Package) <- Package
553 600
      namespacesLoaded <- unlist(lapply(Package, isNamespaceLoaded))
554 601
      if (any(namespacesLoaded) && getOption("Require.unloadNamespaces", TRUE)) {
555 -
        
556 602
        si <- sessionInfo()
557 603
        allLoaded <- c(names(si$otherPkgs), names(si$loadedOnly))
558 604
        topoSortedAllLoaded <- try(names(pkgDepTopoSort(allLoaded)))
@@ -771,13 +817,14 @@
Loading
771 817
  #installPkgNames <- names(sortedTopologically)
772 818
  installPkgNames <- gitPkgNames$packageFullName
773 819
774 -
  names(installPkgNames) <- installPkgNames
820 +
  names(installPkgNames) <- gitPkgNames$Package
775 821
776 822
  ord <- match(extractPkgName(installPkgNames), gitPkgNames$Package)
777 823
  gitPkgNames <- gitPkgNames[ord]
824 +
  installPkgNames <- installPkgNames[ord]
778 825
779 826
  gitPkgs <- trimVersionNumber(gitPkgNames$packageFullName)
780 -
  names(gitPkgs) <- gitPkgs
827 +
  names(gitPkgs) <- gitPkgNames$Package
781 828
  isTryError <- unlist(lapply(gitPkgs, is, "try-error"))
782 829
  attempts <- rep(0, length(gitPkgs))
783 830
  names(attempts) <- gitPkgs
@@ -787,23 +834,40 @@
Loading
787 834
    }))]
788 835
    ipa <- modifyList2(install_githubArgs, dots)
789 836
    outRes <- lapply(gitPkgDeps2, function(p) {
790 -
      tryCatch(do.call(remotes::install_github, append(list(p), ipa)),
837 +
      out <- tryCatch(do.call(remotes::install_github, append(list(p), ipa)),
791 838
               warning = function(w) w,
792 839
               error = function(e) e)
840 +
      if (identical(out, extractPkgName(p))) 
841 +
        out <- NULL
842 +
      out
793 843
    })
794 844
    attempts[names(outRes)] <- attempts[names(outRes)] + 1
795 845
    maxAttempts <- 0
796 -
    if (any(attempts >= maxAttempts)) {
797 -
      failedAttempts <- attempts[attempts >= maxAttempts]
798 -
      outRes[attempts >= maxAttempts] <- "Failed"
846 +
    
847 +
    warn <- outRes
848 +
    if (is(warn[[1]], "simpleWarning") || is(warn[[1]], "install_error")) {
849 +
      warning(warn)
799 850
    }
851 +
    # if (any(attempts >= maxAttempts)) {
852 +
    #   failedAttempts <- attempts[attempts >= maxAttempts]
853 +
    #   outRes[attempts >= maxAttempts] <- "Failed"  
854 +
    #   if (any(identical("message", names(warn[[1]]) ))) {
855 +
    #     if (is.character(warn[[1]]$message)) {
856 +
    #       outRes[attempts >= maxAttempts] <- warn[[1]]$message
857 +
    #     }   
858 +
    #   }
859 +
    # }
800 860
    isTryError <- unlist(lapply(outRes, is, "try-error"))
801 -
    gitPkgs1 <- gitPkgs[!names(gitPkgs) %in% names(outRes)[!isTryError]]
861 +
    whichDone <- !names(gitPkgs) %in% names(outRes)[!isTryError]
862 +
    gitPkgs1 <- gitPkgs[whichDone]
863 +
    outRes <- outRes[whichDone]
802 864
    if (identical(gitPkgs1, gitPkgs)) {
803 -
      failedAttempts <- names(gitPkgs)
865 +
      # failedAttempts <- names(gitPkgs)
804 866
      gitPkgs <- character()
805 867
    }
806 868
    gitPkgs <- gitPkgs1
869 +
    outRes <- unlist(outRes)
870 +
    
807 871
  }
808 872
  outRes
809 873
}
@@ -949,7 +1013,7 @@
Loading
949 1013
    dots$dependencies <- NA # This was NA; which means let install.packages do it. But, failed in some cases:
950 1014
951 1015
  message("Using local cache of ", paste(toIn$localFileName, collapse = ", "))
952 -
  installPkgNames <- normPath(file.path(getOption("Require.RPackageCache"), toIn$localFileName))
1016 +
  installPkgNames <- normPath(file.path(rpackageFolder(getOption("Require.RPackageCache")), toIn$localFileName))
953 1017
  names(installPkgNames) <- installPkgNames
954 1018
955 1019
  installPkgNamesBoth <- split(installPkgNames, endsWith(installPkgNames, "zip"))
@@ -1048,7 +1112,7 @@
Loading
1048 1112
        if (!is.na(toInstall$versionSpec) && !isTRUE(toInstall$correctVersionAvail)) 
1049 1113
          onVec <- c("Package", "Version" = "versionSpec")
1050 1114
      
1051 -
      type <- c("source", "binary")[grepl("bin", ap[toInstall, on = onVec]$Repository) + 1]
1115 +
      type <- c("source", "binary")[any(grepl("bin", ap[toInstall, on = onVec]$Repository)) + 1]
1052 1116
      install.packagesArgs["type"] <- type
1053 1117
      ipa <- modifyList2(list(type = type), ipa)
1054 1118
    }
@@ -1188,7 +1252,7 @@
Loading
1188 1252
installGitHub <- function(pkgDT, toInstall, dots, install.packagesArgs, install_githubArgs) {
1189 1253
  gitPkgNames <- toInstall[installFrom == "GitHub"]
1190 1254
  out5 <- install_githubV(gitPkgNames, install_githubArgs = install_githubArgs, dots = dots)
1191 -
  updateInstalled(pkgDT, gitPkgNames$Package, warnings())
1255 +
  updateInstalled(pkgDT, gitPkgNames$Package, out5)
1192 1256
}
1193 1257
1194 1258
installAny <- function(pkgDT, toInstall, dots, numPackages, startTime, install.packagesArgs, install_githubArgs,
@@ -1200,11 +1264,17 @@
Loading
1200 1264
  lotsOfTimeLeft <- dft > 10
1201 1265
  timeLeftAlt <- if (lotsOfTimeLeft) format(timeLeft, units = "auto", digits = 0) else "..."
1202 1266
  estTimeFinish <- if (lotsOfTimeLeft) Sys.time() + timeLeft else "...calculating"
1203 -
  message(" -- Installing ", toInstall$packageFullName, " -- (", toInstall$installOrder, " of ", numPackages, ". Estimated time left: ", 
1267 +
  pkgToReport <- preparePkgNameToReport(toInstall$Package, toInstall$packageFullName)
1268 +
  message(" -- Installing ", pkgToReport, " -- (", toInstall$installOrder, " of ", numPackages, ". Estimated time left: ", 
1204 1269
          timeLeftAlt, "; est. finish: ", estTimeFinish, ")")
1205 1270
1206 1271
  if (any("Local" %in% toInstall$installFrom)) {
1207 1272
    pkgDT <- installLocal(pkgDT, toInstall, dots, install.packagesArgs, install_githubArgs)
1273 +
    anyFaultyBinaries <- grepl("error 1 in extracting from zip file", pkgDT$installResult)
1274 +
    if (isTRUE(anyFaultyBinaries)) {
1275 +
      message("Local cache of ", paste(pkgDT[anyFaultyBinaries]$localFileName, collapse = ", "), " faulty; deleting")
1276 +
      unlink(file.path(rpackageFolder(getOption("Require.RPackageCache")), pkgDT[anyFaultyBinaries]$localFileName))
1277 +
    }
1208 1278
  }
1209 1279
  if (any("CRAN" %in% toInstall$installFrom))
1210 1280
    pkgDT <- installCRAN(pkgDT, toInstall, dots, install.packagesArgs, install_githubArgs, 
@@ -1226,7 +1296,7 @@
Loading
1226 1296
  if (builtBinary) {
1227 1297
    newFiles <- dir(pattern = gsub("\\_.*", "", pkg), full.names = TRUE)
1228 1298
    if (length(newFiles)) {
1229 -
      newNames <- file.path(getOption("Require.RPackageCache"), unique(basename(newFiles)))
1299 +
      newNames <- file.path(rpackageFolder(getOption("Require.RPackageCache")), unique(basename(newFiles)))
1230 1300
      if (all(!file.exists(newNames)))
1231 1301
        try(file.link(newFiles, newNames))
1232 1302
      unlink(newFiles)
@@ -1305,7 +1375,7 @@
Loading
1305 1375
      if (!is.null(pkgDT$versionSpec)) {
1306 1376
        if (.N > 1) {
1307 1377
          if (all(!is.na(versionSpec))) {
1308 -
            out <- .I[which(versionSpec == max(as.package_version(versionSpec)))]
1378 +
            out <- .I[which(versionSpec == max(as.package_version(versionSpec)))[1]]
1309 1379
          }
1310 1380
        }
1311 1381
      }
@@ -1424,4 +1494,47 @@
Loading
1424 1494
          "install.packages(c('",paste(pkgs, collapse = ", "),"'), lib = '",.libPaths()[1],"')",
1425 1495
          "\n-----\n...before any other packages get loaded")
1426 1496
  
1497 +
}
1498 +
1499 +
rpackageFolder <- function(path = getOption("Require.RPackageCache"), exact = FALSE)  {
1500 +
  if (!is.null(path)) {
1501 +
    if (isTRUE(exact))
1502 +
      return(path)
1503 +
    path <- path[1]
1504 +
    rversion <- paste0(R.version$major, ".", strsplit(R.version$minor, split = "\\.")[[1]][1])
1505 +
    if (normPath(path) %in% normPath(strsplit(Sys.getenv("R_LIBS_SITE"), split = ":")[[1]])) {
1506 +
      path
1507 +
    } else {
1508 +
      if (!endsWith(path, rversion))
1509 +
        file.path(path, rversion)
1510 +
      else 
1511 +
        path
1512 +
    }
1513 +
  } else {
1514 +
    NULL
1515 +
  }
1516 +
}
1517 +
1518 +
checkLibPaths <- function(libPaths, ifMissing, exact = FALSE) {
1519 +
  if (missing(libPaths)) {
1520 +
    if (missing(ifMissing))
1521 +
      return(.libPaths())
1522 +
    else {
1523 +
      pathsToCheck <- ifMissing
1524 +
    }
1525 +
  } else {
1526 +
    pathsToCheck <- libPaths
1527 +
  }
1528 +
  unlist(lapply(pathsToCheck, function(lp) 
1529 +
    checkPath(rpackageFolder(lp, exact = exact), create = TRUE)))
1530 +
}
1531 +
1532 +
preparePkgNameToReport <- function(Package, packageFullName) {
1533 +
  pkgsCleaned <- gsub(.grepTooManySpaces, " ", packageFullName)
1534 +
  pkgsCleaned <- gsub(.grepTabCR, "", pkgsCleaned)
1535 +
  pkgNameInPkgFullName <- unlist(Map(pkg = Package, pfn = packageFullName, 
1536 +
                                     function(pkg, pfn) grepl(pkg, pfn)))
1537 +
  Package[!pkgNameInPkgFullName] <- paste0(Package[!pkgNameInPkgFullName], " (", 
1538 +
                                               packageFullName[!pkgNameInPkgFullName], ")")
1539 +
  Package
1427 1540
}

@@ -53,7 +53,8 @@
Loading
53 53
#'
54 54
#' @section Local Cache of Packages:
55 55
#' When installing new packages, `Require` will put all source and binary files
56 -
#' in \code{getOption("Require.RPackageCache")} whose default is `NULL`, meaning 
56 +
#' in an R-version specific subfolder of 
57 +
#' \code{getOption("Require.RPackageCache")} whose default is `NULL`, meaning 
57 58
#' \emph{do not cache packages locally},
58 59
#' and will reuse them if needed. To turn
59 60
#' on this feature, set \code{options("Require.RPackageCache" = "someExistingFolder")}.
@@ -250,12 +251,12 @@
Loading
250 251
  on.exit(data.table::setDTthreads(origDTThreads))
251 252
  
252 253
  purge <- dealWithCache(purge)
253 -
  browser(expr = exists("._Require_0"))
254 254
  doDeps <- if (!is.null(list(...)$dependencies)) list(...)$dependencies else NA
255 255
  which <- whichToDILES(doDeps)
256 256
  
257 -
  if (missing(libPaths))
258 -
    libPaths <- .libPaths()
257 +
  libPaths <- checkLibPaths(libPaths = libPaths)
258 +
  # if (missing(libPaths))
259 +
  #   libPaths <- .libPaths()
259 260
  suppressMessages(origLibPaths <- setLibPaths(libPaths, standAlone))
260 261
  
261 262
  if (!missing(packageVersionFile)) {
@@ -270,7 +271,10 @@
Loading
270 271
    packages <- packages[!packages$Package %in% .basePkgs]
271 272
    uniqueLibPaths <- unique(packages$LibPath)
272 273
    if (length(uniqueLibPaths) > 1) {
273 -
      dt <- data.table(libPathInSnapshot = uniqueLibPaths, newLibPaths = paste0(libPaths[1], "_", seq(length(uniqueLibPaths))))
274 +
      dt <- data.table(libPathInSnapshot = uniqueLibPaths, 
275 +
                       newLibPaths = normPath(c(libPaths[1], 
276 +
                                                file.path(libPaths[1], 
277 +
                                                          gsub(":", "", uniqueLibPaths[-1])))))
274 278
      message("packageVersionFile is covering more than one library; installing packages in reverse order; ",
275 279
              "also -- .libPaths() will be altered to be\n")
276 280
      messageDF(dt)
@@ -317,7 +321,8 @@
Loading
317 321
    on.exit({Sys.setenv("R_REMOTES_UPGRADE" = oldEnv)}, add = TRUE)
318 322
    message("Using ", packageVersionFile, "; setting `require = FALSE`")
319 323
  }
320 -
  on.exit({suppressMessages(setLibPaths(origLibPaths, standAlone = TRUE))}, add = TRUE)
324 +
  on.exit({suppressMessages(setLibPaths(origLibPaths, standAlone = TRUE, exact = TRUE))}, 
325 +
          add = TRUE)
321 326
  
322 327
  # Rm base packages -- this will happen in getPkgDeps if that is run
323 328
  packages <- packages[!extractPkgName(packages) %in% .basePkgs]
@@ -338,7 +343,6 @@
Loading
338 343
    packagesOrder <- seq(packagesOrig)
339 344
    names(packagesOrder) <- extractPkgName(packageNamesOrig)
340 345
    
341 -
    browser(expr = exists("._Require_1"))
342 346
    if (length(which) && (isTRUE(install) || identical(install, "force"))) {
343 347
      packages <- getPkgDeps(packages, which = which, purge = purge)
344 348
    }
@@ -349,7 +353,8 @@
Loading
349 353
    
350 354
    pkgDT <- toPkgDT(packages, deepCopy = TRUE)
351 355
    # identify the packages that were asked by user to load -- later dependencies will be in table too
352 -
    # some cases, original was without version, but due to a dependency that does have a version, it is no longer the same as orig package name
356 +
    # some cases, original was without version, but due to a dependency that does have a version, 
357 +
    # it is no longer the same as orig package name
353 358
    pkgDT[packageFullName %in% unique(packageNamesOrig) | Package %in% unique(packageNamesOrig), 
354 359
          packagesRequired := packagesOrder[match(Package, names(packagesOrder))]]
355 360
    pkgDT[, loadOrder := packagesRequired] # this will start out as loadOrder = TRUE, but if install fails, will turn to FALSE
@@ -374,7 +379,7 @@
Loading
374 379
          install.packagesArgs["INSTALL_opts"] <- unique(c('--no-multiarch', install.packagesArgs[["INSTALL_opts"]]))
375 380
          install_githubArgs["INSTALL_opts"] <- unique(c('--no-multiarch', install_githubArgs[["INSTALL_opts"]]))
376 381
          if (is.null(list(...)$destdir) && (isTRUE(install) || identical(install, "force"))) {
377 -
            if (!is.null(getOption("Require.RPackageCache"))) {
382 +
            if (!is.null(rpackageFolder(getOption("Require.RPackageCache")))) {
378 383
              ip <- .installed.pkgs()
379 384
              isCranCacheInstalled <- any(grepl("crancache", ip[, "Package"])) && identical(Sys.getenv("CRANCACHE_DISABLE"), "")
380 385
              if (isTRUE(isCranCacheInstalled)) {
@@ -386,8 +391,8 @@
Loading
386 391
                Sys.setenv('CRANCACHE_DISABLE' = TRUE)
387 392
              }
388 393
              
389 -
              checkPath(getOption("Require.RPackageCache"), create = TRUE)
390 -
              install.packagesArgs["destdir"] <- paste0(gsub("/$", "", getOption("Require.RPackageCache")), "/")
394 +
              checkPath(rpackageFolder(getOption("Require.RPackageCache")), create = TRUE)
395 +
              install.packagesArgs["destdir"] <- paste0(gsub("/$", "", rpackageFolder(getOption("Require.RPackageCache"))), "/")
391 396
              if (getOption("Require.buildBinaries", TRUE)) {
392 397
                # if (isWindows() && getOption("Require.buildBinaries", TRUE)) {
393 398
                  install.packagesArgs[["INSTALL_opts"]] <- unique(c('--build', install.packagesArgs[["INSTALL_opts"]]))
@@ -488,3 +493,4 @@
Loading
488 493
    return(invisible(out))
489 494
  }
490 495
}
496 +

@@ -2,15 +2,32 @@
Loading
2 2
#'
3 3
#' This will set the \code{.libPaths()} by either adding a new path to
4 4
#' it if \code{standAlone = FALSE}, or will concatenate
5 -
#' \code{c(libPath, tail(.libPaths(), 1))} if \code{standAlone = TRUE}.
5 +
#' \code{c(libPath, tail(.libPaths(), 1))} if \code{standAlone = TRUE}. Currently,
6 +
#' the default is to make this new \code{.libPaths()} "sticky", meaning it becomes 
7 +
#' associated with the current directory even through a restart of R. It does this
8 +
#' by adding and/updating the .Rprofile file in the current directory. If this
9 +
#' current director is a project, then the project will have the new \code{.libPaths()}
10 +
#' associated with it, even through an R restart.
6 11
#'
7 12
#' @details
8 -
#' This code was modified from \url{https://github.com/milesmcbain}.
13 +
#' This details of this code were modified from \url{https://github.com/milesmcbain}.
9 14
#' A different, likely non-approved by CRAN approach that also works is here:
10 15
#' \url{https://stackoverflow.com/a/36873741/3890027}.
11 16
#'
12 17
#' @param libPaths A new path to append to, or replace all existing user
13 18
#'   components of \code{.libPath()}
19 +
#' @param updateRprofile Logical or Character string. If \code{TRUE}, then
20 +
#'   this function will put several lines of code in the current directory's \code{.Rprofile} 
21 +
#'   file setting up the package libraries for this and future sessions. If
22 +
#'   a character string, then this should be the path to an \code{.Rprofile} file.
23 +
#'   To reset back to normal, run \code{setLibPaths()} without a libPath. Default:
24 +
#'   \code{getOption("Require.updateRprofile", FALSE)}, meaning \code{FALSE}, but it
25 +
#'   can be set with an option or within a single call.
26 +
#' @param exact Logical. This function will automatically append the R version number to the
27 +
#'   \code{libPaths} to maintain separate R package libraries for each R version
28 +
#'   on the system. There are some cases where this behaviour is not desireable. 
29 +
#'   Set \code{exact} to \code{TRUE} to override this automatic appending and use
30 +
#'   the exact, unaltered \code{libPaths}. Default is \code{FALSE}
14 31
#' @inheritParams Require
15 32
#' @return
16 33
#' The main point of this function is to set \code{.libPaths()}, which
@@ -20,21 +37,35 @@
Loading
20 37
#'
21 38
#' @export
22 39
#' @examples
40 +
#' origDir <- setwd(tempdir())
41 +
#' setLibPaths("newProjectLib") # set a new R package library locally
42 +
#' setLibPaths() # reset it to original
43 +
#' setwd(origDir)
23 44
#' \dontrun{
24 -
#' orig <- setLibPaths("~/newProjectLib") # will only have 2 paths,
25 -
#'                                        # this and the last one in .libPaths()
26 -
#' .libPaths() # see the 2 paths
27 -
#' setLibPaths(orig) # reset
28 -
#' .libPaths() # see the 2 original paths back
29 -
#'
30 -
#' # will have 2 or more paths
45 +
#' # Using standAlone = FALSE means that newly installed packages will be installed
46 +
#' #   in the new package library, but loading packages can come from any of the ones
47 +
#' #   listed in .libPaths()
31 48
#' setLibPaths("~/newProjectLib", standAlone = FALSE) # will have 2 or more paths
49 +
#' # Can restart R, and changes will stay
50 +
#' 
51 +
#' # remove the custom .libPaths()
52 +
#' Require::setLibPaths() # reset to previous; remove from Rprofile because libPath arg is empty
32 53
#'
33 54
#' }
34 -
setLibPaths <- function(libPaths, standAlone = TRUE) {
55 +
setLibPaths <- function(libPaths, standAlone = TRUE, 
56 +
                        updateRprofile = getOption("Require.updateRprofile", FALSE),
57 +
                        exact = FALSE) {
35 58
  oldLibPaths <- .libPaths()
36 -
  libPaths <- checkPath(normPath(libPaths), create = TRUE)#, mustWork = TRUE)
37 -
59 +
  
60 +
  if (missing(libPaths)) {
61 +
    return(checkMissingLibPaths(libPaths, updateRprofile))
62 +
  } ## End missing
63 +
  libPaths <- checkLibPaths(libPaths, exact = exact)
64 +
  #libPaths <- checkPath(normPath(libPaths), create = TRUE)#, mustWork = TRUE)
65 +
  if (!is.null(updateRprofile)) {
66 +
    setLibPathsUpdateRprofile(libPaths, standAlone, updateRprofile)
67 +
  }
68 +
  
38 69
  shim_fun <- .libPaths
39 70
  shim_env <- new.env(parent = environment(shim_fun))
40 71
  if (isTRUE(standAlone)) {
@@ -46,6 +77,118 @@
Loading
46 77
47 78
  environment(shim_fun) <- shim_env
48 79
  shim_fun(unique(libPaths))
49 -
  message(".libPaths() is now: ", paste(.libPaths(), collapse = ", "))
80 +
  if (getOption("Require.setupVerbose", TRUE)) 
81 +
    message(".libPaths() is now: ", paste(.libPaths(), collapse = ", "))
50 82
  return(invisible(oldLibPaths))
51 83
}
84 +
85 +
setLibPathsUpdateRprofile <- function(libPaths, standAlone = TRUE, updateRprofile = NULL) {
86 +
  updateRprofile <- checkTRUERprofile(updateRprofile)
87 +
  if (is.character(updateRprofile)) {
88 +
    newFile <- FALSE
89 +
    if (!file.exists(updateRprofile)) {
90 +
      newFile <- TRUE
91 +
      file.create(updateRprofile)
92 +
      if (file.exists(".gitignore")) {
93 +
        if (!isTRUE(any(grepl(".Rprofile", readLines(".gitignore")))))
94 +
          cat(".Rprofile\n", file = ".gitignore", append = TRUE)
95 +
      }
96 +
    }
97 +
    if (any(grepl(setLibPathsStartText, readLines(".Rprofile")))) {
98 +
      if (getOption("Require.setupVerbose", TRUE)) 
99 +
        message(alreadyInRprofileMessage)
100 +
    } else {
101 +
      bodyFn <- format(body(Require::setLibPaths))
102 +
      lineWCheckPath <- grepl("checkPath.normPath|checkLibPaths", bodyFn)
103 +
      bodyFn[lineWCheckPath] <- "    if (!dir.exists(libPaths[1])) dir.create(libPaths[1], recursive = TRUE)"
104 +
      lineWReturn <- grepl("return.*oldLibPaths", bodyFn)
105 +
      bodyFn <- bodyFn[!lineWReturn] 
106 +
      bodyFn <- gsub("tail", "utils::tail", bodyFn)
107 +
      bodyFn <- gsub("shim_env", ".shim_env", bodyFn)
108 +
      bodyFn <- gsub("shim_fun", ".shim_fun", bodyFn)
109 +
      bodyFn <- gsub("oldLibPaths", ".oldLibPaths", bodyFn)
110 +
      lineWMissing <- which(grepl("missing.libPaths", bodyFn))
111 +
      bodyFn <- bodyFn[-(lineWMissing:(lineWMissing+2))] 
112 +
      lineWRprofileToUpdate <- which(grepl("is\\.null\\(updateRprofile\\)", bodyFn))
113 +
      bodyFn <- bodyFn[-(lineWRprofileToUpdate:(lineWRprofileToUpdate+2))] 
114 +
      bodyFn <- gsub("\\<standAlone\\>", "._standAlone", bodyFn)
115 +
      bodyFn <- gsub("\\.libPaths", "origDotlibPaths", bodyFn)
116 +
      bodyFn <- gsub("\\<libPaths\\>", "._libPaths", bodyFn)
117 +
      bodyFn <- gsub("origDotlibPaths", ".libPaths", bodyFn)
118 +
      bodyFn <- c(paste0("\n",setLibPathsStartText," #### ",newFileTrigger, newFile,
119 +
                         " # DO NOT EDIT BETWEEN THESE LINES"),
120 +
                  "### DELETE THESE LINES BELOW TO RESTORE STANDARD R Package LIBRARY", 
121 +
                  paste0("### ", prevLibPathsText, paste(.libPaths(), collapse = ", ")),
122 +
                  paste0("._libPaths <- c('", paste(libPaths, collapse = "', '"), "')"), 
123 +
                  paste0("._standAlone <- ", standAlone), 
124 +
                  bodyFn, 
125 +
                  if (getOption("Require.setupVerbose", TRUE)) resetRprofileMessage(updateRprofile),
126 +
                  paste0(commentCharsForSetLibPaths, "end ####"))
127 +
      if (getOption("Require.setupVerbose", TRUE)) 
128 +
        message("Updating ", updateRprofile, "; this will set new libPaths for R packages even after restarting R")
129 +
      cat(bodyFn, file = ".Rprofile", append = TRUE, sep = "\n")
130 +
    }
131 +
  }
132 +
  
133 +
}
134 +
135 +
checkMissingLibPaths <- function(libPaths, updateRprofile = NULL) {
136 +
  if (!is.null(updateRprofile)) {
137 +
    if (updateRprofile == FALSE && missing(libPaths))
138 +
      updateRprofile <- TRUE
139 +
    updateRprofile <- checkTRUERprofile(updateRprofile)
140 +
    noChange <- FALSE
141 +
    if (is.character(updateRprofile)) {
142 +
      if (file.exists(updateRprofile)) {
143 +
        ll <- readLines(updateRprofile)
144 +
        bounds <- which(grepl("#### setLibPaths", ll))
145 +
        if (length(bounds)) {
146 +
          if (getOption("Require.setupVerbose", TRUE)) 
147 +
            message("removing custom libPaths in .Rprofile")
148 +
          if (identical("", ll[bounds[1] - 1])) {
149 +
            bounds[1] <- bounds[1] - 1
150 +
          }
151 +
          newFileLine <- grepl(newFileTrigger, ll)
152 +
          newFile <- gsub(paste0(".*", newFileTrigger, "([[:alpha:]]+) .*"), "\\1", ll[newFileLine])
153 +
          wasNew <- as.logical(newFile)
154 +
          prevLines <- grepl(prevLibPathsText, ll)
155 +
          prevLibPaths <- strsplit(gsub(paste0(".*", prevLibPathsText), "", ll[prevLines]), split = ", ")[[1]]
156 +
          setLibPaths(prevLibPaths, updateRprofile = FALSE, exact = TRUE)
157 +
          if (isTRUE(wasNew) && which(newFileLine) == 2) { # needs to be NEW and starts on 2nd line
158 +
            file.remove(updateRprofile) 
159 +
          } else {
160 +
            ll <- ll[-(bounds[1]:bounds[2])]
161 +
            writeLines(ll, con = updateRprofile)
162 +
          }
163 +
        } else {
164 +
          noChange <- TRUE
165 +
        }
166 +
      } else {
167 +
        noChange <- TRUE
168 +
      }
169 +
      if (isTRUE(noChange)) 
170 +
        if (getOption("Require.setupVerbose", TRUE)) 
171 +
          message("There was no custom libPaths setting in .Rprofile; nothing changed")
172 +
173 +
      return(invisible())
174 +
    }
175 +
  } 
176 +
  stop("libPaths cannot be missing; please supply a folder to install R packages to")
177 +
  return(invisible())
178 +
}
179 +
180 +
resetRprofileMessage <- function(updateRprofile = ".Rprofile") {
181 +
  paste0("message(\"To reset libPaths to previous state, run: Require::setupOff() (or delete section in .Rprofile file)\") ")
182 +
}
183 +
184 +
checkTRUERprofile <- function(updateRprofile) {
185 +
  if (isTRUE(updateRprofile)) updateRprofile <- ".Rprofile"
186 +
  updateRprofile
187 +
}
188 +
189 +
190 +
prevLibPathsText <- "Previous .libPaths: "
191 +
commentCharsForSetLibPaths <- "#### setLibPaths "
192 +
setLibPathsStartText <- paste0(commentCharsForSetLibPaths, "start")
193 +
newFileTrigger <- "New File:"
194 +
alreadyInRprofileMessage <- "There is already a setLibPaths in the .Rprofile, skipping"

@@ -2,7 +2,6 @@
Loading
2 2
  "..whichAll", "destFile", "filepath", "pkg"
3 3
))
4 4
5 -
6 5
#' @description 
7 6
#' 
8 7
#' \code{pkgDepAlt} is a newer, still experimental approach to \code{pkgDep}, which has different
@@ -77,7 +76,7 @@
Loading
77 76
    pkgDTComplete[[i]] <- pkgDTComplete[[i]][0]
78 77
  }
79 78
  
80 -
  while((NROW(pkgDTDeps[[i]]) & recursive) || (recursive == FALSE & NROW(pkgDTDeps[[i]]) == 1)) {
79 +
  while ((NROW(pkgDTDeps[[i]]) & recursive) || (recursive == FALSE & NROW(pkgDTDeps[[i]]) == 1)) {
81 80
    pkgDTSrc <- list()
82 81
    browser(expr = exists("._pkgDep3_2"))
83 82
    pfn <- pkgDTDeps[[i]]$packageFullName
@@ -97,7 +96,6 @@
Loading
97 96
      pkgDTDeps[[i]] <- pkgDTDeps[[i]][0]
98 97
    }
99 98
    
100 -
    
101 99
    deps <- list()
102 100
    
103 101
    if (NROW(pkgDTDeps[[i]])) {
@@ -174,7 +172,7 @@
Loading
174 172
      depsList <- append(depsList, stashed[!stillNeed])
175 173
    }
176 174
    # message(sum(!stillNeed), " not rerun, out of ", length(stillNeed))
177 -
    pkgDTDeps[[i+1]] <- rbindlist(
175 +
    pkgDTDeps[[i + 1]] <- rbindlist(
178 176
      Map(x = depsList, PackageTopLevel = gsub("^.+\\___(.*)", "\\1", names(depsList)),
179 177
          function(x, PackageTopLevel) {
180 178
            nams <- names(x)
@@ -188,41 +186,41 @@
Loading
188 186
      idcol = "PackageVersion")
189 187
    
190 188
    # Clean up -- R, \n\t
191 -
    if (NROW(pkgDTDeps[[i+1]]) > 0) { 
192 -
      pkgDTDeps[[i+1]] <- cleanUp(pkgDTDeps[[i+1]], includeBase = includeBase)
189 +
    if (NROW(pkgDTDeps[[i + 1]]) > 0) { 
190 +
      pkgDTDeps[[i + 1]] <- cleanUp(pkgDTDeps[[i + 1]], includeBase = includeBase)
193 191
    }
194 192
    
195 -
    if (NROW(pkgDTDeps[[i+1]])) {
193 +
    if (NROW(pkgDTDeps[[i + 1]])) {
196 194
      # Put "remotes" first, because it has more information than all others
197 -
      if (length(unique(pkgDTDeps[[i+1]]$which)) > 1) {
198 -
        set(pkgDTDeps[[i+1]], NULL, "whichFac", 
199 -
            factor(pkgDTDeps[[i+1]]$which, 
195 +
      if (length(unique(pkgDTDeps[[i + 1]]$which)) > 1) {
196 +
        set(pkgDTDeps[[i + 1]], NULL, "whichFac", 
197 +
            factor(pkgDTDeps[[i + 1]]$which, 
200 198
                   levels = c("remotes", "depends", "imports", "suggests", "linkingto", "enhances")))
201 -
        setorderv(pkgDTDeps[[i+1]], "whichFac")
202 -
        set(pkgDTDeps[[i+1]], NULL, "whichFac", NULL)
199 +
        setorderv(pkgDTDeps[[i + 1]], "whichFac")
200 +
        set(pkgDTDeps[[i + 1]], NULL, "whichFac", NULL)
203 201
      }
204 202
      
205 203
      # if there are duplicates within a 
206 -
      set(pkgDTDeps[[i+1]], NULL, "hasVersionSpec", grepl(.grepVersionNumber, pkgDTDeps[[i+1]]$packageFullName))
204 +
      set(pkgDTDeps[[i + 1]], NULL, "hasVersionSpec", grepl(.grepVersionNumber, pkgDTDeps[[i + 1]]$packageFullName))
207 205
      
208 -
      pkgDTDeps[[i+1]] <- keepOnlyMaxVersion(pkgDTDeps[[i+1]])
206 +
      pkgDTDeps[[i + 1]] <- keepOnlyMaxVersion(pkgDTDeps[[i + 1]])
209 207
    }
210 -
    pkgDTComplete[[i+1]] <- data.table::copy(pkgDTDeps[[i+1]])
208 +
    pkgDTComplete[[i + 1]] <- data.table::copy(pkgDTDeps[[i + 1]])
211 209
    
212 -
    if (NROW(pkgDTComplete[[i+1]]) == 0)  {
210 +
    if (NROW(pkgDTComplete[[i + 1]]) == 0)  {
213 211
      break
214 212
    }
215 213
    # Deal with duplicates
216 214
    
217 -
    # alreadyDone <- pkgDTDeps[[i+1]]$packageFullName %in% 
215 +
    # alreadyDone <- pkgDTDeps[[i + 1]]$packageFullName %in% 
218 216
    #   unlist(lapply(pkgDTDeps[seq(i)], function(x) x$packageFullName))
219 217
    
220 218
    # if (any(alreadyDone)) { 
221 -
    #   pkgDTDeps[[i+1]] <- pkgDTDeps[[i+1]][alreadyDone == FALSE]
219 +
    #   pkgDTDeps[[i + 1]] <- pkgDTDeps[[i + 1]][alreadyDone == FALSE]
222 220
    # } else if (all(alreadyDone)) { 
223 -
    #   pkgDTDeps[[i+1]] <- pkgDTDeps[[i+1]][0] 
221 +
    #   pkgDTDeps[[i + 1]] <- pkgDTDeps[[i + 1]][0] 
224 222
    # }
225 -
    # pkgDTDeps[[i+1]] <- pkgDTDeps[[i+1]][!duplicated(pkgDTDeps[[i+1]]$Package)] # remove imports where there is remotes
223 +
    # pkgDTDeps[[i + 1]] <- pkgDTDeps[[i + 1]][!duplicated(pkgDTDeps[[i + 1]]$Package)] # remove imports where there is remotes
226 224
    i <- i + 1
227 225
    
228 226
  }
@@ -293,7 +291,7 @@
Loading
293 291
  DESCRIPTIONpaths <- file.path(packageTD, "DESCRIPTION")
294 292
  pkgDTNeedNew <- pkgDT[objsExist == FALSE] 
295 293
  if (NROW(pkgDTNeedNew)) {
296 -
    message("available.packages() doesn't have correct information on package dependencies for ",
294 +
    message("available.packages() does not have correct information on package dependencies for ",
297 295
            paste(Package, collapse = ", "), 
298 296
            " because they are Archive versions; downloading their respective tar.gz files")
299 297
    pkgFilename <- paste0(pkgDTNeedNew$Package, "_", 

@@ -0,0 +1,169 @@
Loading
1 +
#' Setup a project library, cache, options
2 +
#' 
3 +
#' This can be placed as the first line of any/all scripts and it will
4 +
#' be create a reproducible, self-contained project with R packages. 
5 +
#' Some of these have direct relationships with \code{RequireOptions}
6 +
#' and arguments in \code{setLibPaths} and \code{Require}.
7 +
#' @param RPackageFolders One or more folders where R packages are 
8 +
#'   installed to and loaded from. In the case of more than one 
9 +
#'   folder provided, installation will only happen in the first one.
10 +
#' @param RPackageCache See \code{?RequireOptions}.
11 +
#' @param buildBinaries See \code{?RequireOptions}.
12 +
#' @inheritParams setLibPaths
13 +
#' @export
14 +
#' @rdname setup
15 +
#' 
16 +
#' @examples 
17 +
#' # Place this as the first line of a project
18 +
#' \dontrun{
19 +
#' Require::setup()
20 +
#' 
21 +
#' # To turn it off and return to normal
22 +
#' Require::setupOff()
23 +
#' }
24 +
#'   
25 +
setup <- function(RPackageFolders = getOption("RPackageFolders", "R"), 
26 +
                  RPackageCache = getOption("RPackageCache", "~/.cache/R/RequirePkgCache"), 
27 +
                  buildBinaries = getOption("buildBinaries", TRUE), 
28 +
                  standAlone = getOption("standAlone", TRUE)) {
29 +
  RPackageFolders <- checkPath(RPackageFolders, create = TRUE)
30 +
  RPackageCache <- checkPath(RPackageCache, create = TRUE)
31 +
  # hasCranCache <- any(dir.exists(file.path(.libPaths(), "crancache")))
32 +
  # usingCranCache <- FALSE
33 +
  # 
34 +
  # if (hasCranCache && !isFALSE(getOption("Require.useCranCache"))) { # if NULL or TRUE go here
35 +
  #   rvn <- paste0(R.version$major, '.', strsplit(R.version$minor, split = '\\.')[[1]][1])
36 +
  #   os <- tolower(.Platform$OS.type)
37 +
  #   extra <- file.path('cran','bin', os,'contrib', rvn, fsep = "/")
38 +
  #   usingCranCache <- !endsWith(RPackageCache, extra)
39 +
  #   if (usingCranCache) {
40 +
  #     if (interactive()) {
41 +
  #       message("crancache is installed; would you like to have Require and ",
42 +
  #               "crancache share the cache? If N, then Require will use ",
43 +
  #               RPackageCache)
44 +
  #       useSameCache <- readline("Use same cache? (Y or N)")
45 +
  #       if (identical(tolower(useSameCache), "y")) {
46 +
  #         stop(paste0("To use crancache cached packages, please rerun:\n",
47 +
  #                     "setup(RPackageCache = normalizePath(file.path(crancache::get_cache_dir(),'",extra,"'),
48 +
  #                            winslash = '/'))"))
49 +
  #       }
50 +
  #     }
51 +
  #   } else {
52 +
  #     usingCranCache <- TRUE
53 +
  #   }
54 +
  # }
55 +
  copyRequireAndDeps(RPackageFolders)
56 +
  
57 +
  newOpts <- list("Require.RPackageCache" = RPackageCache,
58 +
                  "Require.buildBinaries" = buildBinaries)#,
59 +
                  #"Require.useCranCache" = usingCranCache)
60 +
  opts <- options(newOpts)
61 +
  co <- capture.output(type = "message", 
62 +
                       setLibPaths(RPackageFolders, standAlone = standAlone, 
63 +
                                   updateRprofile = TRUE))
64 +
  if (!any(grepl(alreadyInRprofileMessage, co)))
65 +
    if (getOption("Require.setupVerbose", TRUE)) 
66 +
      silence <- lapply(co, message)
67 +
  ro <- RequireOptions()
68 +
  roNames <- names(newOpts)
69 +
  names(roNames) <- roNames
70 +
  nonStandardOpt <- !unlist(lapply(roNames, function(optNam) identical(ro[[optNam]], opts[[optNam]])))
71 +
  if (any(nonStandardOpt)) {
72 +
    rp <- readLines(".Rprofile")
73 +
    lineWithPrevious <- grepl("### Previous", rp)
74 +
    if (any(lineWithPrevious)) {
75 +
      lineWithPrevious <- which(lineWithPrevious)
76 +
      post <- seq(length(rp) - lineWithPrevious) + lineWithPrevious
77 +
      pre <- seq(lineWithPrevious)
78 +
      nameNonStandards <- names(nonStandardOpt)[nonStandardOpt]
79 +
      optsToAdd <- unlist(lapply(nameNonStandards, function(nns) {
80 +
        paste0("### Previous option: ", nns, " = ", opts[[nns]])
81 +
      }))
82 +
      newOptsToAdd <- unlist(lapply(nameNonStandards, function(nns) {
83 +
        paste0("options('", nns, "' = '", newOpts[[nns]], "')")
84 +
      }))
85 +
      newRP <- c(rp[pre], optsToAdd, newOptsToAdd, rp[post])
86 +
      cat(newRP, file = ".Rprofile", sep = "\n")
87 +
    }
88 +
  }
89 +
    
90 +
}
91 +
92 +
#' @rdname setup
93 +
#' @export
94 +
#' @param removePackages Logical. If \code{TRUE}, then all packages that
95 +
#'   were installed in the custom library will be deleted when \code{setupOff}
96 +
#'   is run. The default is \code{FALSE}, and when \code{TRUE} is selected,
97 +
#'   and it is an interactive session, the user will be prompted to confirm
98 +
#'   deletions.
99 +
setupOff <- function(removePackages = FALSE) {
100 +
  lps <- .libPaths()
101 +
  if (file.exists(".Rprofile")) {
102 +
    rp <- readLines(".Rprofile")
103 +
    lineWithPrevious <- grepl("### Previous option", rp)
104 +
    options(RequireOptions())
105 +
    if (any(lineWithPrevious)) {
106 +
      lineWithPrevious <- which(lineWithPrevious)
107 +
      silence <- lapply(lineWithPrevious, function(lwp) {
108 +
        opt <- gsub("### Previous option: ", "", rp[lwp])
109 +
        opt <- strsplit(opt, " = ")[[1]]
110 +
        newOpt <- list(opt[2])
111 +
        names(newOpt) <- opt[1]
112 +
        options(newOpt)
113 +
      })
114 +
    }
115 +
    setLibPaths()
116 +
    if (isTRUE(removePackages)) {
117 +
      if (interactive() && getOption("Require.setupVerbose", TRUE) ) {
118 +
        message("You have requested to remove all packages in ", lps[1])
119 +
        out <- readline("Is this correct? Y (delete all) or N (do not delete all)")
120 +
        if (identical(tolower(out), "n"))
121 +
          removePackages <- FALSE
122 +
      } 
123 +
      if (isTRUE(removePackages))
124 +
        unlink(lps[1], recursive = TRUE)
125 +
    }
126 +
  } else {
127 +
    message("Project is not setup yet; nothing to do")
128 +
  }
129 +
}
130 +
131 +
copyRequireAndDeps <- function(RPackageFolders) {
132 +
  lps <- .libPaths()
133 +
  names(lps) <- lps
134 +
  pkgs <- c("Require", "remotes", "data.table")
135 +
  for (pkg in pkgs) {
136 +
    theNewPath <- file.path(rpackageFolder(RPackageFolders), pkg)
137 +
    newPathExists <- dir.exists(theNewPath)
138 +
    for (lp in lps) {
139 +
      thePath <- file.path(lp, pkg)
140 +
      pkgInstalledAlready <- dir.exists(thePath)
141 +
      if (isTRUE(pkgInstalledAlready)) {
142 +
        fromFiles <- dir(thePath, recursive = TRUE, full.names = TRUE)
143 +
        if (!newPathExists) {
144 +
          if (getOption("Require.setupVerbose", TRUE)) 
145 +
            message("Placing copy of ", pkg, " in ", RPackageFolders)
146 +
          dirs <- unique(dirname(fromFiles))
147 +
          dirs <- gsub(thePath, theNewPath, dirs)
148 +
          lapply(dirs, checkPath, create = TRUE)
149 +
        }
150 +
        
151 +
        toFiles <- gsub(thePath, theNewPath, fromFiles)
152 +
        
153 +
        if (newPathExists) {
154 +
          newPathVersion <- DESCRIPTIONFileVersionV(file.path(theNewPath, "DESCRIPTION"))
155 +
          oldPathVersion <- DESCRIPTIONFileVersionV(file.path(thePath, "DESCRIPTION"))
156 +
          comp <- compareVersion(newPathVersion, oldPathVersion)
157 +
          if (comp > -1) break
158 +
          if (getOption("Require.setupVerbose", TRUE)) 
159 +
            message("Updating version of ", pkg, " in ", RPackageFolders)
160 +
          unlink(toFiles)
161 +
        }
162 +
        file.link(fromFiles, toFiles)
163 +
        break
164 +
      }
165 +
    }
166 +
  }
167 +
168 +
169 +
}

@@ -131,7 +131,7 @@
Loading
131 131
              dir.create(file.path(pth), recursive = TRUE, showWarnings = FALSE)
132 132
            })
133 133
          } else {
134 -
            stop(paste("Specified path", normPath(path), "doesn't exist.",
134 +
            stop(paste("Specified path", normPath(path), "does not exist.",
135 135
                       "Create it and try again."))
136 136
          }
137 137
        }
@@ -260,14 +260,14 @@
Loading
260 260
  })
261 261
}
262 262
263 -
#' \code{modifyList} for >2 lists
263 +
#' \code{modifyList} for multiple lists
264 264
#' 
265 265
#' @description 
266 266
#' This calls \code{\link[utils]{modifyList}} iteratively using 
267 -
#' \code{\link[base]{Reduce}}, so it can handle >2 lists. The 
268 -
#' subsequent list elements that share a name will override 
269 -
#' previous list elements with that same name. It also 
270 -
#' will handle the case where any list is a \code{NULL}
267 +
#' \code{\link[base]{Reduce}}, so it can handle >2 lists.
268 +
#' The subsequent list elements that share a name will override 
269 +
#' previous list elements with that same name.
270 +
#' It also will handle the case where any list is a \code{NULL}
271 271
#' 
272 272
#' @details 
273 273
#' Simply a convenience around 
Files Coverage
R 0.22%
Project Totals (11 files) 0.22%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
        informational: true
10
    patch:
11
      default:
12
        target: auto
13
        threshold: 1%
14
        informational: true
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading