From 3af383f041762778cb61d48f5e00b9656d616704 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 16 Dec 2015 14:45:28 +0100 Subject: [PATCH 6/6] import: Add Bioconductor importer and updater. * guix/import/cran.scm (bioconductor->guix-package, %bioconductor-updater, latest-bioconductor-release, bioconductor-package?): New procedures. (%bioconductor-url, %bioconductor-svn-url): New variables. (description->package): Update signature to distinguish between packages from different repositories. (latest-release): Rename procedure ... (latest-cran-release): ... to this. (cran-package?): Do not assume all R packages are available on CRAN. * tests/cran.scm: Update tests. * guix/scripts/import.scm (importers): Add "bioconductor" importers. * guix/scripts/refresh.scm (%updaters): Add "%bioconductor-updater". * doc/guix.texi: Document Bioconductor importer and updater. --- doc/guix.texi | 18 ++++++++++ guix/import/cran.scm | 93 +++++++++++++++++++++++++++++++++++++++--------- guix/scripts/import.scm | 3 +- guix/scripts/refresh.scm | 1 + tests/cran.scm | 5 +-- 5 files changed, 101 insertions(+), 19 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 05a94dc..44f9daf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4214,6 +4214,22 @@ R package: guix import cran Cairo @end example +@item bioconductor +@cindex Bioconductor +Import meta-data from @uref{http://www.bioconductor.org/, Bioconductor}, +a repository of R packages for for the analysis and comprehension of +high-throughput genomic data in bioinformatics. + +Information is extracted from a package's DESCRIPTION file published on +the web interface of the Bioconductor SVN repository. + +The command command below imports meta-data for the @code{GenomicRanges} +R package: + +@example +guix import bioconductor GenomicRanges +@end example + @item nix Import meta-data from a local copy of the source of the @uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This @@ -4412,6 +4428,8 @@ the updater for GNOME packages; the updater for @uref{http://elpa.gnu.org/, ELPA} packages; @item cran the updater for @uref{http://cran.r-project.org/, CRAN} packages; +@item bioconductor +the updater for @uref{http://www.bioconductor.org/, Bioconductor} packages; @item pypi the updater for @uref{https://pypi.python.org, PyPI} packages. @end table diff --git a/guix/import/cran.scm b/guix/import/cran.scm index fc27090..35b18b1 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -29,12 +29,14 @@ #:use-module (guix base32) #:use-module ((guix download) #:select (download-to-store)) #:use-module (guix import utils) - #:use-module ((guix build-system r) #:select (cran-uri)) + #:use-module ((guix build-system r) #:select (cran-uri bioconductor-uri)) #:use-module (guix upstream) #:use-module (guix packages) #:use-module (gnu packages) #:export (cran->guix-package - %cran-updater)) + bioconductor->guix-package + %cran-updater + %bioconductor-updater)) ;;; Commentary: ;;; @@ -108,6 +110,15 @@ package definition." `((,type (,'quasiquote ,(format-inputs package-inputs))))))) (define %cran-url "http://cran.r-project.org/web/packages/") +(define %bioconductor-url "http://bioconductor.org/packages/") + +;; The latest Bioconductor release is 3.2. Bioconductor packages should be +;; updated together. +(define %bioconductor-svn-url + (string-append "https://readonly:readonly@" + "hedgehog.fhcrc.org/bioconductor/branches/RELEASE_3_2/" + "madman/Rpacks/")) + (define (fetch-description base-url name) "Return an alist of the contents of the DESCRIPTION file for the R package @@ -147,24 +158,31 @@ into a proper sentence and by using two spaces between sentences." (regexp-substitute/global #f "\\. \\b" cleaned 'pre ". " 'post))) -(define (description->package meta) - "Return the `package' s-expression for a CRAN package from the alist META, -which was derived from the R package's DESCRIPTION file." +(define (description->package repository meta) + "Return the `package' s-expression for an R package published on REPOSITORY +from the alist META, which was derived from the R package's DESCRIPTION file." (define (guix-name name) (if (string-prefix? "r-" name) (string-downcase name) (string-append "r-" (string-downcase name)))) - (let* ((name (assoc-ref meta "Package")) + (let* ((base-url (case repository + ((cran) %cran-url) + ((bioconductor) %bioconductor-url))) + (uri-helper (case repository + ((cran) cran-uri) + ((bioconductor) bioconductor-uri))) + (name (assoc-ref meta "Package")) (synopsis (assoc-ref meta "Title")) (version (assoc-ref meta "Version")) (license (string->license (assoc-ref meta "License"))) ;; Some packages have multiple home pages. Some have none. (home-page (match (listify meta "URL") ((url rest ...) url) - (_ (string-append %cran-url name)))) - (source-url (match (cran-uri name version) + (_ (string-append base-url name)))) + (source-url (match (uri-helper name version) ((url rest ...) url) + ((? string? url) url) (_ #f))) (tarball (with-store store (download-to-store store source-url))) (sysdepends (map string-downcase (listify meta "SystemRequirements"))) @@ -178,16 +196,17 @@ which was derived from the R package's DESCRIPTION file." (version ,version) (source (origin (method url-fetch) - (uri (cran-uri ,name version)) + (uri (,(procedure-name uri-helper) ,name version)) (sha256 (base32 ,(bytevector->nix-base32-string (file-sha256 tarball)))))) - (properties ,`(,'quasiquote ((,'upstream-name . ,name)))) + (properties ,`(,'quasiquote ((,'upstream-name . ,name) + (,'r-repository . ,repository)))) (build-system r-build-system) ,@(maybe-inputs sysdepends) ,@(maybe-inputs propagate 'propagated-inputs) (home-page ,(if (string-null? home-page) - (string-append %cran-url name) + (string-append base-url name) home-page)) (synopsis ,synopsis) (description ,(beautify-description (assoc-ref meta "Description"))) @@ -197,7 +216,13 @@ which was derived from the R package's DESCRIPTION file." "Fetch the metadata for PACKAGE-NAME from cran.r-project.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let ((module-meta (fetch-description %cran-url package-name))) - (and=> module-meta description->package))) + (and=> module-meta (cut description->package 'cran <>)))) + +(define (bioconductor->guix-package package-name) + "Fetch the metadata for PACKAGE-NAME from bioconductor.org, and return the +`package' s-expression corresponding to that package, or #f on failure." + (let ((module-meta (fetch-description %bioconductor-svn-url package-name))) + (and=> module-meta (cut description->package 'bioconductor <>)))) ;;; @@ -223,7 +248,7 @@ which was derived from the R package's DESCRIPTION file." (_ #f))) (_ #f))))) -(define (latest-release package) +(define (latest-cran-release package) "Return an for the latest release of PACKAGE." (define upstream-name @@ -240,16 +265,52 @@ which was derived from the R package's DESCRIPTION file." (version version) (urls (cran-uri upstream-name version)))))) +(define (latest-bioconductor-release package) + "Return an for the latest release of PACKAGE." + + (define upstream-name + (package->upstream-name (specification->package package))) + + (define meta + (fetch-description %bioconductor-svn-url upstream-name)) + + (and meta + (let ((version (assoc-ref meta "Version"))) + ;; Bioconductor does not provide signatures. + (upstream-source + (package package) + (version version) + (urls (bioconductor-uri upstream-name version)))))) + (define (cran-package? package) "Return true if PACKAGE is an R package from CRAN." - ;; Assume all R packages are available on CRAN. - (string-prefix? "r-" (package-name package))) + ;; Assume all R packages are available on CRAN, unless otherwise indicated + ;; by the r-repository property. + (let ((properties (package-properties package))) + (and (string-prefix? "r-" (package-name package)) + (or (not properties) + (not (assoc-ref properties 'r-repository)) + (eqv? 'cran (assoc-ref properties 'r-repository)))))) + +(define (bioconductor-package? package) + "Return true if PACKAGE is an R package from Bioconductor." + (let ((properties (package-properties package))) + (and (string-prefix? "r-" (package-name package)) + properties + (eqv? 'bioconductor (assoc-ref properties 'r-repository))))) (define %cran-updater (upstream-updater (name 'cran) (description "Updater for CRAN packages") (pred cran-package?) - (latest latest-release))) + (latest latest-cran-release))) + +(define %bioconductor-updater + (upstream-updater + (name 'bioconductor) + (description "Updater for Bioconductor packages") + (pred bioconductor-package?) + (latest latest-bioconductor-release))) ;;; cran.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 7b29794..5810ef8 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,8 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa" "gem" "cran" + "bioconductor")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index a5834d1..f9e3f31 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -195,6 +195,7 @@ unavailable optional dependencies such as Guile-JSON." %gnome-updater %elpa-updater %cran-updater + %bioconductor-updater ((guix import pypi) => %pypi-updater))) (define (lookup-updater name) diff --git a/tests/cran.scm b/tests/cran.scm index 0a4a2fd..72df2b3 100644 --- a/tests/cran.scm +++ b/tests/cran.scm @@ -107,7 +107,7 @@ Date/Publication: 2015-07-14 14:15:16 ("mirror://cran/src/contrib/My-Example_1.2.3.tar.gz" "source") (_ (error "Unexpected URL: " url)))))))) - (match ((@@ (guix import cran) description->package) description-alist) + (match ((@@ (guix import cran) description->package) 'cran description-alist) (('package ('name "r-my-example") ('version "1.2.3") @@ -117,7 +117,8 @@ Date/Publication: 2015-07-14 14:15:16 ('sha256 ('base32 (? string? hash))))) - ('properties ('quasiquote (('upstream-name . "My-Example")))) + ('properties ('quasiquote (('upstream-name . "My-Example") + ('r-repository . 'cran)))) ('build-system 'r-build-system) ('inputs ('quasiquote -- 2.1.0