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

[Jesse Gibbons <jgibbons2357@gmail.com>]

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

     The attached patch adds support for the --with-dependency-source 
common build option. It can be used to specify the sources of 
dependencies of specified packages. With this step, we can close #42155. 
This is also a step in closing #43061.

Note that I suggested making a new 
--with-dependency-source=package=source build option in response to 
#42155 and nobody responded with an objection. So I am sending this 
patch with the assumption that there are no objections to this new build 
option, and that if a member of the community wants to completely 
replace the behavior of --with-source with the behavior of the new 
option, that person can do the work required to not break 
--with-source=source.

-Jesse


[-- Attachment #2: v1-0001-guix-Add-with-dependency-source-option.patch --]
[-- Type: text/x-patch, Size: 4347 bytes --]

From 91a89277067fd454ad77edb3a09ed06382f3694c 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 v1 1/1] guix: Add --with-dependency-source option

* guix/scripts/build.scm: (transform-package-inputs/source): new
  function
(evaluate-source-replacement-specs): new function
(%transformations): add with-dependency-source option
(%transformation-options): add with-dependency-source-option
(show-transformation-options-help): document --with-dependency-source
---
 guix/scripts/build.scm | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 6286a43c02..0713595a00 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -280,6 +280,24 @@ 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."
+  (lambda (store obj)
+    (let* ((replacements (evaluate-source-replacement-specs replacement-specs
+                                                            (lambda (old url)
+                                                              (package-with-source store old url))))
+           (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 +332,21 @@ 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."
+  (map (lambda (spec)
+         (match (string-tokenize spec %not-equal)
+           ((spec url)
+            (define (replace old)
+              (proc old url))
+            (cons spec replace))
+           (x
+            (leave (G_ "invalid 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
@@ -399,6 +432,7 @@ a checkout of the Git repository at the given URL."
   ;; procedure; it is called with two arguments: the store, and a list of
   ;; things to build.
   `((with-source . ,transform-package-source)
+    (with-dependency-source . ,transform-package-inputs/source)
     (with-input  . ,transform-package-inputs)
     (with-graft  . ,transform-package-inputs/graft)
     (with-branch . ,transform-package-source-branch)
@@ -414,6 +448,8 @@ a checkout of the Git repository at the given URL."
                            rest)))))
     (list (option '("with-source") #t #f
                   (parser 'with-source))
+          (option '("with-dependency-source") #t #f
+                  (parser 'with-dependency-source))
           (option '("with-input") #t #f
                   (parser 'with-input))
           (option '("with-graft") #t #f
@@ -429,6 +465,9 @@ a checkout of the Git repository at the given URL."
   (display (G_ "
       --with-source=SOURCE
                          use SOURCE when building the corresponding package"))
+  (display (G_ "
+      --with-dependency-source=PACKAGE=SOURCE
+                         use SOURCE when building the corresponding dependency package"))
   (display (G_ "
       --with-input=PACKAGE=REPLACEMENT
                          replace dependency PACKAGE by REPLACEMENT"))
-- 
2.28.0