pkgs/development/r-modules/generate-r-packages.R

   1 #!/usr/bin/env Rscript
   2 library(data.table)
   3 library(parallel)
   4 library(BiocManager)
   5 cl <- makeCluster(10)
   6
   7 biocVersion <- BiocManager:::.version_map()
   8 biocVersion <- biocVersion[biocVersion$R == getRversion()[, 1:2],c("Bioc", "BiocStatus")]
   9 if ("release" %in% biocVersion$BiocStatus) {
  10   biocVersion <-  as.numeric(as.character(biocVersion[biocVersion$BiocStatus == "release", "Bioc"]))
  11 } else {
  12   biocVersion <-  max(as.numeric(as.character(biocVersion$Bioc)))
  13 }
  14 snapshotDate <- Sys.Date()-1
  15
  16 mirrorUrls <- list( bioc=paste0("http://bioconductor.statistik.tu-dortmund.de/packages/", biocVersion, "/bioc/src/contrib/")
  17                   , "bioc-annotation"=paste0("http://bioconductor.statistik.tu-dortmund.de/packages/", biocVersion, "/data/annotation/src/contrib/")
  18                   , "bioc-experiment"=paste0("http://bioconductor.statistik.tu-dortmund.de/packages/", biocVersion, "/data/experiment/src/contrib/")
  19                   , cran=paste0("http://mran.revolutionanalytics.com/snapshot/", snapshotDate, "/src/contrib/")
  20                   )
  21
  22 mirrorType <- commandArgs(trailingOnly=TRUE)[1]
  23 stopifnot(mirrorType %in% names(mirrorUrls))
  24 packagesFile <- paste(mirrorType, 'packages.nix', sep='-')
  25 readFormatted <- as.data.table(read.table(skip=8, sep='"', text=head(readLines(packagesFile), -1)))
  26
  27 write(paste("downloading package lists"), stderr())
  28 knownPackages <- lapply(mirrorUrls, function(url) as.data.table(available.packages(url, filters=c("R_version", "OS_type", "duplicates")), method="libcurl"))
  29 pkgs <- knownPackages[mirrorType][[1]]
  30 setkey(pkgs, Package)
  31 knownPackages <- c(unique(do.call("rbind", knownPackages)$Package))
  32 knownPackages <- sapply(knownPackages, gsub, pattern=".", replacement="_", fixed=TRUE)
  33
  34 mirrorUrl <- mirrorUrls[mirrorType][[1]]
  35 nixPrefetch <- function(name, version) {
  36   prevV <- readFormatted$V2 == name & readFormatted$V4 == version
  37   if (sum(prevV) == 1)
  38     as.character(readFormatted$V6[ prevV ])
  39
  40   else {
  41     # avoid nix-prefetch-url because it often fails to fetch/hash large files
  42     url <- paste0(mirrorUrl, name, "_", version, ".tar.gz")
  43     tmp <- tempfile(pattern=paste0(name, "_", version), fileext=".tar.gz")
  44     cmd <- paste0("wget -q -O '", tmp, "' '", url, "'")
  45     cmd <- paste0(cmd, " && nix-hash --type sha256 --base32 --flat '", tmp, "'")
  46     cmd <- paste0(cmd, " && echo >&2 '  added ", name, " v", version, "'")
  47     cmd <- paste0(cmd, " ; rm -rf '", tmp, "'")
  48     system(cmd, intern=TRUE)
  49   }
  50
  51 }
  52
  53 escapeName <- function(name) {
  54     switch(name, "import" = "r_import", "assert" = "r_assert", name)
  55 }
  56
  57 formatPackage <- function(name, version, sha256, depends, imports, linkingTo) {
  58     attr <- gsub(".", "_", escapeName(name), fixed=TRUE)
  59     options(warn=5)
  60     depends <- paste( if (is.na(depends)) "" else gsub("[ \t\n]+", "", depends)
  61                     , if (is.na(imports)) "" else gsub("[ \t\n]+", "", imports)
  62                     , if (is.na(linkingTo)) "" else gsub("[ \t\n]+", "", linkingTo)
  63                     , sep=","
  64                     )
  65     depends <- unlist(strsplit(depends, split=",", fixed=TRUE))
  66     depends <- lapply(depends, gsub, pattern="([^ \t\n(]+).*", replacement="\\1")
  67     depends <- lapply(depends, gsub, pattern=".", replacement="_", fixed=TRUE)
  68     depends <- depends[depends %in% knownPackages]
  69     depends <- lapply(depends, escapeName)
  70     depends <- paste(depends)
  71     depends <- paste(sort(unique(depends)), collapse=" ")
  72     paste0("  ", attr, " = derive2 { name=\"", name, "\"; version=\"", version, "\"; sha256=\"", sha256, "\"; depends=[", depends, "]; };")
  73 }
  74
  75 clusterExport(cl, c("nixPrefetch","readFormatted", "mirrorUrl", "knownPackages"))
  76
  77 pkgs <- as.data.table(available.packages(mirrorUrl, filters=c("R_version", "OS_type", "duplicates"), method="libcurl"))
  78 pkgs <- pkgs[order(Package)]
  79
  80 write(paste("updating", mirrorType, "packages"), stderr())
  81 pkgs$sha256 <- parApply(cl, pkgs, 1, function(p) nixPrefetch(p[1], p[2]))
  82 nix <- apply(pkgs, 1, function(p) formatPackage(p[1], p[2], p[18], p[4], p[5], p[6]))
  83 write("done", stderr())
  84
  85 # Mark deleted packages as broken
  86 setkey(readFormatted, V2)
  87 markBroken <- function(name) {
  88   str <- paste0(readFormatted[name], collapse='"')
  89   if(sum(grep("broken = true;", str)))
  90     return(str)
  91   write(paste("marked", name, "as broken"), stderr())
  92   gsub("};$", "broken = true; };", str)
  93 }
  94 broken <- lapply(setdiff(readFormatted[[2]], pkgs[[1]]), markBroken)
  95
  96 cat("# This file is generated from generate-r-packages.R. DO NOT EDIT.\n")
  97 cat("# Execute the following command to update the file.\n")
  98 cat("#\n")
  99 cat(paste("# Rscript generate-r-packages.R", mirrorType, ">new && mv new", packagesFile))
 100 cat("\n\n")
 101 cat("{ self, derive }:\n")
 102 cat("let derive2 = derive ")
 103 if (mirrorType == "cran") { cat("{ snapshot = \"", paste(snapshotDate), "\"; }", sep="")
 104 } else if (mirrorType == "irkernel") { cat("{}")
 105 } else { cat("{ biocVersion = \"", biocVersion, "\"; }", sep="") }
 106 cat(";\n")
 107 cat("in with self; {\n")
 108 cat(paste(nix, collapse="\n"), "\n", sep="")
 109 cat(paste(broken, collapse="\n"), "\n", sep="")
 110 cat("}\n")
 111
 112 stopCluster(cl)