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:
parent
84dfdc5759
commit
27baf50956
@ -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."
|
||||||
|
Loading…
Reference in New Issue
Block a user