guix.install <- function (package, profile = NULL, guix = "guix", archive = NULL)
{
if (is.null (profile)) {
guix_profile <- Sys.getenv ("GUIX_PROFILE", unset = NA)
if (is.na (guix_profile)) {
profile <- paste (Sys.getenv ("HOME"), ".guix-profile", sep = "/")
} else {
profile <- guix_profile
}
} else {
parent <- dirname (profile)
if (! dir.exists (parent)) {
dir.create (parent, recursive = TRUE)
}
}
scratch <- paste (Sys.getenv ("HOME"), ".Rguix", "packages.scm", sep = "/")
package_path <- NULL
old_package_path <- Sys.getenv ("GUIX_PACKAGE_PATH")
entries <- strsplit (old_package_path, ":")[[1]]
package_path <- paste (unique (c(dirname (scratch), entries)), sep = ":")
Sys.setenv (GUIX_PACKAGE_PATH=package_path)
is_url <- length (grep ("^https?://", package)) > 0
if (is_url) {
guix_name <- paste0 ("r-", gsub ("[^a-z0-9]", "-", tolower (basename (package))))
} else {
guix_name <- paste0 ("r-", gsub ("[^a-z0-9]", "-", tolower (package)))
error <- system2 (guix, c("show", guix_name),
stdout = NULL, stderr = NULL)
}
if (is_url || (error > 0)) {
if (! dir.exists (dirname (scratch))) {
dir.create (dirname (scratch), recursive = TRUE)
}
if (! file.exists (scratch)) {
cat ("
(define-module (packages)
#:use-module (gnu)
#:use-module (gnu packages bioinformatics)
#:use-module (gnu packages bioconductor)
#:use-module (gnu packages cran)
#:use-module (gnu packages statistics)
#:use-module (guix)
#:use-module (guix git-download)
#:use-module (guix hg-download)
#:use-module (guix build-system r)
#:use-module (guix licenses))
", file = scratch)
}
if (is.null (archive)) {
archive <- if (is_url) {
"git"
} else {
"bioconductor"
}
}
definitions <- suppressWarnings (system2 (guix, c("import", "cran",
"--recursive",
paste ("--archive", archive, sep = "="),
package),
stdout = TRUE))
status <- attr (definitions, "status")
if (!is.null (status) && (status > 0)) {
stop (paste("Failed to import", package))
}
cat (";; Imported from within R at ", date(), "\n",
file = scratch, append = TRUE)
cat (definitions, sep = "\n",
file = scratch, append = TRUE)
}
error <- system2 (guix, c("package", paste ("--profile", profile, sep = "="),
"--install", guix_name))
if (error == 0) {
.libPaths (paste (profile, "site-library", sep = "/"))
}
}