pak

#!/usr/bin/env Rscript

# nolint next: object_name_linter.
SCRIBE_VERSION <- "0.3.0"

dot_lib_paths <- function() {
  user <- Sys.getenv("SUDO_USER")
  if (!nzchar(user)) {
    return(.libPaths())
  }

  args <- c("-i -u", user, "Rscript -e 'writeLines(.libPaths())'")
  res <- system2("sudo", args, stdout = TRUE)
  res[dir.exists(res)]
}

print_eval <- function(fun, ...) {
  fun <- substitute(fun)
  call <- as.call(do.call(alist, c(fun, list(...))))
  print_call(call)
  eval(as.expression(call))
}

print_call <- function(g) {
  stopifnot(is.call(g))
  ls <- as.list(g)
  ls[] <- lapply(ls, deparse1)
  cat(
    ls[[1]], "(\n  ",
    paste0(names(ls)[-1], " = ", ls[-1], collapse = ",\n  "),
    "\n)\n",
    sep = ""
  )
}

execute_repos <- function(arg, ...) {
  arg$value <- do_execute_repos(arg$get_value())
  invisible()
}

do_execute_repos <- function(value) {
  if (!is.null(value)) {
    return(c(CRAN = value))
  }

  if (isTRUE(value == "cran")) {
    return(c(CRAN = "https://cloud.r-project.org"))
  }

  env <- Sys.getenv("CRAN_REPOS")

  if (nzchar(env)) {
    return(c(CRAN = env))
  }

  repos <- c(
    CRAN = "https://packagemanager.posit.co/cran/latest",
    CRAN = "https://cloud.r-project.org"
  )

  if (.Platform$OS.type == "unix") {
    repos <- c(
      CRAN = sprintf(
        "https://packagemanager.posit.co/cran/__linux__/%s/latest",
        system2("lsb_release", "-cs", stdout = TRUE)
      ),
      repos
    )
  }

  repos
}

lib_scribe <- Sys.getenv("R_LIBS_SCRIBE", "~/R/scribe-library")
lib_scribe_expected <- lib_scribe <- normalizePath(lib_scribe, "/", FALSE)

if (!requireNamespace("scribe", quietly = TRUE, lib.loc = lib_scribe)) {
  # placeholder.  should try to maintain {scribe} in a separate location
  scribe_install_txt <- sprintf(
    paste(
      "mkdir -p \"%s\" &&",
      "Rscript --vanilla \\",
      "  -e \"options(repos = %s)\" \\",
      "  -e \"utils::install.packages('scribe', '%s')\"",
      sep = "\n  "
    ),
    lib_scribe_expected,
    if (isTRUE(getOption("repos") == "@CRAN@")) {
      "c(CRAN = 'https://cloud.r-project.org')"
    } else {
      getOption("repos")
    },
    lib_scribe_expected
  )

  lib_scribe <- tryCatch(
    find.package("scribe"),
    packageNotFoundError = function(e) {
      stop(
        "The 'scribe' package is not installed. ",
        "Please install with: \n",
        scribe_install_txt,
        call. = FALSE
      )
    }
  )

  warning(
    "The 'scribe' package is not installed in an expected location. ",
    "Please set 'R_LIBS_SCRIBE' or save in default location:",
    " ~/R/scribe-library",
    "\nYou can install with: \n",
    scribe_install_txt,
    "\n",
    call. = FALSE
  )
}

args <- try(silent = TRUE, {
  library(scribe, lib.loc = lib_scribe, include.only = "command_args")
  ca <- command_args()
  ca$add_description("pak : R package installation")
  ca$add_description(
    "console wrapper for calling pak::pak() from R, with some extra features"
  )
  ca$add_example("pak fuj", "install {fuj} from CRAN")
  ca$add_example(
    "pak -d true -u github::tidyverse/dplyr github::tidyverse/tidyr",
    "install dev packages"
  )
  ca$add_example(
    "pak --lockfile",
    "trigger use of lockfile setups"
  )
  ca$add_argument(
    "...",
    "pkgs",
    default = "local::.",
    info = "packages to install (default: local::.)"
  )
  ca$add_argument(
    "-d",
    "--dep",
    "--dependencies",
    default = NULL,
    info = c(
      "dependencies (coerced).",
      " Defaults to TRUE when pkgs is 'local::.' or --dev is set, otherwise NA"
    )
  )
  ca$add_argument(
    "-u",
    "--upgrade",
    action = "flag",
    default = NA,
    info = c(
      "use most recent version of packages, TRUE when pkgs is 'local::.'",
      " or --dev is set, otherwise FALSE"
    )
  )
  ca$add_argument(
    "--update",
    action = "flag",
    default = TRUE,
    info = "install new versions of packages"
  )
  ca$add_argument(
    "--sysreqs",
    action = "flag",
    default = FALSE,
    info = "Tries to install system requirements"
  )
  ca$add_argument(
    "--dev",
    action = "flag",
    info = "install only local package dependencies"
  )
  ca$add_argument(
    "-e",
    "--echo",
    action = "flag",
    default = FALSE,
    info = "Echo the lock file"
  )
  ca$add_argument(
    "--lib",
    action = "list",
    default = dot_lib_paths()[1],
    info = "library location for plan and installation"
  )
  ca$add_argument(
    "--lib-create",
    action = "list",
    default = NULL,
    info = c(
      "library location used for creating installation plan",
      "when NULL defaults to --lib-loc"
    )
  )
  ca$add_argument(
    "--lib-install",
    action = "list",
    default = NULL,
    info = c(
      "library location to install pkgs",
      "defaults to --lib-loc"
    )
  )
  ca$add_argument(
    "--repos",
    default = NULL,
    action = "list",
    info = "Sets the repository",
    execute = execute_repos
  )
  ca$add_argument(
    "--extra-messages",
    default = TRUE,
    action = "flag",
    info = "sets options(pak.no_extra_messages)"
  )
  ca$add_argument(
    "--install-pak",
    action = "flag",
    default = FALSE,
    info = "Early exit to install CRAN version of {pak}"
  )
  ca$add_argument(
    "--update-scribe",
    action = "flag",
    options = list(no = FALSE),
    info = "Early exit to install CRAN version of {scribe}"
  )
  ca$add_argument(
    "--update-scribe-dev",
    action = "flag",
    options = list(no = FALSE),
    info = "Early exit to install development version of {scribe} from GitHub"
  )
  ca$add_argument(
    "--lib-pak",
    action = "list",
    default = Sys.getenv(
      "R_LIBS_PAK",
      Sys.getenv("PAK_LIB", "~/R/pak-library")
    ),
    info = "library location for {pak}"
  )
  ca$add_argument(
    "--lockfile",
    action = "flag",
    default = FALSE,
    info = c(
      "Triggers use of lockfile setup,",
      " otherwise simplified 'pak::pak()' is employed"
    )
  )
  ca$parse()
})

if (inherits(args, "try-error")) {
  # remake args but retain condition
  args <- structure(list(), condition = attr(args, "condition"))
  ca <- commandArgs()
  args$update_scribe <- "--update-scribe" %in% ca
  args$update_scribe_dev <- "--update-scribe-dev" %in% ca
  args$install_pak <- "--install-pak" %in% ca
  fail <- TRUE
  warning("failed to parse arguments")
} else {
  fail <- FALSE
}

if (args$install_pak) {
  pak_install <- Sys.which("pak-install")
  if (!nzchar(pak_install)) {
    warning("pak-install not found in PATH")
  } else {
    system2(pak_install)
  }
  quit()
}

if (!require(
  pak,
  lib.loc = args$lib_pak,
  include.only = c(
    "pkg_install",
    "local_install_dev_deps",
    "lockfile_create",
    "lockfile_install"
  ),
  quietly = TRUE
)) {
  warning(
    "pak is not installed, try:\n",
    "$ pak --install-pak",
    call. = FALSE
  )
  quit()
}

if (args$update_scribe) {
  print_eval(
    pak,
    pkg = "scribe",
    lib = lib_scribe,
    upgrade = TRUE
  )
  quit()
}

if (args$update_scribe_dev) {
  print_eval(
    pak,
    pkg = "github::jmbarbone/scribe",
    lib = lib_scribe,
    upgrade = TRUE
  )
  quit()
}

scribe_version <- try(packageVersion("scribe"), silent = TRUE)
if (
  inherits(scribe_version, "try-error") ||
  scribe_version < SCRIBE_VERSION
) {
  warning(
    "some features may not work properly, try:\n",
    "$ pak --update-scribe",
    "\n...or\n",
    "$ pak --update-scribe-dev",
    call. = FALSE
  )
}

if (fail) {
  warning(attr(args, "condition"))
  cat(
    "Try one of:",
    "$ pak --help",
    "$ pak --update-scribe",
    "$ pak --update-scribe-dev",
    "$ pak --install-pak",
    "",
    sep = "\n",
    file = stderr()
  )
  quit()
}

# wrapper for:
#> pak::lockfile_create()
#> pak::lockfile_install()
pak_lockfile <- function(
    pkgs,
    lib = dot_lib_paths()[1],
    upgrade = NA,         # check pkgs == "local::."
    dependencies = NULL,  # check pkgs == "local::."
    update = TRUE,
    sysreqs = FALSE,
    echo = FALSE,
    lib_create = lib,
    lib_install = lib,
    repos = "https://cloud.r-project.org",
    extra_messages = TRUE,
    ...
) {
  op <- options(
    repos = c(CRAN = repos),
    pak.no_extra_messages = extra_messages
  )
  on.exit(options(op))

  if (is.null(lib_create)) {
    lib_create <- lib
  }

  if (is.null(lib_install)) {
    lib_install <- lib
  }

  if (sysreqs) {
    Sys.setenv(PKG_SYSREQS = "true")
  } else {
    Sys.setenv(PKG_SYSREQS = "false")
  }

  is_local <- isTRUE(grepl("local::.", pkgs, fixed = TRUE))

  if (is.null(dependencies)) {
    if (is_local) {
      dependencies <- TRUE
    } else {
      dependencies <- NA
    }
  }

  if (is.na(upgrade)) {
    if (is_local) {
      upgrade <- TRUE
    } else {
      upgrade <- FALSE
    }
  }

  lockfile <- normalizePath(tempfile(), "/", FALSE)
  on.exit(unlink(lockfile), add = TRUE)

  print_eval(
    lockfile_create,
    pkg = pkgs,
    lockfile = lockfile,
    lib = lib_create,
    dependencies = dependencies,
    upgrade = upgrade
  )

  if (echo) {
    writeLines(readLines(lockfile))
  }

  print_eval(
    lockfile_install,
    lockfile = lockfile,
    lib = lib_install,
    update = update
  )
}

# wrapper for
#> pak::pkg_install()
pak_install <- function(
    pkgs,
    lib = dot_lib_paths()[1],
    upgrade = NA,         # check pkgs == "local::."
    dependencies = NULL,  # check pkgs == "local::."
    sysreqs = FALSE,
    repos = "https://cloud.r-project.org",
    extra_messages = TRUE,
    ...
) {
  op <- options(
    repos = c(CRAN = repos),
    pak.no_extra_messages = extra_messages
  )
  on.exit(options(op))

  if (sysreqs) {
    Sys.setenv(PKG_SYSREQS = "true")
  } else {
    Sys.setenv(PKG_SYSREQS = "false")
  }

  is_local <- isTRUE(grepl("local::.", pkgs, fixed = TRUE))

  # recreate defaults from pak::pak() as we want to be more verbose
  if (is.null(dependencies)) {
    if (is_local) {
      dependencies <- TRUE
    } else {
      dependencies <- NA
    }
  }

  if (is.na(upgrade)) {
    if (is_local) {
      upgrade <- TRUE
    } else {
      upgrade <- FALSE
    }
  }

  lockfile <- normalizePath(tempfile(), "/", FALSE)
  on.exit(unlink(lockfile), add = TRUE)

  print_eval(
    pkg_install,
    pkg = pkgs,
    lib = lib,
    dependencies = dependencies,
    upgrade = upgrade
  )
}

# wrapper for
#> pak::local_install_dev_deps()
pak_dev <- function(
    lib = dot_lib_paths()[1],
    sysreqs = FALSE,
    extra_messages = TRUE,
    upgrade = TRUE,
    dependencies = TRUE,
    ...
) {
  op <- options(pak.no_extra_messages = extra_messages)
  on.exit(options(op))

  if (sysreqs) {
    Sys.setenv(PKG_SYSREQS = "true")
  } else {
    Sys.setenv(PKG_SYSREQS = "false")
  }

  upgrade <- !isFALSE(upgrade)
  dependencies <- !isFALSE(dependencies)

  print_eval(
    local_install_dev_deps,
    root = ".",
    lib = lib,
    upgrade = upgrade,
    dependencies = TRUE
  )
}

.libPaths(c(args$lib_pak, args$lib))
do.call(
  if (args$lockfile) {
    pak_lockfile
  } else if (args$dev) {
    pak_dev
  } else {
    pak_install
  },
  args
)

quit()