summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/import/cran.scm61
1 files changed, 36 insertions, 25 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index bcfc0d9355..5622f759e0 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -130,9 +130,6 @@ package definition."
;; The latest Bioconductor release is 3.6. Bioconductor packages should be
;; 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-packages-list-url
@@ -168,20 +165,35 @@ bioconductor package NAME, or #F if the package is unknown."
"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
case-sensitive."
- ;; This API always returns the latest release of the module.
- (let ((url (string-append (case repository
- ((cran) (string-append %cran-url name))
- ((bioconductor) (bioconductor-mirror-url name)))
- "/DESCRIPTION")))
- (guard (c ((http-get-error? c)
- (format (current-error-port)
- "error: failed to retrieve package information \
+ (case repository
+ ((cran)
+ (let ((url (string-append %cran-url name "/DESCRIPTION")))
+ (guard (c ((http-get-error? c)
+ (format (current-error-port)
+ "error: failed to retrieve package information \
from ~s: ~a (~s)~%"
- (uri->string (http-get-error-uri c))
- (http-get-error-code c)
- (http-get-error-reason c))
- #f))
- (description->alist (read-string (http-fetch url))))))
+ (uri->string (http-get-error-uri c))
+ (http-get-error-code c)
+ (http-get-error-reason c))
+ #f))
+ (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)
"Look up FIELD in the alist META. If FIELD contains a comma-separated
@@ -449,16 +461,15 @@ dependencies."
(define upstream-name
(package->upstream-name package))
- (define meta
- (fetch-description 'bioconductor upstream-name))
+ (define version
+ (latest-bioconductor-package-version upstream-name))
- (and meta
- (let ((version (assoc-ref meta "Version")))
- ;; Bioconductor does not provide signatures.
- (upstream-source
- (package (package-name package))
- (version version)
- (urls (list (bioconductor-uri upstream-name version)))))))
+ (and version
+ ;; Bioconductor does not provide signatures.
+ (upstream-source
+ (package (package-name package))
+ (version version)
+ (urls (list (bioconductor-uri upstream-name version))))))
(define (cran-package? package)
"Return true if PACKAGE is an R package from CRAN."