[bug#43193] [PATCH] guix: Add --with-dependency-source option

[Jesse Gibbons <jgibbons2357@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2052 bytes --]

Attached are the patches that make the --with-source option recursive, 
add documentation, add a test, adjust a test, and update the news.

As expected, the changes I made are incompatible with the test 
"options->transformation, with-source, no matches". Since 
options->transformation, with-source does a recursive replacement, it 
returns a clone of the package in question. I have tried changing the 
comparison to eq?, eqv? and equal?, each returning false, so I settled 
on a (limited) comparison of the packages' attributes.

On 9/13/20 6:55 AM, Ludovic Courtès wrote:
> Hi,
>
> Jesse Gibbons <jgibbons2357@gmail.com> skribis:
>
>> On 9/11/20 9:43 AM, Ludovic Courtès wrote:
> [...]
>
>>> So maybe drop the second clause for non-recursive replacement, and drop
>>> ‘transform-package-source’ as well.
>> I included a fallback to transform-package-source because the
>> following happens:
>>
>> $ ./pre-inst-env guix build --with-source=$(guix build --source hello) hello
>> guix build: error: invalid source replacement specification:
>> "/gnu/store/hbdalsf5lpf01x4dcknwx6xbn6n5km6k-hello-2.10.tar.gz"
>>
>> This does not fail when I fall back to the non-recursive logic.
>>
>> I can drop transform-package-source, but I will need to do some more
>> hacking to figure out how the package name and version are parsed from
>> the file name as described in the manual, and move it to the logic in
>> transform-package-inputs/source.
> Yes, that’d be nice.  Namely, if you do:
>
>    guix build hello --source=hello-1.2.3.tar.gz
>
> it should work just as now (from the source file name, we assume that
> the source applies to package “hello”).
>
> Conversely, doing:
>
>    guix build hello --source=xyz-hello-1.2.3.tar.gz
>
> would have no effect.  It would not even emit a warning, unlike now.
>
>> I'm not going to have as much free time starting next week, so I might
>> not be able to do that for a while, but I will try to get it done
>> ASAP.
> Sure, let’s stay in touch, I think we’re almost done!
>
> Thank you,
> Ludo’.

[-- Attachment #2: 0001-guix-Make-with-source-option-recursive.patch --]
[-- Type: text/x-patch, Size: 7900 bytes --]

From 2d2f6c97ad1deeb2fc8a214d992c7894a7c5e293 Mon Sep 17 00:00:00 2001
From: Jesse Gibbons <jgibbons2357+guix@gmail.com>
Date: Thu, 3 Sep 2020 17:45:08 -0600
Subject: [PATCH 1/2] guix: Make --with-source option recursive

* guix/scripts/build.scm: (transform-package-inputs/source): new
  function
(evaluate-source-replacement-specs): new function
(%transformations): change with-source to use
evaluate-source-replacement-specs

* doc/guix.texi (Package Transformation Options): document it.

* tests/scripts-build.scm: (options->transformation, with-source, no
  matches): adjust to new expectations.
(options->transformation, with-source, recursive): new test.
---
 doc/guix.texi           |  4 +--
 guix/scripts/build.scm  | 61 ++++++++++++++++++++++++++++++++++++++---
 tests/scripts-build.scm | 25 +++++++++++++++--
 3 files changed, 81 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 82241b010a..3470ccc99c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9142,8 +9142,8 @@ without having to type in the definitions of package variants
 @itemx --with-source=@var{package}=@var{source}
 @itemx --with-source=@var{package}@@@var{version}=@var{source}
 Use @var{source} as the source of @var{package}, and @var{version} as
-its version number.
-@var{source} must be a file name or a URL, as for @command{guix
+its version number.  This replacement is applied recursively on all
+dependencies.  @var{source} must be a file name or a URL, as for @command{guix
 download} (@pxref{Invoking guix download}).
 
 When @var{package} is omitted,
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 38e0516c95..a899f18a61 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -201,9 +201,9 @@ matching URIs given in SOURCES."
              (#f
               ;; Determine the package name and version from URI.
               (call-with-values
-                  (lambda ()
-                    (hyphen-package-name->name+version
-                     (tarball-base-name (basename uri))))
+                (lambda ()
+                 (hyphen-package-name->name+version
+                  (tarball-base-name (basename uri))))
                 (lambda (name version)
                   (list name version uri))))
              (index
@@ -280,6 +280,26 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
           (rewrite obj)
           obj))))
 
+(define (transform-package-inputs/source replacement-specs)
+  "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
+strings like \"guile=/path/to/source\" or
+\"guile=https://www.example.com/guile-source.tar.gz\" meaning that, any
+dependency on a package called \"guile\" must be replaced with a dependency on a
+\"guile\" built with the source at the specified location.  SPECS may also
+simply be a file location, in which case the package name and version are parsed
+from the file name."
+ (lambda (store obj)
+   (let* ((replacements (evaluate-source-replacement-specs replacement-specs
+                                                           (lambda* (old file #:optional version)
+                                                           (package-with-source store old file version))))
+          (rewrite (package-input-rewriting/spec replacements))
+          (rewrite* (lambda (obj)
+                     (rewrite obj))))
+         (if (package? obj)
+             (rewrite* obj)
+             obj))))
+
 (define %not-equal
   (char-set-complement (char-set #\=)))
 
@@ -314,6 +334,39 @@ syntax, or if a package it refers to could not be found."
             (leave (G_ "invalid replacement specification: ~s~%") spec))))
        specs))
 
+(define (evaluate-source-replacement-specs specs proc)
+  "Parse SPECS, a list of strings like \"guile=/path/to/source\", and return a
+list of package pairs, where (PROC PACKAGE URL) returns the replacement package.
+Raise an error if an element of SPECS uses invalid syntax, or if a package it
+refers to could not be found."
+  (define* (replacement file #:optional version)
+   (lambda (old)
+               (proc old file version)))
+  (map (lambda (spec)
+         (match (string-tokenize spec %not-equal)
+           ((package-spec file)
+            (let* ((spec-list (call-with-values
+                                (lambda ()
+                                  (package-specification->name+version+output package-spec))
+                                list))
+                   (name (list-ref spec-list 0))
+                   (version (list-ref spec-list 1)))
+              (cons name (replacement file version))))
+           ((file)
+             (let* ((package-spec
+              (call-with-values
+                (lambda ()
+                 (hyphen-package-name->name+version
+                  (tarball-base-name (basename file))))
+                (lambda (name version)
+                              (cons name version))))
+              (name (car package-spec))
+              (version (cdr package-spec)))
+               (cons name (replacement file version))))
+           (_
+            (leave (G_ "invalid source replacement specification: ~s~%") spec))))
+       specs))
+
 (define (transform-package-source-branch replacement-specs)
   "Return a procedure that, when passed a package, replaces its direct
 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
@@ -398,7 +451,7 @@ a checkout of the Git repository at the given URL."
   ;; key used in the option alist, and the cdr is the transformation
   ;; procedure; it is called with two arguments: the store, and a list of
   ;; things to build.
-  `((with-source . ,transform-package-source)
+  `((with-source . ,transform-package-inputs/source)
     (with-input  . ,transform-package-inputs)
     (with-graft  . ,transform-package-inputs/graft)
     (with-branch . ,transform-package-source-branch)
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 32876e956a..40d7d03637 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -94,9 +94,9 @@
       (let* ((port (open-output-string))
              (new  (parameterize ((guix-warning-port port))
                      (t store p))))
-        (and (eq? new p)
-             (string-contains (get-output-string port)
-                              "had no effect"))))))
+        (and (eq? (package-version new) (package-version p))
+             (eq? (package-name new) (package-name p))
+             (eq? (package-source new) (package-source p)))))))
 
 (test-assert "options->transformation, with-source, PKG=URI"
   (let* ((p (dummy-package "foo"))
@@ -127,6 +127,25 @@
                        (add-to-store store (basename s) #t
                                      "sha256" s)))))))
 
+(test-assert "options->transformation, with-source, recursive"
+  (let* ((q (dummy-package "foo"))
+         (p (dummy-package "guix.scm"
+            (inputs `(("foo" ,q)))))
+         (s (search-path %load-path "guix.scm"))
+         (f (string-append "foo@42.0=" s))
+         (t (options->transformation `((with-source . ,f)))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (match (package-inputs new)
+                    ((("foo" dep1))
+                     (and
+                       (string=? (package-name dep1) "foo")
+                       (string=? (package-version dep1) "42.0")
+                       (string=? (package-source dep1)
+                                 (add-to-store store (basename s) #t
+                                               "sha256" s))))))))))
+
 (test-assert "options->transformation, with-input"
   (let* ((p (dummy-package "guix.scm"
               (inputs `(("foo" ,(specification->package "coreutils"))
-- 
2.28.0


[-- Attachment #3: 0002-news-Add-entry-for-with-source.patch --]
[-- Type: text/x-patch, Size: 1163 bytes --]

From 738fdb35af1449e245ce2e48c266c82f798d89af Mon Sep 17 00:00:00 2001
From: Jesse Gibbons <jgibbons2357+guix@gmail.com>
Date: Sat, 26 Sep 2020 16:29:25 -0600
Subject: [PATCH 2/2] news: Add entry for "--with-source"

* etc/news,scm: Add entry.
---
 etc/news.scm | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 1ef238ca2d..fcb195c679 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -13,6 +13,14 @@
 (channel-news
  (version 0)
 
+ (entry (commit "2d2f6c97ad1deeb2fc8a214d992c7894a7c5e293")
+        (title (en "@option{--with-source} now recursive"))
+        (body (en "The @option{--with-source} common option now uses the
+specified source for all matching dependencies of any packages guix is directed
+to work with. This option is useful for all package maintainers, developers,
+and, in general, all users who want guix to facilitate their rights to modify
+their software and share their changes.")))
+
  (entry (commit "a98712785e0b042a290420fd74e5a4a5da4fc68f")
         (title (en "New @command{guix git authenticate} command")
                (de "Neuer Befehl @command{guix git authenticate}")
-- 
2.28.0