R/package-installation.R

Defines functions assure_package_installation assure_repos assure_user_lib update_packages old_packages available_dependencies install_packages get_default_packages get_pkglist default_pkglist detect_load_problems try_load_elsewhere

Documented in assure_package_installation assure_repos assure_user_lib available_dependencies default_pkglist detect_load_problems get_default_packages get_pkglist install_packages try_load_elsewhere

#' Check if package can be loaded
#'
#' Loading happens in a separate R process (that should find the same
#' .Renviron, etc... files as the current one so this should be a reproducible
#' check.  Returns FALSE unless the package can be loaded
#'
#' Does not affect state of namespace in the current session!
#'
#' @param pkg name of the package as a string
#' @return TRUE iff package can be loaded
#'
#' @export
try_load_elsewhere = function(pkg) {
  cl = parallel::makePSOCKcluster(names = 'localhost')
  outcome = try(parallel::clusterCall(cl = cl, fun = function(p) {
    o = try(require(package = p, character.only = TRUE))
    return(o)
  }, p = pkg))[[1]]
  parallel::stopCluster(cl = cl)
  if (isTRUE(outcome)) {
    return(TRUE)
  }
  return(FALSE)
}

#' Check if packages can be loaded report problems
#'
#' See `workflow::try_load_elsewhere` for details on check.
#'
#' @param pkgs vector of package names
#' @return vector of package names for packages with load problems
#'
#' @export
detect_load_problems = function(pkgs) {
  problems = character()
  default_packages = getOption("defaultPackages")
  for (pkg in pkgs) {
    if (pkg %in% default_packages)
      next
    loaded = try_load_elsewhere(pkg) 
    if (!isTRUE(loaded))
      problems = c(problems, pkg)
  }
  return(problems) 
}

#' Default place to find list of packages
#'
#' one package name per line
#'
#' @param path where to find list
#' @return path to package list
#'
#' @export
default_pkglist = function(path = "~/.Rpackages") return(path)

#' Retrieve the list of packages that should be installed
#'
#' @param path path to file with default list
#' @return vector of package names to install
#'
#' @export
get_pkglist = function(path = default_pkglist()) {
  if (!file.exists(path)) {
    msg = paste0("The file '", path, "' does not exist.")
  }
  pkgs = readLines(path)
  pkgs = pkgs[pkgs != ""]
  return(pkgs)
}

#' Retrieve list of R's default packages
#'
#' Just avoiding brain freeze
#'
#' @return R's list of default packages
#' @export
get_default_packages = function() getOption("defaultPackages")

#' Install a list of packages
#'
#' @param packages vector of package names to install
#' @return list with namems of installs attempted, successes, and failures
#'
#' @export
install_packages = function(
  packages = get_pkglist(),
  lib = assure_user_lib()[1],
  repos = assure_repos(),
  dependencies = c("Depends", "Imports")
) {
  local({
    r = options(repos)
    options(repos = repos)
    try(renv::install(packages = packages, library = lib,
      prompt = FALSE))
    options(repos = r)
  })
  problems = detect_load_problems(packages)
  o = list(
    attempted = packages,
    success = setdiff(packages, problems),
    problems = problems)
  return(o)
}


#' List available packages
#'
#' @param packages packages to check dependency info for
#' @param ... additional options to `available.packages`
#' @return list of lists of packages with dependencies and versions
#'
#' @export
available_dependencies = function(
  packages,
  repos = assure_repos(),
  ...
) {
  ap = available.packages(...)
  dependency_info = 
    purrr::map(packages, ~ ap[.x, c('Depends', 'Imports')]) |>
    purrr::map( ~ stringr::str_replace_all(.x, '\n', '')) |>
    purrr::map( ~ stringr::str_split(.x, ',[ ]*')) |>
    purrr::map(purrr::flatten_chr)
  dependencies = dependency_info |>
    purrr::map(stringr::str_split, pattern = ' ') |>
    purrr::map(purrr::map_chr,  ~ .x[1])
 
  min_versions =
    dependency_info |>
    purrr::map(stringr::str_split, pattern = ' ') |>
    purrr::map(purrr::map_chr,  ~ paste(.x[-1], collapse = ' ')) |>
    purrr::map(stringr::str_replace, pattern = '\\((.*)\\)', replacement = '\\1') |>
    purrr::map(stringr::str_replace, pattern = '[^0-9]*([0-9\\.]+)', replacement = '\\1')
  o = purrr::map2(dependencies, min_versions, 
    ~ purrr::map2(.x, .y, ~ list(package_name = .x, min_version = .y)))
  names(o) = packages
  return(o)
}

#' @export
old_packages = function(lib_path = assure_user_lib()[1], repos = assure_repos()) {
  old = old.packages(lib.loc = lib_path, repos = repos)
  return(old)
}

#' @export
update_packages = function(
  packages = old_packages(), 
  lib_path = assure_user_lib()[1],
  repos = assure_repos(),
  dependencies = c("Depends", "Imports")
) {
  old_package_list = old_packages(lib_path, repos)
  old_package_names = old_package_list[,'Package']
  install_packages(old_package_names, lib_path, repos, dependencies)
  return(old_package_names)
}
   
#' Make sure the path to the user's location for R packages exists
#'
#' @param lib_path where to put packages
#' @return detected library paths
#'
#' @export
assure_user_lib = function(lib_path = Sys.getenv("R_LIBS_USER")) {
  if (!dir.exists(lib_path))
    dir.create(lib_path, recursive=TRUE)
  lp = .libPaths(lib_path)
  return(lp)
}
 
#' Make sure the repos option is set and matches the environmental variable
#'
#' @return URL for repos to use
#'
#' @export
assure_repos = function() {
  current_repos = getOption("repos")
  current_repos['CRAN'] = Sys.getenv("R_CRAN")
  options(repos = current_repos)
  return(getOption("repos"))
}

#' Maks sure the list of packages is installed
#'
#' @param path path to list of packages (one per line)
#' @return character vector of packages that failed to install.
#'
#' @export
assure_package_installation = function(
  path = default_pkglist(),
  lib = assure_user_lib()[1],
  repos = assure_repos(),
  dependencies = c("Depends", "Imports")
) {
  options(stringsAsFactors=FALSE)
  
  installed_packages = rownames(utils::installed.packages())
  update_packages(installed_packages)
  non_default_packages = setdiff(installed_packages, get_default_packages())
  
  problems = detect_load_problems(installed_packages)
  repair_install = install_packages(problems, lib, repos, dependencies)
  
  installed_packages = rownames(utils::installed.packages())
  remaining_packages = setdiff(x=get_pkglist(path), y=installed_packages)
  if (length(remaining_packages) != 0) {
    remaining_install = install_packages(remaining_packages, lib, repos, dependencies)
  }
  remaining_packages = setdiff(x=get_pkglist(path), y=installed_packages)
  return(remaining_packages)
}
sakrejda/workflow documentation built on Nov. 18, 2024, 3:02 a.m.