R/addPackages.R

In andrie/miniCRAN: Create a Mini Version of CRAN Containing Only Selected Packages

if (getRversion() >= "3.1.0") {
  utils::globalVariables(c("."))
}

#' Check for previous versions of packages in a miniCRAN repository.
#'
#' Checks for previous versions, and returns the file paths for packages with
#' multiple versions. You can subsequently decide which version to keep.
#'
#' @param pkgs Character vector of packages to be installed. If not provided,
#'   checks all files for multiple package versions.
#'
#' @param path The local path to the directory where the miniCRAN repo resides.
#'
#' @param type  character, indicating the type of package to download and
#'   install. See [install.packages()].
#'
#' @template Rversion
#'
#' @return Returns invisibly the file paths to packages with multiple versions
#'   for removal.
#'
#' @export
#'
#' @return list with an element for each `type`, consisting of a character
#'   vector of download paths
#'
#' @family update repo functions
#'
#' @example /inst/examples/example_checkVersions.R
#'
checkVersions <- function(
  pkgs = NULL,
  path = NULL,
  type = "source",
  Rversion = R.version
) {
  if (is.null(path)) stop("path must be specified.")
  if (!file.exists(path)) stop("invalid path, ", path)

  do_one <- function(type) {
    pkgPath <- repoBinPath(path, type, Rversion)
    if (is.null(pkgs)) {
      files <- dir(pkgPath)
    } else {
      files <- sapply(
        pkgs,
        function(x) list.files(pkgPath, pattern = paste0("^", x, "_"))
      )
    }
    files <- unlist(files)
    pkgFiles <- grep("\\.(tar\\.gz|zip|tgz)$", basename(files), value = TRUE)

    # identify duplicate packages and warn the user
    pkgs <- sapply(strsplit(files, "_"), "[[", 1)
    dupes <- pkgs[duplicated(pkgs)]
    if (length(dupes)) {
      warning(
        "Duplicate package(s): ",
        paste(dupes, collapse = ", "),
        call. = FALSE
      )
    }
    file.path(pkgPath, pkgFiles)
  }

  duplicatePkgs <- sapply(type, do_one, simplify = FALSE)
  names(duplicatePkgs) <- type
  duplicatePkgs
}


# addPackage---------------------------------------------------------------

#' Add packages to a miniCRAN repository.
#'
#' @inheritParams makeRepo
#' @inheritParams pkgDep
#'
#' @template Rversion
#'
#' @param deps logical indicating whether the package dependencies should be
#'   added (default `TRUE`).
#'
#' @return Installs the packages, rebuilds the package index, and invisibly
#'   returns the number of packages written to the index files.
#'
#' @importFrom tools write_PACKAGES
#' @export
#' @family update repo functions
#'
#' @example /inst/examples/example_checkVersions.R
#'
addPackage <- function(
  pkgs = NULL,
  path = NULL,
  repos = getOption("repos"),
  type = "source",
  Rversion = R.version,
  writePACKAGES = TRUE,
  deps = TRUE,
  quiet = FALSE
) {
  if (is.null(path) || is.null(pkgs))
    stop("path and pkgs must both be specified.")

  do_one <- function(t) {
    prev <- checkVersions(
      pkgs = pkgs,
      path = path,
      type = t,
      Rversion = Rversion
    )
    prev <- prev[[1]]
    prev.df <- getPkgVersFromFile(prev)

    if (deps) pkgs <- pkgDep(pkgs, repos = repos, type = t, Rversion = Rversion)

    makeRepo(
      pkgs = pkgs,
      path = path,
      repos = repos,
      type = t,
      Rversion = Rversion,
      download = TRUE,
      writePACKAGES = FALSE,
      quiet = quiet
    )

    if (length(prev)) {
      curr <- suppressWarnings(
        checkVersions(pkgs = pkgs, path = path, type = t, Rversion = Rversion)
      )
      curr <- curr[[1]]
      curr.df <- getPkgVersFromFile(curr)

      findPrevPackage <- function(x) {
        grep(paste0("^", x), basename(prev))
      }

      dupes <- with(curr.df, package[duplicated(package)])
      if (length(dupes)) {
        to_remove <- lapply(dupes, findPrevPackage)
        if (length(unlist(to_remove))) {
          file.remove(prev[unlist(to_remove)])
        }
      }
    }
  }

  ret <- lapply(type, do_one)

  if (writePACKAGES)
    updateRepoIndex(path = path, type = type, Rversion = Rversion)
  invisible(ret)
}


# addOldPackage -----------------------------------------------------------

#' Add old package versions to a miniCRAN repository.
#'
#' Will download and add older source package versions. Older binary versions
#' are not normally available on CRAN and should be built from source on the
#' platform for which they are required. As such, specifying `type!="source"`
#' will likely fail as the download will not be successful.
#'
#' @inheritParams addPackage
#' @inheritParams makeRepo
#'
#' @param vers The package version to install.
#'
#' @return Adds the packages, rebuilds the package index, and invisibly returns
#'   the number of packages written to the index files.
#'
#' @note Dependencies for old package versions cannot be determined
#'   automatically and must be specified by the user in `pkgs` and `vers`. Thus,
#'   `deps=FALSE` is the default for this function.
#'
#' @importFrom tools write_PACKAGES
#' @export
#' @family update repo functions
#'
#' @example /inst/examples/example_checkVersions.R
#'
addOldPackage <- function(
  pkgs = NULL,
  path = NULL,
  vers = NULL,
  repos = getOption("repos"),
  type = "source",
  Rversion = R.version,
  writePACKAGES = TRUE,
  deps = FALSE,
  quiet = TRUE
) {
  if (is.null(path) || is.null(pkgs) || is.null(vers)) {
    stop("path, pkgs, and vers must all be specified.")
  }
  if (type != "source")
    stop(
      "Older binary versions are not normally available on CRAN. ",
      "You must build the binary versions from source."
    )
  if (deps) {
    message(
      "Unable to automatically determine dependency version information.\n",
      "Use pkgs and vers to identify which dependecies and their versions to download."
    )
  }
  vers <- as.character(vers)
  oldPkgs <- file.path(
    repos,
    repoPrefix(type, R.version),
    "Archive",
    pkgs,
    sprintf("%s_%s%s", pkgs, vers, pkgFileExt(type))
  )

  pkgPath <- repoBinPath(path = path, type = type, Rversion = Rversion)
  if (!file.exists(pkgPath)) dir.create(pkgPath, recursive = TRUE)

  do_one <- function(x) {
    result <- download.file(
      x,
      destfile = file.path(pkgPath, basename(x)),
      method = "auto",
      mode = "wb",
      quiet = quiet
    )
    if (result != 0) warning("error downloading file ", x)
  }
  ret <- sapply(oldPkgs, do_one)
  if (writePACKAGES) {
    updateRepoIndex(path = path, type = type, Rversion)
  }
  invisible(ret)
}


# .listFiles -------------------------------------------------------------------

#' List pre-built packages in a directory based on file extension
#'
#' @param pkgs  Character vector of package names
#' @param path  Character string specifying the directory containing packages to
#'   be added.
#' @param type  Character indicating the package type (e.g., "source",
#'   "win.binary", etc.).
#'
#' @return Installs the packages and returns the new package index.
#'
#' @rdname listFiles
#' @docType methods
#'
#' @keywords Internal
#'
#' @examples
#' \dontrun{
#'  .listFiles('path/to/my/packages', type = "source")
#' }
#'
.listFiles <- function(pkgs, path, type) {
  stopifnot(dir.exists(path))
  pattern <- pkgFileExt(type)

  # get a list of all files in pkgPaths directory matching pattern
  f <- list.files(path, pattern = pattern)

  assert_that(
    is.character(f) && length(f) > 0,
    msg = sprintf("No files found in path with extension '%s'", pattern)
  )

  # we only care about the subset matching pkgs
  f <- sapply(pkgs, function(x) {
    grep(x, f, value = TRUE)
  })

  if (length(f)) {
    # if multiple versions present, always use latest
    fp <- local({
      x <- strsplit(f, "_")
      sapply(x, `[[`, 1)
    })

    fv <- local({
      x <- strsplit(f, "_")
      x <- sapply(x, `[[`, 2)
      x <- strsplit(x, pattern)
      x <- sapply(x, `[[`, 1)
      as.numeric_version(x)
    })

    fout <- sapply(fp, function(x) {
      ids.p <- which(fp %in% x)

      # numeric_version always returns version using '.' as separator,
      #   even if the package uses '-', so we need to ensure either will work
      id.v <- which(fv == max(fv[ids.p]))

      f[id.v]
    })
    unique(fout)
  } else {
    character()
  }
}


#' Add local packages to a miniCRAN repository.
#'
#' Examine the contents of a directory specified by `pkgPath` for pre-built
#' packages matching the names specified by `pkgs`, and add these to the
#' miniCRAN repository.
#'
#' To build a package from source and then add it, use `build = TRUE`. Note that
#' package development libraries and the `devtools` package must be installed on
#' your system in order to build packages.
#'
#' @note Currently, adding local packages does not check nor download their
#'   dependencies.
#'
#' @inheritParams addPackage
#'
#' @param deps Not used. See note.
#'
#' @param pkgPath  Character vector of directory location containing packages to
#'   be added. Note that `pkgPath` should be the parent directory of the package
#'   (i.e., the package directory path is constructed from `file.path(pkgPath,
#'   pkgs)`).
#'
#' @param build Logical indicating whether packages should be build prior to
#'   adding.
#'
#' @return Installs the packages and returns the new package index.
#'
#' @export
#' @docType methods
#'
#' @author Alex Chubaty
#'
#' @examples
#' \dontrun{
#'  addLocalPackage("myPackage", "path/to/my/prebuilt/package",
#'                  "path/to/my/miniCRAN/repo")
#'
#'  addLocalPackage("myPackage", "path/to/my/package/sourcecode",
#'                  "path/to/my/miniCRAN/repo", build = TRUE)
#' }
#'
addLocalPackage <- function(
  pkgs = NULL,
  pkgPath = NULL,
  path = NULL,
  type = "source",
  Rversion = R.version,
  writePACKAGES = TRUE,
  deps = FALSE,
  quiet = FALSE,
  build = FALSE
) {
  if (is.null(path) || is.null(pkgs) || is.null(pkgPath)) {
    stop("path, pkgs, and pkgPath must be specified.")
  }

  stopifnot(dir.exists(file.path(pkgPath)))

  # build local package if needed
  if (isTRUE(build)) {
    warning("Building local packages is still being tested.")
    if (requireNamespace("devtools", quietly = TRUE)) {
      lapply(pkgs, function(x) {
        devtools::build(
          pkg = file.path(pkgPath, x),
          path = pkgPath,
          binary = ifelse(type == "source", FALSE, TRUE),
          quiet = quiet
        )
      })
    } else {
      stop("To build packages, you must first install the 'devtools' package.")
    }
  }

  # get list of pre-built packages for each type, filter by pkgs to be added
  do_one <- function(t) {
    repoPath <- file.path(path, repoPrefix(t, Rversion))
    if (!dir.exists(repoPath)) dir.create(repoPath, recursive = TRUE)
    files <- .listFiles(pkgs = pkgs, path = pkgPath, type = t)

    # check for previous package version and omit if identical
    prev <- checkVersions(pkgs, path)
    same <- which(basename(as.character(prev)) %in% files)

    if (length(same)) {
      files <- files[-same]
      if (length(files) == 0) {
        if (!quiet) message("All packages up to date. Nothing to add.")
        return(invisible(NULL))
      }
    }

    # copy other packages to their respective folders
    lapply(files, function(x) {
      f.src <- file.path(pkgPath, x)
      f.dst <- file.path(repoPath, x)

      file.exists(f.src)

      if (!isTRUE(quiet)) message("copying ", x, "\n")
      file.copy(from = f.src, to = f.dst)
    })

    # check to ensure they all copied successfully
    copied <- file.exists(file.path(repoPath, files))
    if (!all(copied)) {
      warning(
        "the following ",
        t,
        " packages were not copied:\n",
        paste(files[!copied], sep = ", ")
      )
    }

    # remove previous package versions
    if (length(prev[-same]) > 0) unlink(prev[-same])
    file.path(repoPath, files)[copied]
  }

  ret <- sapply(type, do_one)

  # write package index for each folder:
  if (writePACKAGES) {
    updateRepoIndex(path = path, type = type, Rversion = Rversion)
  }
  invisible(ret)
}