me/guix
Archived
1
0
Fork 0
Code Activity

import/cran: Accept optional alternative download procedure.

Browse source 
This is useful for cached mass imports.

* guix/import/cran.scm (fetch-description-from-tarball): Accept optional
download keyword.
(fetch-description): Accept optional replacement-download argument.

Change-Id: Ic917074656ac34a24c8e7eea3d3e0528fc5180b3
This commit is contained in:
Ricardo Wurmus 2024-01-17 22:59:11 +01:00
parent 270570f090
commit b94047cf81
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
1 changed files with 8 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
guix/import/cran.scm
View file

@ -270,7 +270,7 @@ bioconductor package NAME, or #F if the package is unknown."
;; of the URLs is the /Archive CRAN URL. ;; of the URLs is the /Archive CRAN URL.
(any (cut download-to-store store <>) urls))))))))) (any (cut download-to-store store <>) urls)))))))))
(define (fetch-description-from-tarball url) (define* (fetch-description-from-tarball url #:key (download download))
"Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and "Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and
return the resulting alist." return the resulting alist."
(match (download url) (match (download url)
@ -288,7 +288,7 @@ return the resulting alist."
(call-with-input-file (string-append dir "/DESCRIPTION") (call-with-input-file (string-append dir "/DESCRIPTION")
read-string))))))))) read-string)))))))))
(define* (fetch-description repository name #:optional version) (define* (fetch-description repository name #:optional version replacement-download)
"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 at VERSION in the given REPOSITORY, or #f in case of failure. NAME is NAME at VERSION in the given REPOSITORY, or #f in case of failure. NAME is
case-sensitive." case-sensitive."
@ -310,7 +310,9 @@ from ~a: ~a (~a)~%")
(string-append "mirror://cran/src/contrib/Archive/" (string-append "mirror://cran/src/contrib/Archive/"
name "/" name "/"
name "_" version ".tar.gz")))) name "_" version ".tar.gz"))))
(fetch-description-from-tarball urls)) (fetch-description-from-tarball
urls #:download (or replacement-download
download)))
(let* ((url (string-append %cran-url name "/DESCRIPTION")) (let* ((url (string-append %cran-url name "/DESCRIPTION"))
(port (http-fetch url)) (port (http-fetch url))
(result (description->alist (read-string port)))) (result (description->alist (read-string port))))
@ -327,7 +329,9 @@ from ~a: ~a (~a)~%")
;; TODO: Honor VERSION. ;; TODO: Honor VERSION.
(version (latest-bioconductor-package-version name type)) (version (latest-bioconductor-package-version name type))
(url (car (bioconductor-uri name version type))) (url (car (bioconductor-uri name version type)))
(meta (fetch-description-from-tarball url))) (meta (fetch-description-from-tarball
url #:download (or replacement-download
download))))
(if (boolean? type) (if (boolean? type)
meta meta
(cons `(bioconductor-type . ,type) meta)))) (cons `(bioconductor-type . ,type) meta))))