From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Subject: [PATCH] guix archive: '-f docker' supports package names as arguments. Date: Sat, 7 Jan 2017 00:58:34 +0100 Message-ID: <20170106235834.28588-1-ludo@gnu.org> References: <87pok12iy5.fsf@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:60914) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cPePW-00039x-Cx for guix-devel@gnu.org; Fri, 06 Jan 2017 18:59:03 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cPePV-0008BB-Iy for guix-devel@gnu.org; Fri, 06 Jan 2017 18:59:02 -0500 In-Reply-To: <87pok12iy5.fsf@gnu.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org 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