nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

import: cran: Support experiment and annotation packages. 

* guix/import/cran.scm (%bioconductor-packages-list-url): Replace variable...
(bioconductor-packages-list-url): ...with this procedure.
(bioconductor-packages-list): Accept optional TYPE argument.
(latest-bioconductor-package-version): Same.
(fetch-description): Determine package type and use it in calls to
LATEST-BIOCONDUCTOR-PACKAGE-VERSION and BIOCONDUCTOR-URI.
(description->package): Pass package type to URI helper procedure; include
package type in annotation or experiment packages from Bioconducter.
This commit is contained in:
Ricardo Wurmus 2019-08-16 14:59:23 +02:00
parent c586f427b4
commit 5063deab08
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
1 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
guix/import/cran.scm
View File

@ -132,14 +132,19 @@ package definition."
;; updated together. ;; updated together.
(define %bioconductor-version "3.9") (define %bioconductor-version "3.9")
(define %bioconductor-packages-list-url (define* (bioconductor-packages-list-url #:optional type)
(string-append "https://bioconductor.org/packages/" (string-append "https://bioconductor.org/packages/"
%bioconductor-version "/bioc/src/contrib/PACKAGES")) %bioconductor-version
(match type
('annotation "/data/annotation")
('experiment "/data/experiment")
(_ "/bioc"))
"/src/contrib/PACKAGES"))
(define (bioconductor-packages-list) (define* (bioconductor-packages-list #:optional type)
"Return the latest version of package NAME for the current bioconductor "Return the latest version of package NAME for the current bioconductor
release." release."
(let ((url (string->uri %bioconductor-packages-list-url))) (let ((url (string->uri (bioconductor-packages-list-url type))))
(guard (c ((http-get-error? c) (guard (c ((http-get-error? c)
(format (current-error-port) (format (current-error-port)
"error: failed to retrieve list of packages from ~s: ~a (~s)~%" "error: failed to retrieve list of packages from ~s: ~a (~s)~%"
@ -153,12 +158,12 @@ release."
(description->alist (string-join chunk "\n"))) (description->alist (string-join chunk "\n")))
(chunk-lines (read-lines (http-fetch/cached url))))))) (chunk-lines (read-lines (http-fetch/cached url)))))))
(define (latest-bioconductor-package-version name) (define* (latest-bioconductor-package-version name #:optional type)
"Return the version string corresponding to the latest release of the "Return the version string corresponding to the latest release of the
bioconductor package NAME, or #F if the package is unknown." bioconductor package NAME, or #F if the package is unknown."
(and=> (find (lambda (meta) (and=> (find (lambda (meta)
(string=? (assoc-ref meta "Package") name)) (string=? (assoc-ref meta "Package") name))
(bioconductor-packages-list)) (bioconductor-packages-list type))
(cut assoc-ref <> "Version"))) (cut assoc-ref <> "Version")))
;; Little helper to download URLs only once. ;; Little helper to download URLs only once.
@ -187,8 +192,12 @@ from ~s: ~a (~s)~%"
;; Currently, the bioconductor project does not offer a way to access a ;; Currently, the bioconductor project does not offer a way to access a
;; package's DESCRIPTION file over HTTP, so we determine the version, ;; package's DESCRIPTION file over HTTP, so we determine the version,
;; download the source tarball, and then extract the DESCRIPTION file. ;; download the source tarball, and then extract the DESCRIPTION file.
(and-let* ((version (latest-bioconductor-package-version name)) (and-let* ((type (or
(url (car (bioconductor-uri name version))) (and (latest-bioconductor-package-version name) #t)
(and (latest-bioconductor-package-version name 'annotation) 'annotation)
(and (latest-bioconductor-package-version name 'experiment) 'experiment)))
(version (latest-bioconductor-package-version name type))
(url (car (bioconductor-uri name version type)))
(tarball (download url))) (tarball (download url)))
(call-with-temporary-directory (call-with-temporary-directory
(lambda (dir) (lambda (dir)
@ -198,8 +207,11 @@ from ~s: ~a (~s)~%"
"--strip-components=1" "--strip-components=1"
"-C" dir "-C" dir
"-f" tarball "*/DESCRIPTION")) "-f" tarball "*/DESCRIPTION"))
(description->alist (with-input-from-file (and=> (description->alist (with-input-from-file
(string-append dir "/DESCRIPTION") read-string)))))))))) (string-append dir "/DESCRIPTION") read-string))
(lambda (meta)
(if (boolean? type) meta
(cons `(bioconductor-type . ,type) meta))))))))))))
(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
@ -306,7 +318,11 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(home-page (match (listify meta "URL") (home-page (match (listify meta "URL")
((url rest ...) url) ((url rest ...) url)
(_ (string-append base-url name)))) (_ (string-append base-url name))))
(source-url (match (uri-helper name version) (source-url (match (apply uri-helper name version
(case repository
((bioconductor)
(list (assoc-ref meta 'bioconductor-type)))
(else '())))
((url rest ...) url) ((url rest ...) url)
((? string? url) url) ((? string? url) url)
(_ #f))) (_ #f)))
@ -330,7 +346,11 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(version ,version) (version ,version)
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (,(procedure-name uri-helper) ,name version)) (uri (,(procedure-name uri-helper) ,name version
,@(or (and=> (assoc-ref meta 'bioconductor-type)
(lambda (type)
(list (list 'quote type))))
'())))
(sha256 (sha256
(base32 (base32
,(bytevector->nix-base32-string (file-sha256 tarball)))))) ,(bytevector->nix-base32-string (file-sha256 tarball))))))