[bug#60629] [PATCH 1/3] transformations: Add '--with-version'.

["Ludovic Courtès" <ludo@gnu.org>]

This is a followup to 8aeccc6240ec45f0bc7bed655e0c8149ae4253eb.

* guix/transformations.scm (package-with-upstream-version): New procedure.
(transform-package-latest)[package-with-latest-upstream]: Remove.
Use 'package-with-upstream-version' instead.
(transform-package-version): New procedure.
(%transformations, %transformation-options)
(show-transformation-options-help/detailed): Add '-with-version'.
* tests/transformations.scm ("options->transformation, with-version"):
New test.
* doc/guix.texi (Package Transformation Options): Document '--with-version'.
(Defining Package Variants): Mention it.
---
 doc/guix.texi             | 19 ++++++++--
 guix/transformations.scm  | 78 +++++++++++++++++++++++++++------------
 tests/transformations.scm | 19 +++++++++-
 3 files changed, 89 insertions(+), 27 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 293c3016aa..d3af813b5a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8072,8 +8072,9 @@ vintage!):
                 "0lappv4slgb5spyqbh6yl5r013zv72yqg2pcl30mginf3wdqd8k9"))))))
 @end lisp
 
-The example above corresponds to what the @option{--with-source} package
-transformation option does.  Essentially @code{hello-2.2} preserves all
+The example above corresponds to what the @option{--with-version}
+or @option{--with-source} package transformations option do.
+Essentially @code{hello-2.2} preserves all
 the fields of @code{hello}, except @code{version} and @code{source},
 which it overrides.  Note that the original @code{hello} variable is
 still there, in the @code{(gnu packages base)} module, unchanged.  When
@@ -12735,7 +12736,9 @@ Coreutils in the dependency graph is rebuilt.
 
 @cindex upstream, latest version
 @item --with-latest=@var{package}
-So you like living on the bleeding edge?  This option is for you!  It
+@itemx --with-version=@var{package}=@var{version}
+So you like living on the bleeding edge?  The @option{--with-latest}
+option is for you!  It
 replaces occurrences of @var{package} in the dependency graph with its
 latest upstream version, as reported by @command{guix refresh}
 (@pxref{Invoking guix refresh}).
@@ -12751,6 +12754,16 @@ of Guile-JSON:
 guix build guix --with-latest=guile-json
 @end example
 
+The @option{--with-version} works similarly except that it lets you
+specify that you want precisely @var{version}, assuming that version
+exists upstream.  For example, to spawn a development environment with
+SciPy built against version 1.22.4 of NumPy (skipping its test suite
+because hey, we're not gonna wait this long), you would run:
+
+@example
+guix shell python python-scipy --with-version=python-numpy=1.22.4
+@end example
+
 There are limitations.  First, in cases where the tool cannot or does
 not know how to authenticate source code, you are at risk of running
 malicious code; a warning is emitted in this case.  Second, this option
diff --git a/guix/transformations.scm b/guix/transformations.scm
index bf9639020b..d6a2ef0708 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -757,35 +757,61 @@ (define rewrite
         (rewrite obj)
         obj)))
 
+(define* (package-with-upstream-version p #:optional version)
+  "Return package P changed to use the given upstream VERSION or, if VERSION
+is #f, the latest known upstream version."
+  (let ((source (package-latest-release p #:version version)))
+    (cond ((not source)
+           (if version
+               (warning
+                (G_ "could not find version ~a of '~a' upstream~%")
+                version (package-name p))
+               (warning
+                (G_ "could not determine latest upstream release of '~a'~%")
+                (package-name p)))
+           p)
+          ((string=? (upstream-source-version source)
+                     (package-version p))
+           p)
+          (else
+           (unless (pair? (upstream-source-signature-urls source))
+             (warning (G_ "cannot authenticate source of '~a', version ~a~%")
+                      (package-name p)
+                      (upstream-source-version source)))
+
+           ;; TODO: Take 'upstream-source-input-changes' into account.
+           (package
+             (inherit p)
+             (version (upstream-source-version source))
+             (source source))))))
+
 (define (transform-package-latest specs)
   "Return a procedure that rewrites package graphs such that those in SPECS
 are replaced by their latest upstream version."
-  (define (package-with-latest-upstream p)
-    (let ((source (package-latest-release p)))
-      (cond ((not source)
-             (warning
-              (G_ "could not determine latest upstream release of '~a'~%")
-              (package-name p))
-             p)
-            ((string=? (upstream-source-version source)
-                       (package-version p))
-             p)
-            (else
-             (unless (pair? (upstream-source-signature-urls source))
-               (warning (G_ "cannot authenticate source of '~a', version ~a~%")
-                        (package-name p)
-                        (upstream-source-version source)))
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (lambda (spec)
+            (cons spec package-with-upstream-version))
+          specs)))
 
-             ;; TODO: Take 'upstream-source-input-changes' into account.
-             (package
-               (inherit p)
-               (version (upstream-source-version source))
-               (source source))))))
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
 
+(define (transform-package-version specs)
+  "Return a procedure that rewrites package graphs such that those in SPECS
+are replaced by the specified upstream version."
   (define rewrite
     (package-input-rewriting/spec
      (map (lambda (spec)
-            (cons spec package-with-latest-upstream))
+            (match (string-tokenize spec %not-equal)
+              ((spec version)
+               (cons spec (cut package-with-upstream-version <> version)))
+              (_
+               (raise (formatted-message
+                       (G_ "~a: invalid upstream version specification")
+                       spec)))))
           specs)))
 
   (lambda (obj)
@@ -809,7 +835,8 @@ (define %transformations
     (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)
     (with-patch  . ,transform-package-patches)
-    (with-latest . ,transform-package-latest)))
+    (with-latest . ,transform-package-latest)
+    (with-version . ,transform-package-version)))
 
 (define (transformation-procedure key)
   "Return the transformation procedure associated with KEY, a symbol such as
@@ -881,6 +908,8 @@ (define micro-architecture
                   (parser 'with-patch))
           (option '("with-latest") #t #f
                   (parser 'with-latest))
+          (option '("with-version") #t #f
+                  (parser 'with-version))
 
           (option '("help-transform") #f #f
                   (lambda _
@@ -915,6 +944,9 @@ (define (show-transformation-options-help/detailed)
   (display (G_ "
       --with-latest=PACKAGE
                          use the latest upstream release of PACKAGE"))
+  (display (G_ "
+      --with-version=PACKAGE=VERSION
+                         use the given upstream VERSION of PACKAGE"))
   (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 5c136e1d48..1fa2c0bba8 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2017, 2019-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2017, 2019-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -497,6 +497,23 @@ (define (package-name* obj)
                    `((with-latest . "foo")))))
           (package-version (t p)))))
 
+(test-equal "options->transformation, with-version"
+  "1.0"
+  (mock ((guix upstream) %updaters
+         (delay (list (upstream-updater
+                       (name 'dummy)
+                       (pred (const #t))
+                       (description "")
+                       (import (const (upstream-source
+                                         (package "foo")
+                                         (version "1.0")
+                                         (urls '("http://example.org")))))))))
+        (let* ((p0 (dummy-package "foo" (version "7.7")))
+               (p1 (dummy-package "bar" (inputs (list p0))))
+               (t  (options->transformation
+                    `((with-version . "foo=1.0")))))
+          (package-version (lookup-package-input (t p1) "foo")))))
+
 (test-equal "options->transformation, tune"
   '(cpu-tuning . "superfast")
   (let* ((p0 (dummy-package "p0"))
-- 
2.38.1