From 91a89277067fd454ad77edb3a09ed06382f3694c Mon Sep 17 00:00:00 2001 From: Jesse Gibbons 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