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(+)
@@ -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