pyrox.dev
1#!/usr/bin/env Rscript
2
3# This script can be used to generate the .json file for a given R package set
4# that is part of the `rPackages` tree
5#
6# See R section of the nixpkgs manual for an example of how to use this script
7
8library(data.table)
9library(parallel)
10library(BiocManager)
11library(jsonlite)
12
13# always order strings according to POSIX ordering
14locale <- Sys.setlocale(locale = "C")
15
16biocVersion <- BiocManager:::.version_map()
17biocVersion <- biocVersion[biocVersion$R == getRversion()[, 1:2],c("Bioc", "BiocStatus")]
18if ("release" %in% biocVersion$BiocStatus) {
19 biocVersion <- as.character(biocVersion[biocVersion$BiocStatus == "release", "Bioc"])
20} else {
21 biocVersion <- max(as.character(biocVersion$Bioc))
22}
23
24mirrorUrls <- list( bioc=paste0("http://bioconductor.org/packages/", biocVersion, "/bioc/src/contrib/")
25 , "bioc-annotation"=paste0("http://bioconductor.org/packages/", biocVersion, "/data/annotation/src/contrib/")
26 , "bioc-experiment"=paste0("http://bioconductor.org/packages/", biocVersion, "/data/experiment/src/contrib/")
27 , cran="https://cran.r-project.org/src/contrib/"
28 )
29
30mirrorType <- commandArgs(trailingOnly=TRUE)[1]
31stopifnot(mirrorType %in% names(mirrorUrls))
32
33packagesFile <- paste(mirrorType, 'packages.json', sep='-')
34prevPkgs <- fromJSON(packagesFile)$packages
35
36write(paste("downloading package lists"), stderr())
37pkgTables <- lapply(mirrorUrls, function(url) as.data.table(available.packages(url, filters=c("R_version", "OS_type", "duplicates")), method="libcurl"))
38knownPackageNames <- c(unique(do.call("rbind", pkgTables)$Package))
39
40pkgTable <- pkgTables[mirrorType][[1]]
41mirrorUrl <- mirrorUrls[mirrorType][[1]]
42
43escapeName <- function(name) {
44 gsub(".", "_", switch(name, "import" = "r_import", "assert" = "r_assert", name), fixed=TRUE)
45}
46
47nixPrefetch <- function(name, version) {
48 prevPkg <- prevPkgs[[escapeName(name)]]
49 if (!is.null(prevPkg) && prevPkg$version == version)
50 prevPkg$sha256
51
52 else {
53 # avoid nix-prefetch-url because it often fails to fetch/hash large files
54 url <- paste0(mirrorUrl, name, "_", version, ".tar.gz")
55 tmp <- tempfile(pattern=paste0(name, "_", version), fileext=".tar.gz")
56 cmd <- paste0("wget -q -O '", tmp, "' '", url, "'")
57 if(mirrorType == "cran"){
58 archiveUrl <- paste0(mirrorUrl, "Archive/", name, "/", name, "_", version, ".tar.gz")
59 cmd <- paste0(cmd, " || wget -q -O '", tmp, "' '", archiveUrl, "'")
60 }
61 cmd <- paste0(cmd, " && nix-hash --type sha256 --base32 --flat '", tmp, "'")
62 cmd <- paste0(cmd, " && echo >&2 ' added ", name, " v", version, "'")
63 cmd <- paste0(cmd, " ; rm -rf '", tmp, "'")
64 system(cmd, intern=TRUE)
65 }
66
67}
68
69formatPackage <- function(name, version, sha256, depends, imports, linkingTo) {
70 options(warn=5)
71 depends <- paste( if (is.na(depends)) "" else gsub("[ \t\n]+", "", depends)
72 , if (is.na(imports)) "" else gsub("[ \t\n]+", "", imports)
73 , if (is.na(linkingTo)) "" else gsub("[ \t\n]+", "", linkingTo)
74 , sep=","
75 )
76 depends <- unlist(strsplit(depends, split=",", fixed=TRUE))
77 depends <- lapply(depends, gsub, pattern="([^ \t\n(]+).*", replacement="\\1")
78 depends <- depends[depends %in% knownPackageNames]
79 depends <- lapply(depends, escapeName)
80 depends <- paste(depends)
81 depends <- sort(unique(depends))
82 list(name=unbox(name), version=unbox(version), sha256=unbox(sha256), depends=depends)
83}
84
85cl <- makeCluster(10)
86clusterExport(cl, c("escapeName", "nixPrefetch", "prevPkgs", "mirrorUrl", "mirrorType", "knownPackageNames"))
87
88write(paste("updating", mirrorType, "packages"), stderr())
89pkgTable$sha256 <- parApply(cl, pkgTable, 1, function(p) nixPrefetch(p[1], p[2]))
90
91stopCluster(cl)
92
93pkgs <- lapply(1:nrow(pkgTable), function(i) with(pkgTable[i,], formatPackage(Package, Version, sha256, Depends, Imports, LinkingTo)))
94names(pkgs) <- lapply(pkgs, function(p) escapeName(p$name))
95
96# Mark deleted packages as broken
97brokenPkgs <- lapply(prevPkgs[setdiff(names(prevPkgs), names(pkgs))], function(p)
98 list(name=unbox(p$name),
99 version=unbox(p$version),
100 sha256=unbox(p$sha256),
101 depends=p$depends,
102 broken=unbox(T)))
103
104# sort packages by their non-escaped names
105pkgs <- pkgs[order(sapply(pkgs, function(p) p$name))]
106brokenPkgs<- brokenPkgs[order(sapply(brokenPkgs, function(p) p$name))]
107
108# empty named list
109extraArgs = setNames(list(), character(0))
110
111if (mirrorType != "cran") {
112 extraArgs=list(biocVersion=unbox(paste(biocVersion)))
113}
114
115cat(toJSON(list(extraArgs=extraArgs, packages=c(pkgs, brokenPkgs)), pretty=TRUE))
116cat("\n")
117write("done", stderr())