01/06: pack: Add '--expression'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 83cfa0247b68adf8fc6461792aa7cdc4f0d838ae
Author: Ludovic Courtès <address@hidden>
Date:   Fri Apr 7 22:20:28 2017 +0200

    pack: Add '--expression'.
    
    * guix/scripts/pack.scm (%options, show-help): Add '--expression'.
    (guix-pack)[maybe-package-argument]: New procedure.
    Use it, and remove variable 'specs'.
    * doc/guix.texi (Invoking guix pack): Document '--expression'.
---
 doc/guix.texi         |  8 ++++++++
 guix/scripts/pack.scm | 31 +++++++++++++++++++------------
 2 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index d413ea4..07ae660 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2476,6 +2476,14 @@ This produces a tarball that follows the
 Docker Image Specification}.
 @end table
 
address@hidden address@hidden
address@hidden -e @var{expr}
+Consider the package @var{expr} evaluates to.
+
+This has the same purpose as the same-named option in @command{guix
+build} (@pxref{Additional Build Options, @code{--expression} in
address@hidden build}}).
+
 @item address@hidden
 @itemx -s @var{system}
 Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 9e91bc2..165e4cc 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -280,6 +280,9 @@ the image."
          (option '(#\f "format") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'format (string->symbol arg) result)))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -323,6 +326,8 @@ Create a bundle of PACKAGE.\n"))
   (display (_ "
   -f, --format=FORMAT    build a pack in the given FORMAT"))
   (display (_ "
+  -e, --expression=EXPR  consider the package EXPR evaluates to"))
+  (display (_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
@@ -349,20 +354,22 @@ Create a bundle of PACKAGE.\n"))
   (define opts
     (parse-command-line args %options (list %default-options)))
 
+  (define maybe-package-argument
+    ;; Given an option pair, return a package, a package/output tuple, or #f.
+    (match-lambda
+      (('argument . spec)
+       (call-with-values
+           (lambda ()
+             (specification->package+output spec))
+         list))
+      (('expression . exp)
+       (read/eval-package-expression exp))
+      (x #f)))
+
   (with-error-handling
     (parameterize ((%graft? (assoc-ref opts 'graft?)))
-      (let* ((dry-run? (assoc-ref opts 'dry-run?))
-             (specs    (filter-map (match-lambda
-                                     (('argument . name)
-                                      name)
-                                     (x #f))
-                                   opts))
-             (packages (map (lambda (spec)
-                              (call-with-values
-                                  (lambda ()
-                                    (specification->package+output spec))
-                                list))
-                            specs))
+      (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+             (packages    (filter-map maybe-package-argument opts))
              (pack-format (assoc-ref opts 'format))
              (name        (string-append (symbol->string pack-format)
                                          "-pack"))