import: cran: Use Bioconductor 3.6 helpers.

* guix/import/cran.scm (bioconductor-mirror-url): Remove procedure.
(fetch-description): Extract DESCRIPTION file from tarball for Bioconductor
packages.
(latest-bioconductor-release): Use latest-bioconductor-package-version.
This commit is contained in:
Ricardo Wurmus 2017-11-06 17:10:41 +01:00
parent 84dfdc5759
commit 27baf50956
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC

View File

@ -130,9 +130,6 @@ package definition."
;; The latest Bioconductor release is 3.6. Bioconductor packages should be ;; The latest Bioconductor release is 3.6. Bioconductor packages should be
;; updated together. ;; updated together.
(define (bioconductor-mirror-url name)
(string-append "https://raw.githubusercontent.com/Bioconductor-mirror/"
name "/release-3.5"))
(define %bioconductor-version "3.6") (define %bioconductor-version "3.6")
(define %bioconductor-packages-list-url (define %bioconductor-packages-list-url
@ -168,11 +165,9 @@ bioconductor package NAME, or #F if the package is unknown."
"Return an alist of the contents of the DESCRIPTION file for the R package "Return an alist of the contents of the DESCRIPTION file for the R package
NAME in the given REPOSITORY, or #f in case of failure. NAME is NAME in the given REPOSITORY, or #f in case of failure. NAME is
case-sensitive." case-sensitive."
;; This API always returns the latest release of the module. (case repository
(let ((url (string-append (case repository ((cran)
((cran) (string-append %cran-url name)) (let ((url (string-append %cran-url name "/DESCRIPTION")))
((bioconductor) (bioconductor-mirror-url name)))
"/DESCRIPTION")))
(guard (c ((http-get-error? c) (guard (c ((http-get-error? c)
(format (current-error-port) (format (current-error-port)
"error: failed to retrieve package information \ "error: failed to retrieve package information \
@ -182,6 +177,23 @@ from ~s: ~a (~s)~%"
(http-get-error-reason c)) (http-get-error-reason c))
#f)) #f))
(description->alist (read-string (http-fetch url)))))) (description->alist (read-string (http-fetch url))))))
((bioconductor)
;; Currently, the bioconductor project does not offer a way to access a
;; package's DESCRIPTION file over HTTP, so we determine the version,
;; download the source tarball, and then extract the DESCRIPTION file.
(let* ((version (latest-bioconductor-package-version name))
(url (bioconductor-uri name version))
(tarball (with-store store (download-to-store store url))))
(call-with-temporary-directory
(lambda (dir)
(parameterize ((current-error-port (%make-void-port "rw+"))
(current-output-port (%make-void-port "rw+")))
(and (zero? (system* "tar" "--wildcards" "-x"
"--strip-components=1"
"-C" dir
"-f" tarball "*/DESCRIPTION"))
(description->alist (with-input-from-file
(string-append dir "/DESCRIPTION") read-string))))))))))
(define (listify meta field) (define (listify meta field)
"Look up FIELD in the alist META. If FIELD contains a comma-separated "Look up FIELD in the alist META. If FIELD contains a comma-separated
@ -449,16 +461,15 @@ dependencies."
(define upstream-name (define upstream-name
(package->upstream-name package)) (package->upstream-name package))
(define meta (define version
(fetch-description 'bioconductor upstream-name)) (latest-bioconductor-package-version upstream-name))
(and meta (and version
(let ((version (assoc-ref meta "Version")))
;; Bioconductor does not provide signatures. ;; Bioconductor does not provide signatures.
(upstream-source (upstream-source
(package (package-name package)) (package (package-name package))
(version version) (version version)
(urls (list (bioconductor-uri upstream-name version))))))) (urls (list (bioconductor-uri upstream-name version))))))
(define (cran-package? package) (define (cran-package? package)
"Return true if PACKAGE is an R package from CRAN." "Return true if PACKAGE is an R package from CRAN."