02/02: pack: Add '--manifest'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 4a979afe1b320efcdb3236eb3c8e6c889eb73f38
Author: Konrad Hinsen <address@hidden>
Date:   Fri Feb 9 20:33:12 2018 +0100

    pack: Add '--manifest'.
    
    * guix/scripts/pack.scm (%options, show-help): Add --manifest.
    (guix-pack)[manifest-from-args]: New procedure.
    Use it.
    * doc/guix.texi (Invoking guix pack): Document --manifest.
    
    Signed-off-by: Ludovic Courtès <address@hidden>
---
 doc/guix.texi         | 13 +++++++++++++
 guix/scripts/pack.scm | 22 ++++++++++++++++++++--
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8a9e1bc..7ed39ff 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2841,6 +2841,19 @@ This has the same purpose as the same-named option in 
@command{guix
 build} (@pxref{Additional Build Options, @code{--expression} in
 @command{guix build}}).
 
address@hidden address@hidden
address@hidden -m @var{file}
+Use the packages contained in the manifest object returned by the Scheme
+code in @var{file}.
+
+This has a similar purpose as the same-named option in @command{guix
+package} (@pxref{profile-manifest, @option{--manifest}}) and uses the
+same manifest files.  It allows you to define a collection of packages
+once and use it both for creating profiles and for creating archives
+for use on machines that do not have Guix installed.  Note that you can
+specify @emph{either} a manifest file @emph{or} a list of packages,
+but not both.
+
 @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 a22258d..a1b839e 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2015, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Efraim Flashner <address@hidden>
 ;;; Copyright © 2017 Ricardo Wurmus <address@hidden>
+;;; Copyright © 2018 Konrad Hinsen <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -292,6 +293,9 @@ the image."
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
+         (option '(#\m "manifest") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'manifest arg result)))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -345,6 +349,9 @@ Create a bundle of PACKAGE.\n"))
   (display (G_ "
   -S, --symlink=SPEC     create symlinks to the profile according to SPEC"))
   (display (G_ "
+  -m, --manifest=FILE    create a new profile generation with the manifest
+                         from FILE"))
+  (display (G_ "
       --localstatedir    include /var/guix in the resulting pack"))
   (newline)
   (display (G_ "
@@ -375,10 +382,21 @@ Create a bundle of PACKAGE.\n"))
        (read/eval-package-expression exp))
       (x #f)))
 
+  (define (manifest-from-args opts)
+    (let ((packages      (filter-map maybe-package-argument opts))
+          (manifest-file (assoc-ref opts 'manifest)))
+      (cond
+       ((and manifest-file (not (null? packages)))
+        (leave (G_ "both a manifest and a package list were given~%")))
+       (manifest-file
+        (let ((user-module (make-user-module '((guix profiles) (gnu)))))
+          (load* manifest-file user-module)))
+       (else (packages->manifest packages)))))
+
   (with-error-handling
     (parameterize ((%graft? (assoc-ref opts 'graft?)))
       (let* ((dry-run?    (assoc-ref opts 'dry-run?))
-             (packages    (filter-map maybe-package-argument opts))
+             (manifest    (manifest-from-args opts))
              (pack-format (assoc-ref opts 'format))
              (name        (string-append (symbol->string pack-format)
                                          "-pack"))
@@ -397,7 +415,7 @@ Create a bundle of PACKAGE.\n"))
 
           (run-with-store store
             (mlet* %store-monad ((profile (profile-derivation
-                                           (packages->manifest packages)
+                                           manifest
                                            #:target target))
                                  (drv (build-image name profile
                                                    #:target