[PATCH] guix archive: '-f docker' supports package names as arguments.

[Ludovic Courtès]

This allows users to type:

  guix archive -f docker emacs

as was already the case for the 'nar' format.

Reported by David Thompson.

* guix/scripts/archive.scm (%default-options): Add 'format'.
(export-from-store): Dispatch based on the 'format' key in OPTS.
(guix-archive): Call 'export-from-store' in all cases when the 'export'
key is in OPTS.
---
 guix/scripts/archive.scm | 30 ++++++++++++++++++------------
 1 file changed, 18 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 6eba9e000..3e056fda9 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -53,7 +53,8 @@
 
 (define %default-options
   ;; Alist of default option values.
-  `((system . ,(%current-system))
+  `((format . "nar")
+    (system . ,(%current-system))
     (substitutes? . #t)
     (graft? . #t)
     (max-silent-time . 3600)
@@ -253,8 +254,21 @@ resulting archive to the standard output port."
 
     (if (or (assoc-ref opts 'dry-run?)
             (build-derivations store drv))
-        (export-paths store files (current-output-port)
-                      #:recursive? (assoc-ref opts 'export-recursive?))
+        (match (assoc-ref opts 'format)
+          ("nar"
+           (export-paths store files (current-output-port)
+                         #:recursive? (assoc-ref opts 'export-recursive?)))
+          ("docker"
+           (match files
+             ((file)
+              (let ((system (assoc-ref opts 'system)))
+                (format #t "~a\n"
+                        (build-docker-image file #:system system))))
+             (_
+              ;; TODO: Remove this restriction.
+              (leave (_ "only a single item can be exported to Docker~%")))))
+          (format
+           (leave (_ "~a: unknown archive format~%") format)))
         (leave (_ "unable to export the given packages~%")))))
 
 (define (generate-key-pair parameters)
@@ -338,15 +352,7 @@ the input port."
                 (else
                  (with-store store
                    (cond ((assoc-ref opts 'export)
-                          (cond ((equal? (assoc-ref opts 'format) "docker")
-                                 (match (car opts)
-                                   (('argument . (? store-path? item))
-                                    (format #t "~a\n"
-                                            (build-docker-image
-                                             item
-                                             #:system (assoc-ref opts 
'system))))
-                                   (_ (leave (_ "argument must be a direct 
store path~%")))))
-                                (_ (export-from-store store opts))))
+                          (export-from-store store opts))
                          ((assoc-ref opts 'import)
                           (import-paths store (current-input-port)))
                          ((assoc-ref opts 'missing)
-- 
2.11.0