~ruther/guix-local: import/cran: Accept optional alternative download procedure.

b94047cf810c70e6a596cea539e50d487f5c044e — Ricardo Wurmus 2 years ago 270570f

import/cran: Accept optional alternative download procedure.

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

patch browse .tar.gz .zip

1 files changed, 8 insertions(+), 4 deletions(-)

M guix/import/cran.scm

M guix/import/cran.scm => guix/import/cran.scm +8 -4

@@ 270,7 270,7 @@ bioconductor package NAME, or #F if the package is unknown."
             ;; of the URLs is the /Archive CRAN URL.
             (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
 return the resulting alist."
   (match (download url)


@@ 288,7 288,7 @@ return the resulting alist."
                 (call-with-input-file (string-append dir "/DESCRIPTION")
                   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
 NAME at VERSION in the given REPOSITORY, or #f in case of failure.  NAME is
 case-sensitive."


@@ 310,7 310,9 @@ from ~a: ~a (~a)~%")
                              (string-append "mirror://cran/src/contrib/Archive/"
                                             name "/"
                                             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"))
                   (port   (http-fetch url))
                   (result (description->alist (read-string port))))


@@ 327,7 329,9 @@ from ~a: ~a (~a)~%")
                 ;; TODO: Honor VERSION.
                 (version (latest-bioconductor-package-version name 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)
            meta
            (cons `(bioconductor-type . ,type) meta))))