01/01: import: Add Bioconductor importer and updater.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository guix.

commit d0bd632f89e242a2a217d7e85194589f088f75ea
Author: Ricardo Wurmus <address@hidden>
Date:   Wed Dec 16 14:45:28 2015 +0100

    import: Add Bioconductor importer and updater.
    
    * guix/import/cran.scm (%bioconductor-updater,
    latest-bioconductor-release, bioconductor-package?): New procedures.
    (cran->guix-package): Support repositories other than CRAN.
    (%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/cran.scm: Add "--archive" option and default to
    CRAN.
    * guix/scripts/refresh.scm (%updaters): Add "%bioconductor-updater".
    * doc/guix.texi: Document Bioconductor importer and updater.
---
 doc/guix.texi                |   20 ++++++++-
 guix/import/cran.scm         |  103 +++++++++++++++++++++++++++++++++--------
 guix/scripts/import/cran.scm |    9 +++-
 guix/scripts/refresh.scm     |    1 +
 tests/cran.scm               |    2 +-
 5 files changed, 112 insertions(+), 23 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a3d751a..2a97516 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4279,11 +4279,12 @@ guix import cpan Acme::Boolean
 
 @item cran
 @cindex CRAN
address@hidden Bioconductor
 Import meta-data from @uref{http://cran.r-project.org/, CRAN}, the
 central repository for the @uref{http://r-project.org, address@hidden
 statistical and graphical environment}.
 
-Information is extracted from the package's DESCRIPTION file.
+Information is extracted from the package's @code{DESCRIPTION} file.
 
 The command command below imports meta-data for the @code{Cairo}
 R package:
@@ -4292,6 +4293,21 @@ R package:
 guix import cran Cairo
 @end example
 
+When @code{--archive=bioconductor} is added, meta-data is imported from
address@hidden://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 @code{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:
+
address@hidden
+guix import cran --archive=bioconductor GenomicRanges
address@hidden example
+
 @item nix
 Import meta-data from a local copy of the source of the
 @uref{http://nixos.org/nixpkgs/, Nixpkgs address@hidden
@@ -4490,6 +4506,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;
address@hidden bioconductor
+the updater for @uref{http://www.bioconductor.org/, Bioconductor} R 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 1c30da8..f36e948 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
@@ -136,24 +147,31 @@ empty list when the FIELD cannot be found."
                         (string-any char-set:whitespace item)))
                   (map string-trim-both items))))))
 
-(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")))
@@ -167,26 +185,32 @@ 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))))
+       ,@(if (not (equal? (string-append "r-" name)
+                          (guix-name name)))
+             `((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
+             '())
        (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")))
        (license ,license))))
 
-(define (cran->guix-package package-name)
-  "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)))
+(define* (cran->guix-package package-name #:optional (repo 'cran))
+  "Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
+s-expression corresponding to that package, or #f on failure."
+  (let* ((url (case repo
+                ((cran)         %cran-url)
+                ((bioconductor) %bioconductor-svn-url)))
+         (module-meta (fetch-description url package-name)))
+    (and=> module-meta (cut description->package repo <>))))
 
 
 ;;;
@@ -212,7 +236,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
@@ -229,16 +253,55 @@ 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)))
+  (and (string-prefix? "r-" (package-name package))
+       (match (and=> (package-source package) origin-uri)
+         ((? string? uri)
+          (string-prefix? "mirror://cran" uri))
+         ((? list? uris)
+          (any (cut string-prefix? "mirror://cran" <>) uris))
+         (_ #f))))
+
+(define (bioconductor-package? package)
+  "Return true if PACKAGE is an R package from Bioconductor."
+  (and (string-prefix? "r-" (package-name package))
+       (match (and=> (package-source package) origin-uri)
+         ((? string? uri)
+          (string-prefix? "http://bioconductor.org"; uri))
+         ((? list? uris)
+          (any (cut string-prefix? "http://bioconductor.org"; <>) uris))
+         (_ #f))))
 
 (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/cran.scm b/guix/scripts/import/cran.scm
index 8d001ac..ace1123 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -42,6 +42,8 @@
   (display (_ "Usage: guix import cran PACKAGE-NAME
 Import and convert the CRAN package for PACKAGE-NAME.\n"))
   (display (_ "
+  -a, --archive=ARCHIVE  specify the archive repository"))
+  (display (_ "
   -h, --help             display this help and exit"))
   (display (_ "
   -V, --version          display version information and exit"))
@@ -57,6 +59,10 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix import cran")))
+         (option '(#\a "archive") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'repo (string->symbol arg)
+                               (alist-delete 'repo result))))
          %standard-import-options))
 
 
@@ -82,7 +88,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
                            (reverse opts))))
     (match args
       ((package-name)
-       (let ((sexp (cran->guix-package package-name)))
+       (let ((sexp (cran->guix-package package-name
+                                       (or (assoc-ref opts 'repo) 'cran))))
          (unless sexp
            (leave (_ "failed to download description for package '~a'~%")
                   package-name))
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..e4f2235 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")