[bug#54393] [PATCH v2 3/3] shell: Add '--export-manifest'.

[Ludovic Courtès]

* guix/scripts/shell.scm (show-help, %options): Add '--export-manifest'.
(manifest-entry-version-prefix, manifest->code*)
(export-manifest): New procedures.
(guix-shell): Honor '--export-manifest'.
* tests/guix-shell-export-manifest.sh: New file.
* Makefile.am (SH_TESTS): Add it.
* doc/guix.texi (Invoking guix shell): Document '--export-manifest'.
(Invoking guix environment): Link to it.
(Invoking guix pack): Likewise.
---
 Makefile.am                         |   1 +
 doc/guix.texi                       |  57 +++++++++++++++
 guix/scripts/shell.scm              | 109 +++++++++++++++++++++++++++-
 tests/guix-shell-export-manifest.sh |  84 +++++++++++++++++++++
 4 files changed, 248 insertions(+), 3 deletions(-)
 create mode 100644 tests/guix-shell-export-manifest.sh

diff --git a/Makefile.am b/Makefile.am
index 91243f2cad..20ab7dd5f0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -572,6 +572,7 @@ SH_TESTS =                                  \
   tests/guix-environment.sh                    \
   tests/guix-environment-container.sh          \
   tests/guix-shell.sh                          \
+  tests/guix-shell-export-manifest.sh          \
   tests/guix-graph.sh                          \
   tests/guix-describe.sh                       \
   tests/guix-repl.sh                           \
diff --git a/doc/guix.texi b/doc/guix.texi
index e8ef4286be..85a91019be 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5848,6 +5848,55 @@ This is similar to the same-named option in 
@command{guix package}
 (@pxref{profile-manifest, @option{--manifest}}) and uses the same
 manifest files.
 
+See @option{--export-manifest} below on how to obtain a first manifest.
+
+@cindex manifest, exporting
+@anchor{shell-export-manifest}
+@item --export-manifest
+Write to standard output a manifest suitable for @option{--manifest}
+corresponding to given command-line options.
+
+This is a way to ``convert'' command-line arguments into a manifest.
+For example, imagine you are tired of typing long lines and would like
+to get a manifest equivalent to this command line:
+
+@example
+guix shell -D guile git emacs emacs-geiser emacs-geiser-guile
+@end example
+
+Just add @option{--export-manifest} to the command line above:
+
+@example
+guix shell --export-manifest \
+  -D guile git emacs emacs-geiser emacs-geiser-guile
+@end example
+
+@noindent
+... and you get a manifest along these lines:
+
+@lisp
+(concatenate-manifests
+  (list (specifications->manifest
+          (list "git"
+                "emacs"
+                "emacs-geiser"
+                "emacs-geiser-guile"))
+        (package->development-manifest
+          (specification->package "guile"))))
+@end lisp
+
+You can store it into a file, say @file{manifest.scm}, and from there
+pass it to @command{guix shell} or indeed pretty much any @command{guix}
+command:
+
+@example
+guix shell -m manifest.scm
+@end example
+
+Voilà, you've converted a long command line into a manifest!  That
+conversion process honors package transformation options (@pxref{Package
+Transformation Options}) so it should be lossless.
+
 @item --profile=@var{profile}
 @itemx -p @var{profile}
 Create an environment containing the packages installed in @var{profile}. 
@@ -6235,6 +6284,10 @@ This is similar to the same-named option in 
@command{guix package}
 (@pxref{profile-manifest, @option{--manifest}}) and uses the same
 manifest files.
 
+@xref{shell-export-manifest, @command{guix shell --export-manifest}},
+for information on how to ``convert'' command-line options into a
+manifest.
+
 @item --ad-hoc
 Include all specified packages in the resulting environment, as if an
 @i{ad hoc} package were defined with them as inputs.  This option is
@@ -6693,6 +6746,10 @@ 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.
 
+@xref{shell-export-manifest, @command{guix shell --export-manifest}},
+for information on how to ``convert'' command-line options into a
+manifest.
+
 @item --system=@var{system}
 @itemx -s @var{system}
 Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 1eab05d737..5e7f454f4c 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -21,7 +21,8 @@ (define-module (guix scripts shell)
   #:use-module ((guix diagnostics) #:select (location))
   #:use-module (guix scripts environment)
   #:autoload   (guix scripts build) (show-build-options-help)
-  #:autoload   (guix transformations) (transformation-option-key?
+  #:autoload   (guix transformations) (options->transformation
+                                       transformation-option-key?
                                        show-transformation-options-help)
   #:use-module (guix scripts)
   #:use-module (guix packages)
@@ -41,7 +42,12 @@ (define-module (guix scripts shell)
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (guix cache)
   #:use-module ((ice-9 ftw) #:select (scandir))
-  #:autoload   (gnu packages) (cache-is-authoritative?)
+  #:autoload   (ice-9 pretty-print) (pretty-print)
+  #:autoload   (gnu packages) (cache-is-authoritative?
+                               package-unique-version-prefix
+                               specification->package
+                               specification->package+output
+                               specifications->manifest)
   #:export (guix-shell))
 
 (define (show-help)
@@ -55,10 +61,13 @@ (define (show-help)
   -D, --development      include the development inputs of the next package"))
   (display (G_ "
   -f, --file=FILE        add to the environment the package FILE evaluates 
to"))
+
   (display (G_ "
   -q                     inhibit loading of 'guix.scm' and 'manifest.scm'"))
   (display (G_ "
       --rebuild-cache    rebuild cached environment, if any"))
+  (display (G_ "
+      --export-manifest  print a manifest for the given options"))
 
   (show-environment-options-help)
   (newline)
@@ -112,6 +121,10 @@ (define %options
                         ;; 'wrapped-option'.
                         (alist-delete 'ad-hoc? result)))
 
+              (option '("export-manifest") #f #f
+                      (lambda (opt name arg result)
+                        (alist-cons 'export-manifest? #t result)))
+
               ;; For consistency with 'guix package', support '-f' rather than
               ;; '-l' like 'guix environment' does.
               (option '(#\f "file") #t #f
@@ -380,6 +393,94 @@ (define (key->file key)
        (loop rest system file specs))
       ((_ . rest) (loop rest system file specs)))))
 
+
+;;;
+;;; Exporting a manifest.
+;;;
+
+(define (manifest-entry-version-prefix entry)
+  "Search among all the versions of ENTRY's package that are available, and
+return the shortest unambiguous version prefix for this package."
+  (package-unique-version-prefix (manifest-entry-name entry)
+                                 (manifest-entry-version entry)))
+
+(define (manifest->code* manifest extra-manifests)
+  "Like 'manifest->code', but insert a 'concatenate-manifests' call that
+concatenates MANIFESTS, a list of expressions."
+  (if (null? (manifest-entries manifest))
+      (match extra-manifests
+        ((one) one)
+        (lst   `(concatenate-manifests ,@extra-manifests)))
+      (match (manifest->code manifest
+                             #:entry-package-version
+                             manifest-entry-version-prefix)
+        (('begin exp ... last)
+         `(begin
+            ,@exp
+            ,(match extra-manifests
+               (() last)
+               (_  `(concatenate-manifests
+                     (list ,last ,@extra-manifests)))))))))
+
+(define (export-manifest opts port)
+  "Write to PORT a manifest corresponding to OPTS."
+  (define (manifest-lift proc)
+    (lambda (entry)
+      (match (manifest-entry-item entry)
+        ((? package? p)
+         (manifest-entry
+           (inherit (package->manifest-entry (proc p)))
+           (output (manifest-entry-output entry))))
+        (_
+         entry))))
+
+  (define (validated-spec spec)
+    ;; Return SPEC if it's validate package spec.
+    (specification->package+output spec)
+    spec)
+
+  (let* ((transform (options->transformation opts))
+         (specs     (reverse
+                     (filter-map (match-lambda
+                                   (('package 'ad-hoc-package spec)
+                                    (validated-spec spec))
+                                   (_ #f))
+                                 opts)))
+         (extras    (reverse
+                     (filter-map (match-lambda
+                                   (('package 'package spec)
+                                    ;; Make sure SPEC is valid.
+                                    (specification->package spec)
+
+                                    ;; XXX: This is an approximation:
+                                    ;; transformation options are not applied.
+                                    `(package->development-manifest
+                                      (specification->package ,spec)))
+                                   (_ #f))
+                                 opts)))
+         (manifest  (concatenate-manifests
+                     (cons (map-manifest-entries
+                            (manifest-lift transform)
+                            (specifications->manifest specs))
+                           (filter-map (match-lambda
+                                         (('manifest . file)
+                                          (load-manifest file))
+                                         (_ #f))
+                                       opts)))))
+    (display (G_ "\
+;; What follows is a \"manifest\" equivalent to the command line you gave.
+;; You can store it in a file that you may then pass to any 'guix' command
+;; that accepts a '--manifest' (or '-m') option.\n")
+             port)
+    (match (manifest->code* manifest extras)
+      (('begin exp ...)
+       (for-each (lambda (exp)
+                   (newline port)
+                   (pretty-print exp port))
+                 exp))
+      (exp
+       (pretty-print exp port)))))
+
 
 ;;;
 ;;; One-time hints.
@@ -445,4 +546,6 @@ (define interactive?
                 cache-entries
                 #:entry-expiration entry-expiration)))
 
-  (guix-environment* opts))
+  (if (assoc-ref opts 'export-manifest?)
+      (export-manifest opts (current-output-port))
+      (guix-environment* opts)))
diff --git a/tests/guix-shell-export-manifest.sh 
b/tests/guix-shell-export-manifest.sh
new file mode 100644
index 0000000000..cbb90f04bf
--- /dev/null
+++ b/tests/guix-shell-export-manifest.sh
@@ -0,0 +1,84 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test 'guix shell --export-manifest'.
+#
+
+guix shell --version
+
+tmpdir="t-guix-manifest-$$"
+trap 'rm -r "$tmpdir"' EXIT
+mkdir "$tmpdir"
+
+manifest="$tmpdir/manifest.scm"
+
+# Basics.
+guix shell --export-manifest guile-bootstrap > "$manifest"
+test "$(guix build -m "$manifest")" = "$(guix build guile-bootstrap)"
+
+guix shell -m "$manifest" --bootstrap -- \
+     "$SHELL" -c 'guix package --export-manifest -p "$GUIX_ENVIRONMENT"' > \
+     "$manifest.second"
+for m in "$manifest" "$manifest.second"
+do
+    grep -v '^;' < "$m" > "$m.new" # filter out comments
+    mv "$m.new" "$m"
+done
+
+cat "$manifest"
+cat "$manifest.second"
+
+cmp "$manifest" "$manifest.second"
+
+# Combining manifests.
+guix shell --export-manifest -m "$manifest" gash gash-utils \
+     > "$manifest.second"
+guix build -m "$manifest.second" -d | \
+    grep "$(guix build guile-bootstrap -d)"
+guix build -m "$manifest.second" -d | \
+    grep "$(guix build gash -d)"
+
+# Package transformation option.
+guix shell --export-manifest guile guix --with-latest=guile-json > "$manifest"
+grep 'options->transformation' "$manifest"
+grep '(with-latest . "guile-json")' "$manifest"
+
+# Development manifest.
+guix shell --export-manifest -D guile git > "$manifest"
+grep 'package->development-manifest' "$manifest"
+grep '"guile"' "$manifest"
+guix build -m "$manifest" -d | \
+    grep "$(guix build -e '(@@ (gnu packages commencement) gcc-final)' -d)"
+guix build -m "$manifest" -d | \
+    grep "$(guix build git -d)"
+
+# Test various combinations to make sure generated code uses interfaces
+# correctly.
+for options in                                 \
+    "coreutils grep sed"                       \
+    "gsl openblas gcc-toolchain --tune"                \
+    "guile -m $manifest.previous"              \
+    "git:send-email gdb guile:debug"           \
+    "git -D coreutils"
+do
+    guix shell --export-manifest $options > "$manifest"
+    cat "$manifest"
+    guix shell -m "$manifest" -n
+    mv "$manifest" "$manifest.previous"
+done
-- 
2.34.0