scripts: package: Transform before creating manifest entries.

* guix/scripts/package.scm (options->installable): Add TRANSFORM
argument, to be able to directly transform the new packages before
creating their manifest entries.
(process-actions): Remove transform-entry, and step3, transforming
directly in step2.
* tests/guix-package.sh: Add test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 42 insertions, 24 deletions

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d007005607..4673cf18b2 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -694,10 +695,10 @@ the resulting manifest entry."
   (manifest-entry-with-provenance
    (package->manifest-entry package output)))
 
-(define (options->installable opts manifest transaction)
-  "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
-return an variant of TRANSACTION that accounts for the specified installations
-and upgrades."
+(define (options->installable opts manifest transform transaction)
+  "Given MANIFEST, the current manifest, OPTS, and TRANSFORM, the result of
+'args-fold', return an variant of TRANSACTION that accounts for the specified
+installations, upgrades and transformations."
   (define upgrade?
     (options->upgrade-predicate opts))
 
@@ -714,13 +715,14 @@ and upgrades."
                   (('install . (? package? p))
                    ;; When given a package via `-e', install the first of its
                    ;; outputs (XXX).
-                   (package->manifest-entry* p "out"))
+                   (package->manifest-entry* (transform p) "out"))
                   (('install . (? string? spec))
                    (if (store-path? spec)
                        (store-item->manifest-entry spec)
                        (let-values (((package output)
                                      (specification->package+output spec)))
-                         (package->manifest-entry* package output))))
+                         (package->manifest-entry* (transform package)
+                                                   output))))
                   (('install . obj)
                    (leave (G_ "cannot install non-package object: ~s~%")
                           obj))
@@ -979,16 +981,6 @@ processed, #f otherwise."
   (define profile  (or (assoc-ref opts 'profile) %current-profile))
   (define transform (options->transformation opts))
 
-  (define (transform-entry entry)
-    (let ((item (transform (manifest-entry-item entry))))
-      (manifest-entry-with-transformations
-       (manifest-entry
-         (inherit entry)
-         (item item)
-         (version (if (package? item)
-                      (package-version item)
-                      (manifest-entry-version entry)))))))
-
   (when (equal? profile %current-profile)
     ;; Normally the daemon created %CURRENT-PROFILE when we connected, unless
     ;; it's a version that lacks the fix for <https://bugs.gnu.org/37744>
@@ -1021,16 +1013,12 @@ processed, #f otherwise."
                              (map load-manifest files))))))
            (step1    (options->removable opts manifest
                                          (manifest-transaction)))
-           (step2    (options->installable opts manifest step1))
-           (step3    (manifest-transaction
-                      (inherit step2)
-                      (install (map transform-entry
-                                    (manifest-transaction-install step2)))))
-           (new      (manifest-perform-transaction manifest step3))
+           (step2    (options->installable opts manifest transform step1))
+           (new      (manifest-perform-transaction manifest step2))
            (trans    (if (null? files)
-                         step3
+                         step2
                          (fold manifest-transaction-install-entry
-                               step3
+                               step2
                                (manifest-entries manifest)))))
 
       (warn-about-old-distro)
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index d1b383d2ad..dedba2fd74 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,6 +1,7 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+# Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 #
 # This file is part of GNU Guix.
 #
@@ -210,6 +211,35 @@ test "$(readlink -f "$profile/bin/guile")" \
 test ! -f "$profile/bin/sed"
 rm "$profile" "$profile"-[0-9]-link
 
+# Make sure transformations apply to propagated inputs and don't lead to
+# conflicts when installing them alongside, see
+# <https://issues.guix.gnu.org/55316>.
+mkdir "$module_dir"
+cat > "$module_dir/test.scm" <<EOF
+(define-module (test)
+  #:use-module (guix packages)
+  #:use-module (gnu packages base)
+  #:use-module (guix build-system trivial))
+
+(define-public dummy-package
+  (package
+    (name "dummy-package")
+    (version "1")
+    (source #f)
+    (build-system trivial-build-system)
+    (propagated-inputs
+     (list hello))
+    (synopsis "dummy")
+    (description "dummy")
+    (home-page "dummy")
+    (license #f)))
+EOF
+guix package -p "$profile" -L "$module_dir"\
+     -i hello dummy-package \
+     --without-tests=hello -n
+rm "$module_dir/test.scm"
+rmdir "$module_dir"
+
 # Profiles with a relative file name.  Make sure we don't create dangling
 # symlinks--see bug report at
 # <https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00036.html>.