R/get_package_lists.R

In rmflight/reup: Provides Utilities for Upgrading Packages in an Old R Library

#' old packages
#'
#' get the list of packages installed in the old library
#'
#' @param old_library where to look
#'
#' @export
#' @return matrix
get_old_packages <- function(old_library = get_old_library()) {
  old_pkgs <- installed.packages(lib.loc = old_library)
  old_pkgs
}

#' new packages
#'
#' get the list of packages installed in the new library
#'
#' @param new_library where to look
#'
#' @export
#' @return matrix
get_new_packages <- function(new_library = get_new_library()){
  new_pkgs <- installed.packages(lib.loc = new_library)
  new_pkgs
}

#' compare lists
#'
#' Compares the old and new package lists, and then returns the list of things
#' that have yet to be installed in the new library location.
#'
#' @export
#' @return matrix
compare_old_new_library <- function(){
  old_pkgs <- get_old_packages()
  new_pkgs <- get_new_packages()

  old_pkgs <- old_pkgs[setdiff(rownames(old_pkgs), rownames(new_pkgs)), ]
  old_pkgs
}

#' number of dependencies
#'
#' get the number of dependencies for all of the packages
#'
#' @param pkg_matrix the matrix of package information
#'
#' @export
#' @return data.frame
n_package_deps <- function(pkg_matrix){
  pkg_deps <- paste0(pkg_matrix[, "Depends"], ", ",
                     pkg_matrix[, "Imports"], ", ",
                     pkg_matrix[, "Suggests"], "")
  pkg_frame <- as.data.frame(pkg_matrix, stringsAsFactors = FALSE)
  split_deps <- strsplit(pkg_deps, ",")
  n_deps <- vapply(split_deps, length, numeric(1))

  pkg_frame$n_deps <- n_deps
  pkg_frame
}

#' pkg matrix
#'
#' An example package information matrix generated by RMF on his personal R
#' installation.
#'
#' @source Robert M Flight
#'
"pkg_matrix"

match_type <- function(pkg_desc){
  #print(pkg_desc$Package)
  if (!is.null(pkg_desc$Repository)) {
    if (pkg_desc$Repository == "CRAN") {
      out_type <- data.frame(type = "cran", remote = "NA", branch = "NA", stringsAsFactors = FALSE)
    }
  }

  if (!is.null(pkg_desc$biocViews)) {
    out_type <- data.frame(type = "bioconductor", remote = "NA", branch = "NA", stringsAsFactors = FALSE)
  }

  if (!is.null(pkg_desc$RemoteType)) {
    if (pkg_desc$RemoteType == "local") {
      out_type <- data.frame(type = "local", remote = pkg_desc$RemoteUrl, branch = "NA", stringsAsFactors = FALSE)
      if (!is.null(pkg_desc$remoteBranch)) {
        out_type$branch = pkg_desc$RemoteBranch
      }
    } else if (pkg_desc$RemoteType == "github") {
      out_type <- data.frame(type = "github",
                             remote = paste0(pkg_desc$RemoteUsername, "/",
                                             pkg_desc$RemoteRepo),
                             branch = pkg_desc$RemoteRef,
                             stringsAsFactors = FALSE)
    }
  }

  if ((is.null(pkg_desc$Repository)) && (is.null(pkg_desc$biocViews)) && (is.null(pkg_desc$RemoteType))) {
    out_type <- data.frame(type = "NA", remote = "NA", branch = "NA", stringsAsFactors = FALSE)
  }
  out_type
}

#' package type
#'
#' Determine what type of package it is and where it needs to be installed from.
#' The types expected include: Cran, Bioconductor, local, and versioned repo (i.e.
#' github, bitbucket, gitlab).
#'
#' @param pkg_frame a data.frame of package information
#'
#' @export
#' @return data.frame
package_type <- function(pkg_frame){
  pkg_types <- lapply(seq(1, nrow(pkg_frame)), function(in_row){
    tmp_desc <- utils::packageDescription(pkg_frame[in_row, "Package"],
                                          pkg_frame[in_row, "LibPath"])
    reup:::match_type(tmp_desc)
  })
  pkg_types <- do.call(rbind, pkg_types)
  cbind(pkg_frame, pkg_types)
}