4 files changed, 36 insertions(+), 38 deletions(-)

M guix/download.scm
M guix/scripts/download.scm
M guix/ui.scm
M guix/utils.scm

@@ 21,13 21,15 @@
   #:use-module (ice-9 match)
   #:use-module (guix derivations)
   #:use-module (guix packages)
-  #:use-module ((guix store) #:select (derivation-path?))
+  #:use-module ((guix store) #:select (derivation-path? add-to-store))
+  #:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:export (%mirrors
-            url-fetch))
+            url-fetch
+            download-to-store))
 
 ;;; Commentary:
 ;;;


@@ 231,4 233,17 @@ must be a list of symbol/URL-list pairs."
                                   #:guile-for-build guile-for-build
                                   #:env-vars env-vars)))
 
+(define* (download-to-store store url #:optional (name (basename url))
+                            #:key (log (current-error-port)))
+  "Download from URL to STORE, either under NAME or URL's basename if
+omitted.  Write progress reports to LOG."
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let ((result
+            (parameterize ((current-output-port log))
+              (build:url-fetch url temp #:mirrors %mirrors))))
+       (close port)
+       (and result
+            (add-to-store store name #f "sha256" temp))))))
+
 ;;; download.scm ends here

@@ 21,30 21,15 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix base32)
-  #:use-module ((guix download) #:select (%mirrors))
-  #:use-module (guix build download)
+  #:use-module (guix download)
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:export (guix-download))
 
-(define (fetch-and-store store fetch name)
-  "Call FETCH for URI, and pass it the name of a file to write to; eventually,
-copy data from that port to STORE, under NAME.  Return the resulting
-store path."
-  (call-with-temporary-output-file
-   (lambda (temp port)
-     (let ((result
-            (parameterize ((current-output-port (current-error-port)))
-              (fetch temp))))
-       (close port)
-       (and result
-            (add-to-store store name #f "sha256" temp))))))
 
 ;;;
 ;;; Command-line options.


@@ 124,10 109,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                      (add-to-store store (basename (uri-path uri))
                                    #f "sha256" (uri-path uri)))
                     (else
-                     (fetch-and-store store
-                                      (cut url-fetch arg <>
-                                           #:mirrors %mirrors)
-                                      (basename (uri-path uri))))))
+                     (download-to-store store (uri->string uri)
+                                        (basename (uri-path uri))))))
            (hash  (call-with-input-file
                       (or path
                           (leave (_ "~a: download failed~%")

@@ 41,7 41,6 @@
             with-error-handling
             read/eval-package-expression
             location->string
-            call-with-temporary-output-file
             switch-symlinks
             config-directory
             fill-paragraph


@@ 205,21 204,6 @@ available for download."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
-(define (call-with-temporary-output-file proc)
-  "Call PROC with a name of a temporary file and open output port to that
-file; close the file and delete it when leaving the dynamic extent of this
-call."
-  (let* ((template (string-copy "guix-file.XXXXXX"))
-         (out      (mkstemp! template)))
-    (dynamic-wind
-      (lambda ()
-        #t)
-      (lambda ()
-        (proc template out))
-      (lambda ()
-        (false-if-exception (close out))
-        (false-if-exception (delete-file template))))))
-
 (define (switch-symlinks link target)
   "Atomically switch LINK, a symbolic link, to point to TARGET.  Works
 both when LINK already exists and when it does not."

@@ 60,6 60,7 @@
             version-compare
             version>?
             package-name->name+version
+            call-with-temporary-output-file
             fold2))
 
 


@@ 464,6 465,21 @@ introduce the version part."
       ((head tail ...)
        (loop tail (cons head prefix))))))
 
+(define (call-with-temporary-output-file proc)
+  "Call PROC with a name of a temporary file and open output port to that
+file; close the file and delete it when leaving the dynamic extent of this
+call."
+  (let* ((template (string-copy "guix-file.XXXXXX"))
+         (out      (mkstemp! template)))
+    (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc template out))
+      (lambda ()
+        (false-if-exception (close out))
+        (false-if-exception (delete-file template))))))
+
 (define fold2
   (case-lambda
     ((proc seed1 seed2 lst)