Ricardo Wurmus <ricardo.wur...@mdc-berlin.de> writes:
> The first two patches in this series are actually unrelated: the first
> fixes an annoying bug in the CRAN importer; the second corrects an
> outdated claim in the CRAN importer’s documentation.
I pushed the first two patches already.
Attached is a replacement for
0006-import-Add-Bioconductor-importer-and-updater.patch
because I forgot to add the new importer script file.
~~ Ricardo
>From 8829683fffc03dec7f2faecea75cdd7831ce1741 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <ricardo.wur...@mdc-berlin.de>
Date: Wed, 16 Dec 2015 14:45:28 +0100
Subject: [PATCH] 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/bioconductor.scm: New file.
* 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/import/bioconductor.scm | 92 +++++++++++++++++++++++++++++++++++
guix/scripts/refresh.scm | 1 +
tests/cran.scm | 5 +-
6 files changed, 193 insertions(+), 19 deletions(-)
create mode 100644 guix/scripts/import/bioconductor.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index e12bc9f..ef60f04 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4215,6 +4215,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
@@ -4413,6 +4429,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 <upstream-source> 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 <upstream-source> 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/import/bioconductor.scm b/guix/scripts/import/bioconductor.scm
new file mode 100644
index 0000000..41b32e0
--- /dev/null
+++ b/guix/scripts/import/bioconductor.scm
@@ -0,0 +1,92 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Ricardo Wurmus <rek...@elephly.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts import bioconductor)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix scripts)
+ #:use-module (guix import cran)
+ #:use-module (guix scripts import)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-37)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:export (guix-import-bioconductor))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ '())
+
+(define (show-help)
+ (display (_ "Usage: guix import bioconductor PACKAGE-NAME
+Import and convert the Bioconductor package for PACKAGE-NAME.\n"))
+ (display (_ "
+ -h, --help display this help and exit"))
+ (display (_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ ;; Specification of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix import bioconductor")))
+ %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-bioconductor . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
+
+ (let* ((opts (parse-options))
+ (args (filter-map (match-lambda
+ (('argument . value)
+ value)
+ (_ #f))
+ (reverse opts))))
+ (match args
+ ((package-name)
+ (let ((sexp (bioconductor->guix-package package-name)))
+ (unless sexp
+ (leave (_ "failed to download description for package '~a'~%")
+ package-name))
+ sexp))
+ (()
+ (leave (_ "too few arguments~%")))
+ ((many ...)
+ (leave (_ "too many arguments~%"))))))
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
