R function to compile a tar.gz source R package into a zip compiled/binary R windows package

build_windows_binary.R

build_windows_binary <- function(src_tar_gz,
                                 out_dir = dirname(normalizePath(src_tar_gz, winslash = "/", mustWork = TRUE)),
                                 lib = file.path(tempdir(), "r-win-bin-lib"),
                                 install_deps = FALSE,
                                 dep_fields = c("Depends", "Imports", "LinkingTo"),
                                 repos = {
                                   r <- getOption("repos")
                                   if (is.null(r) || identical(unname(r["CRAN"]), "@CRAN@")) {
                                     c(CRAN = "https://cloud.r-project.org")
                                   } else {
                                     r
                                   }
                                 },
                                 rcmd = file.path(R.home("bin"), "Rcmd.exe"),
                                 install_args = character(),
                                 clean = TRUE,
                                 verbose = TRUE) {
  stopf <- function(...) stop(sprintf(...), call. = FALSE)
  msg <- function(...) if (isTRUE(verbose)) message(sprintf(...))
  q <- function(x) shQuote(x, type = if (.Platform$OS.type == "windows") "cmd" else "sh")

  if (.Platform$OS.type != "windows") {
    stopf(
      paste(
        "This builds a Windows .zip binary and must be run under Windows.",
        "On Linux/WSL, use a Windows CI runner, win-builder, or R-hub instead."
      )
    )
  }

  if (!file.exists(src_tar_gz)) stopf("Source tarball not found: %s", src_tar_gz)

  src_tar_gz <- normalizePath(src_tar_gz, winslash = "/", mustWork = TRUE)

  if (!grepl("\\.tar\\.gz$", basename(src_tar_gz), ignore.case = TRUE)) {
    stopf("Expected a source package tarball ending in .tar.gz: %s", src_tar_gz)
  }

  if (!file.exists(rcmd)) stopf("Could not find Rcmd.exe at: %s", rcmd)

  dir.create(out_dir, recursive = TRUE, showWarnings = FALSE)
  dir.create(lib, recursive = TRUE, showWarnings = FALSE)

  out_dir <- normalizePath(out_dir, winslash = "/", mustWork = TRUE)
  lib <- normalizePath(lib, winslash = "/", mustWork = TRUE)

  read_description <- function(tarball) {
    files <- utils::untar(tarball, list = TRUE)
    desc <- files[grepl("^[^/\\\\]+[/\\\\]DESCRIPTION$", files)][1L]

    if (is.na(desc)) {
      stopf("No top-level DESCRIPTION file found in %s", basename(tarball))
    }

    td <- tempfile("r-pkg-desc-")
    dir.create(td)
    on.exit(unlink(td, recursive = TRUE, force = TRUE), add = TRUE)

    utils::untar(tarball, files = desc, exdir = td)
    read.dcf(file.path(td, desc))[1L, , drop = FALSE]
  }

  pkg_names <- function(x) {
    x <- x[!is.na(x) & nzchar(x)]
    if (!length(x)) return(character())

    x <- unlist(strsplit(x, ",", fixed = TRUE), use.names = FALSE)
    x <- trimws(sub("\\s*\\(.*\\)\\s*$", "", x))
    unique(x[nzchar(x) & x != "R"])
  }

  install_cran_deps <- function(tarball) {
    desc <- read_description(tarball)
    fields <- intersect(dep_fields, colnames(desc))
    direct <- pkg_names(unname(desc[1L, fields]))

    if (!length(direct)) return(invisible(character()))

    old_libs <- .libPaths()
    on.exit(.libPaths(old_libs), add = TRUE)
    .libPaths(unique(c(lib, old_libs)))

    ap <- utils::available.packages(repos = repos)
    direct_in_repos <- intersect(direct, rownames(ap))

    recursive <- if (length(direct_in_repos)) {
      tools::package_dependencies(
        direct_in_repos,
        db = ap,
        which = dep_fields,
        recursive = TRUE
      )
    } else {
      list()
    }

    deps <- unique(c(direct, unlist(recursive, use.names = FALSE)))
    deps <- deps[nzchar(deps) & deps != "R"]

    installed <- rownames(utils::installed.packages(lib.loc = .libPaths()))
    missing <- setdiff(deps, installed)

    if (length(missing)) {
      msg(
        "Installing missing dependencies into temporary library: %s",
        paste(missing, collapse = ", ")
      )

      utils::install.packages(
        missing,
        lib = lib,
        repos = repos,
        type = getOption("pkgType"),
        dependencies = FALSE
      )
    }

    invisible(missing)
  }

  old_env <- Sys.getenv(c("R_LIBS", "R_LIBS_USER"), unset = NA_character_)

  restore_env <- function() {
    for (nm in names(old_env)) {
      if (is.na(old_env[[nm]])) {
        Sys.unsetenv(nm)
      } else {
        do.call(Sys.setenv, setNames(as.list(old_env[[nm]]), nm))
      }
    }
  }

  on.exit(restore_env(), add = TRUE)

  old_libs <- .libPaths()
  on.exit(.libPaths(old_libs), add = TRUE)

  .libPaths(unique(c(lib, old_libs)))

  Sys.setenv(
    R_LIBS = paste(.libPaths(), collapse = .Platform$path.sep),
    R_LIBS_USER = lib
  )

  if (isTRUE(install_deps)) install_cran_deps(src_tar_gz)

  build_dir <- tempfile("r-win-bin-build-")
  dir.create(build_dir)

  if (isTRUE(clean)) {
    on.exit(unlink(build_dir, recursive = TRUE, force = TRUE), add = TRUE)
  }

  old_wd <- getwd()
  on.exit(setwd(old_wd), add = TRUE)
  setwd(build_dir)

  args <- c("INSTALL", "-l", q(lib), "--build", install_args, q(src_tar_gz))

  msg("Running: %s %s", basename(rcmd), paste(args, collapse = " "))

  out <- system2(rcmd, args = args, stdout = TRUE, stderr = TRUE)
  status <- attr(out, "status")
  if (is.null(status)) status <- 0L

  log_file <- file.path(build_dir, "R_CMD_INSTALL_build.log")
  writeLines(enc2utf8(out), con = log_file, useBytes = TRUE)

  if (!identical(as.integer(status), 0L)) {
    stopf(
      "R CMD INSTALL --build failed with status %s.\nLog file: %s\n\n%s",
      status,
      log_file,
      paste(tail(out, 80), collapse = "\n")
    )
  }

  zips <- list.files(build_dir, pattern = "\\.zip$", full.names = TRUE)

  if (length(zips) != 1L) {
    stopf(
      "Expected exactly one .zip output, found %d.\nLog file: %s\n\n%s",
      length(zips),
      log_file,
      paste(tail(out, 80), collapse = "\n")
    )
  }

  dest <- file.path(out_dir, basename(zips))

  if (!file.copy(zips, dest, overwrite = TRUE)) {
    stopf("Built zip but could not copy it to: %s", dest)
  }

  normalizePath(dest, winslash = "/", mustWork = TRUE)
}