me/guix
Archived
1
0
Fork 0
Code Activity

import: cran: Download tarballs only once.

Browse source 
* guix/import/cran.scm (download): New procedure.
(fetch-description, description->package): Use it.
This commit is contained in:
Ricardo Wurmus 2019-01-03 08:31:15 +01:00
parent 707efe171a
commit b3d0617a55
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
1 changed files with 8 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
guix/import/cran.scm
View file

@ -161,6 +161,12 @@ bioconductor package NAME, or #F if the package is unknown."
(bioconductor-packages-list)) (bioconductor-packages-list))
(cut assoc-ref <> "Version"))) (cut assoc-ref <> "Version")))
;; Little helper to download URLs only once.
(define download
(memoize
(lambda (url)
(with-store store (download-to-store store url)))))
(define (fetch-description repository name) (define (fetch-description repository name)
"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
@ -183,7 +189,7 @@ from ~s: ~a (~s)~%"
;; 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* ((version (latest-bioconductor-package-version name))
(url (car (bioconductor-uri name version))) (url (car (bioconductor-uri name version)))
(tarball (with-store store (download-to-store store url)))) (tarball (download url)))
(call-with-temporary-directory (call-with-temporary-directory
(lambda (dir) (lambda (dir)
(parameterize ((current-error-port (%make-void-port "rw+")) (parameterize ((current-error-port (%make-void-port "rw+"))
@ -299,7 +305,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
((url rest ...) url) ((url rest ...) url)
((? string? url) url) ((? string? url) url)
(_ #f))) (_ #f)))
(tarball (with-store store (download-to-store store source-url))) (tarball (download source-url))
(sysdepends (append (sysdepends (append
(if (needs-zlib? tarball) '("zlib") '()) (if (needs-zlib? tarball) '("zlib") '())
(map string-downcase (listify meta "SystemRequirements")))) (map string-downcase (listify meta "SystemRequirements"))))