build-cran-binaries/R/build_binaries.R

#' @import progressr
#' @importFrom future plan
#' @importFrom future.apply future_mapply
#' @importFrom gert git_config_set
#' @importFrom pak local_install_dev_deps
#' @importFrom pkgbuild build
build_binary_package <- function(package_name, tag = NULL, codename = NULL,
                                 r_version_minor = NULL, build_for_minor = TRUE,
                                 local_build_root = "/root",
                                 local_clone_dir = "/tmp",
                                 pak_pkg_syrsreqs_platform = "redhat-9",
                                 install_system_dependencies = TRUE) {
  codename <- set_codename(codename)

  if (is.null(r_version_minor)) {
    r_version_minor <- sub("R version (\\d+\\.\\d+).*", "\\1", R.Version()$version.string)
  }

  # create directory structure
  dir_out_bin <- set_bin_path(r_version_minor, build_for_minor, local_build_root, codename)
  dir_out_src <- sprintf("%s/src/contrib/Archive", local_build_root)
  cli::cli_alert_info("{.fun build_binary_package}: Creating dir {.path {dir_out_bin}}.")
  cli::cli_alert_info("{.fun build_binary_package}: Creating dir {.path {dir_out_src}}.")
  dir.create(sprintf("%s/Archive", dir_out_bin), sprintf("%s/Archive", dir_out_src),
    recursive = TRUE
  )

  cli::cli_h2("Installing system dependencies")

  ### Install system dependencies
  if (install_system_dependencies) {
    install_package_system_dependencies(package_name, pak_pkg_syrsreqs_platform, tag, local_clone_dir_single)
  }

  gert::git_config_global_set("advice.detachedHead", "false")

  if (is.null(tag)) {
    # get all tags of package
    gert::git_clone(sprintf("https://github.com/cran/%s", package_name),
      path = sprintf("%s/%s", tempdir(), "tmp1"),
      verbose = FALSE
    )
    # Retrieve all tags
    all_tags <- gert::git_tag_list(repo = sprintf("%s/%s", tempdir(), "tmp1"))
    unlink(sprintf("%s/%s", tempdir(), "tmp1"), force = TRUE, recursive = TRUE)
    tag <- all_tags$name
    package_name <- rep(package_name, length(tag))

    cli::cli_alert_info("Building binaries for {.pkg {package_name[[1]]}} with tags {.env {tag}}.")
  }

  cli::cli_h2("Building")

  # devtools::install(quiet = TRUE)

  # Set up the progress handler
  progressr::handlers(global = TRUE)
  progressr::handlers("cli")

  # cli::cli_alert("{package_name}")
  # cli::cli_alert("{tag}")

  out <- progressr::with_progress({
    p <- progressr::progressor(along = tag)
    future_mapply(function(x, y) {
      p()
      build_single_tag(x, y, dir_out_bin, local_clone_dir)
    }, package_name, tag, future.seed = TRUE)
  })

  #   future.apply::future_mapply(build_single_tag,
  #   package_name = package_name, tag = tag,
  #   MoreArgs = list(
  #     dir_out_bin = dir_out_bin,
  #     local_clone_dir = local_clone_dir
  #   ),
  #   future.seed = TRUE
  # )

  return(invisible(TRUE))
}

install_package_system_dependencies <- function(package_name,
                                                pak_pkg_syrsreqs_platform = "redhat-9",
                                                tag,
                                                local_clone_dir_single) {
  cli::cli_alert_info("{.fun install_package_system_dependencies}: Cloning package {.env {package_name}} with tag {.env {tag}}.")

  if (!dir.exists(local_clone_dir_single)) {
    system2("git", args = c(
      "clone", "-q", sprintf("--branch=%s", tag),
      sprintf("https://github.com/cran/%s", package_name), local_clone_dir_single
    ))
  }

  Sys.setenv(PKG_SYSREQS_PLATFORM = pak_pkg_syrsreqs_platform)
  Sys.setenv(PKG_SYSREQS = TRUE)
  Sys.setenv(PKG_SYSREQS_VERBOSE = TRUE)
  pak::local_install_dev_deps(sprintf("%s", local_clone_dir_single))

  cli::cli_alert_info("{.fun install_package_system_dependencies}: 4. Removing {.path {local_clone_dir_single}}.")
  # delete clone again as we need a full clone of the repo when not only building a single tag
  if (!is.null(tag)) {
    unlink(sprintf("%s", local_clone_dir_single), recursive = TRUE, force = TRUE)
  }
}


#' @importFrom cli cli_alert_info
#' @importFrom pkgbuild build
build_single_tag <- function(package_name, tag = NULL,
                             dir_out_bin,
                             local_clone_dir) {

  local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name, tag)

  cli::cli_alert_info("{.fun build_single_tag}: 1. Cloning package {.pkg {package_name}} with tag {.env {tag}}.")

  # Using system git here as {gert} does not provide this functionality
  system2("git", args = c(
    "clone", "-q", sprintf("--branch=%s", tag),
    sprintf("https://github.com/cran/%s", package_name), local_clone_dir_single
  ))

  cli::cli_alert_info("{.fun build_single_tag}: 2. Building package {.pkg {package_name}} with tag {.env {tag}}.")

  pkgbuild::build(
    path = sprintf("%s", local_clone_dir_single),
    binary = TRUE, vignettes = FALSE,
    dest_path = dir_out_bin
  )

  if (!file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) {
    cli::cli_alert_info('{.fun build_single_tag}: 3. Moving package from {.path {sprintf("%s/%s*.tar.gz", dir_out_bin, package_name)}} to {.path {sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag)}}')
    # remove _aarch64-unknown-linux-gnu part in filename
    system2("rsync", args = c(
      sprintf("%s/%s_%s*.tar.gz", dir_out_bin, package_name, tag),
      sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag)
    ))
  } else {
    cli::cli_alert_warning('{.fun build_single_tag}: Binary {sprintf("%s_%s.tar.gz", package_name, tag)} already exists. Skipping copy.')
  }
  unlink(sprintf("%s/%s_%s_R*.tar.gz", dir_out_bin, package_name, tag))

  cli::cli_alert_info("{.fun build_single_tag}: 4. Removing {.path {local_clone_dir_single}}.")
  unlink(local_clone_dir_single, force = TRUE, recursive = TRUE)
}