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

   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
   8 library(data.table)
   9 library(parallel)
  10 library(BiocManager)
  11 library(jsonlite)
  12
  13 # always order strings according to POSIX ordering
  14 locale <- Sys.setlocale(locale = "C")
  15
  16 biocVersion <- BiocManager:::.version_map()
  17 biocVersion <- biocVersion[biocVersion$R == getRversion()[, 1:2],c("Bioc", "BiocStatus")]
  18 if ("release" %in% biocVersion$BiocStatus) {
  19   biocVersion <-  as.numeric(as.character(biocVersion[biocVersion$BiocStatus == "release", "Bioc"]))
  20 } else {
  21   biocVersion <-  max(as.numeric(as.character(biocVersion$Bioc)))
  22 }
  23
  24 mirrorUrls <- 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
  30 mirrorType <- commandArgs(trailingOnly=TRUE)[1]
  31 stopifnot(mirrorType %in% names(mirrorUrls))
  32
  33 packagesFile <- paste(mirrorType, 'packages.json', sep='-')
  34 prevPkgs <- fromJSON(packagesFile)$packages
  35
  36 write(paste("downloading package lists"), stderr())
  37 pkgTables <- lapply(mirrorUrls, function(url) as.data.table(available.packages(url, filters=c("R_version", "OS_type", "duplicates")), method="libcurl"))
  38 knownPackageNames <- c(unique(do.call("rbind", pkgTables)$Package))
  39
  40 pkgTable <- pkgTables[mirrorType][[1]]
  41 mirrorUrl <- mirrorUrls[mirrorType][[1]]
  42
  43 escapeName <- function(name) {
  44     gsub(".", "_", switch(name, "import" = "r_import", "assert" = "r_assert", name), fixed=TRUE)
  45 }
  46
  47 nixPrefetch <- 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
  69 formatPackage <- 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
  85 cl <- makeCluster(10)
  86 clusterExport(cl, c("escapeName", "nixPrefetch", "prevPkgs", "mirrorUrl", "mirrorType", "knownPackageNames"))
  87
  88 write(paste("updating", mirrorType, "packages"), stderr())
  89 pkgTable$sha256 <- parApply(cl, pkgTable, 1, function(p) nixPrefetch(p[1], p[2]))
  90
  91 stopCluster(cl)
  92
  93 pkgs <- lapply(1:nrow(pkgTable), function(i) with(pkgTable[i,], formatPackage(Package, Version, sha256, Depends, Imports, LinkingTo)))
  94 names(pkgs) <- lapply(pkgs, function(p) escapeName(p$name))
  95
  96 # Mark deleted packages as broken
  97 brokenPkgs <- 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
 105 pkgs <- pkgs[order(sapply(pkgs, function(p) p$name))]
 106 brokenPkgs<- brokenPkgs[order(sapply(brokenPkgs, function(p) p$name))]
 107
 108 # empty named list
 109 extraArgs = setNames(list(), character(0))
 110
 111 if (mirrorType != "cran") {
 112   extraArgs=list(biocVersion=unbox(paste(biocVersion)))
 113 }
 114
 115 cat(toJSON(list(extraArgs=extraArgs, packages=c(pkgs, brokenPkgs)), pretty=TRUE))
 116 cat("\n")
 117 write("done", stderr())
 118