[bug#30409] [PATCH 1/2] guix: Add option --manifest to guix pack

[Konrad Hinsen <konrad.hinsen@fastmail.net>]

* guix/scripts/pack.scm: Extend the way the manifest for the archive
contents is created. If the --manifest option is given, read the
manifest from the provided file. Otherwise, create the manifest from
a package list as before. Check if both a manifest file and a package list
were given, which is an error.
---
 guix/scripts/pack.scm | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index a22258d5a..f772083c6 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -292,6 +292,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
@@ -375,10 +378,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 +411,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
-- 
2.14.3 (Apple Git-98)