guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [PATCH] Add Bioconductor importer and updater.


From: Ricardo Wurmus
Subject: Re: [PATCH] Add Bioconductor importer and updater.
Date: Mon, 21 Dec 2015 17:00:54 +0100

Ricardo Wurmus <address@hidden> 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 <address@hidden>
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
 
address@hidden bioconductor
address@hidden 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:
+
address@hidden
+guix import 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
@@ -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;
address@hidden 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 <address@hidden>
+;;;
+;;; 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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]