R/dev_install.R

In coda.pack: Meta-Package for Compositional Data Analysis

#' Development repositories in the coda ecosystem
#'
#' @return A character vector. Each element is a GitHub repository identifier
#'   of the form `"owner/repository"` corresponding to a development package
#'   in the `coda` ecosystem.
#' @examples
#' coda_dev_repos()
#' @export
coda_dev_repos <- function() {
  c(
    "mcomas/coda.count"
  )
}

#' Install development packages from the coda ecosystem
#'
#' Installs the development extensions of the `coda` ecosystem from GitHub.
#'
#' Currently, this function installs:
#' - `coda.count`
#'
#' @param upgrade Upgrade policy passed to [remotes::install_github()].
#'
#' @return Invisibly returns a character vector with the GitHub repositories
#'   that were passed to [remotes::install_github()]. Each element is of the
#'   form `"owner/repository"`.
#' @export
install_coda_dev <- function(upgrade = "never") {
  repos <- coda_dev_repos()

  if (!requireNamespace("remotes", quietly = TRUE)) {
    stop(
      "Package 'remotes' must be installed to use `install_coda_dev()`.",
      call. = FALSE
    )
  }

  for (repo in repos) {
    remotes::install_github(repo, upgrade = upgrade, dependencies = NA)
  }

  invisible(repos)
}

#' Update installed packages from the coda ecosystem
#'
#' Updates installed packages that belong to the `coda` ecosystem.
#' CRAN packages are updated only if a newer version is available on CRAN.
#' GitHub packages are updated from their development repositories.
#'
#' By default, only already installed packages are considered. This avoids
#' installing optional packages that are part of the ecosystem but not yet
#' present in the user's library.
#'
#' @param installed_only Logical. If `TRUE` (default), only packages already
#'   installed in the current library are considered for update.
#' @param ask Logical. Passed to [utils::old.packages()] for CRAN updates.
#'   Default is `FALSE`.
#' @param repos Character vector of CRAN repositories passed to
#'   [utils::install.packages()]. If `NULL`, the current `getOption("repos")`
#'   value is used.
#' @param quiet Logical. If `TRUE`, reduce console output where possible.
#'   Default is `FALSE`.
#'
#' @return Invisibly returns a list with components:
#' \describe{
#'   \item{cran}{Character vector of CRAN packages updated.}
#'   \item{github}{Character vector of GitHub packages processed for update.}
#'   \item{skipped}{Character vector of ecosystem packages skipped because they
#'   were not installed and `installed_only = TRUE`.}
#' }
#' @export
update_coda_packages <- function(installed_only = TRUE,
                                 ask = FALSE,
                                 repos = NULL,
                                 quiet = FALSE) {
  pkgs <- coda_packages()
  ip <- utils::installed.packages()

  installed_names <- rownames(ip)

  if (installed_only) {
    skipped <- setdiff(pkgs$package, installed_names)
    pkgs <- pkgs[pkgs$package %in% installed_names, , drop = FALSE]
  } else {
    skipped <- character(0)
  }

  if (nrow(pkgs) == 0L) {
    if (!quiet) {
      message("No installed packages from the coda ecosystem were found.")
    }
    return(invisible(list(
      cran = character(0),
      github = character(0),
      skipped = skipped
    )))
  }

  cran_pkgs <- pkgs$package[pkgs$source == "CRAN"]
  github_pkgs <- pkgs$package[pkgs$source == "GitHub"]

  updated_cran <- character(0)
  updated_github <- character(0)

  repos_use <- `%||%`(repos, getOption("repos"))

  ## CRAN packages: update only if a newer version exists
  if (length(cran_pkgs) > 0L) {
    inst_cran <- ip[rownames(ip) %in% cran_pkgs, , drop = FALSE]

    if (nrow(inst_cran) > 0L) {
      old <- utils::old.packages(
        lib.loc = .libPaths(),
        repos = repos_use,
        instPkgs = inst_cran,
        checkBuilt = FALSE
      )

      if (!is.null(old) && nrow(old) > 0L) {
        updated_cran <- rownames(old)
        utils::install.packages(
          pkgs = updated_cran,
          repos = repos_use,
          quiet = quiet
        )
      } else if (!quiet) {
        message("CRAN packages from the coda ecosystem are already up to date.")
      }
    }
  }

  ## GitHub packages: update only if installed
  if (length(github_pkgs) > 0L) {
    github_pkgs <- github_pkgs[github_pkgs %in% installed_names]

    if (length(github_pkgs) > 0L) {
      if (!requireNamespace("remotes", quietly = TRUE)) {
        stop(
          "Package 'remotes' must be installed to update GitHub packages.",
          call. = FALSE
        )
      }

      repos_dev <- coda_dev_repos()
      repo_map <- stats::setNames(repos_dev, basename(repos_dev))
      github_repos <- unname(repo_map[github_pkgs])

      missing_repo <- is.na(github_repos)
      if (any(missing_repo)) {
        warning(
          "No GitHub repository mapping found for: ",
          paste(github_pkgs[missing_repo], collapse = ", "),
          call. = FALSE
        )
        github_repos <- github_repos[!missing_repo]
        github_pkgs <- github_pkgs[!missing_repo]
      }

      if (length(github_repos) > 0L) {
        for (i in seq_along(github_repos)) {
          if (!quiet) {
            message("Updating GitHub package: ", github_pkgs[i])
          }
          remotes::install_github(
            github_repos[i],
            upgrade = "never",
            dependencies = NA,
            force = FALSE,
            quiet = quiet
          )
        }
        updated_github <- github_pkgs
      }
    }
  }

  invisible(list(
    cran = updated_cran,
    github = updated_github,
    skipped = skipped
  ))
}

`%||%` <- function(x, y) {
  if (is.null(x)) y else x
}