From 01445711db6771cea6122859c3f717f130359f55 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 7 Jan 2017 00:48:11 +0100
Subject: [PATCH] guix archive: '-f docker' supports package names as
 arguments.

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 6eba9e0008..3e056fda9b 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -53,7 +53,8 @@ (define-module (guix scripts archive)
 
 (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 @@ (define (export-from-store store opts)
 
     (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 @@ (define (lines 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)