@@ -676,6 +676,70 @@ (define rewrite
(rewrite obj)
obj)))
+(define (transform-package-configure-flag specs)
+ "Return a procedure that, when passed a package and a flag, adds the
flag to #:configure-flags in the package's
+'arguments' field."
+ (define (package-with-configure-flag p extra-flag)
+ (package/inherit p
+ (arguments
+ (substitute-keyword-arguments (package-arguments p)
+ ((#:configure-flags list-of-flags (quote '()))
+ ;; here extra-flag takes the form (--extra-flag)
+ ;; hence it must be spliced to avoid eval errors
+ `(cons* ,@extra-flag ,list-of-flags))))))
+
+ (define (coalesce-alist alist)
+ ;; Coalesce multiple occurrences of the same key in ALIST.
+ (let loop ((alist alist)
+ (keys '())
+ (mapping vlist-null))
+ (match alist
+ (()
+ (map (lambda (key)
+ (cons key (vhash-fold* cons '() key mapping)))
+ (delete-duplicates (reverse keys))))
+ (((key . value) . rest)
+ (loop rest
+ (cons key keys)
+ (vhash-cons key value mapping))))))
+
+ (define %BUILD-SYSTEMS-WITHOUT-CONFIGURE-FLAGS
+ ;; These build systems do not have a #:configure-flags parameter
+'(android-ndk asdf/sbcl asdf/ecl asdf/source cargo channel chicken clojure
copy dub dune elm emacs go guile julia linux-module maven minetest-mod
minify node perl rakudo rebar ruby scons texlive tree-sitter trivial))
+
+ (define (build-system-supports-flags? spec)
+ ;; XXX: a more sophisticated approach could be added that checks the
given build system for a configure-flags option
+ ;; if a new build system is added, it needs to be added to the
%BUILD-SYSTEMS-WITHOUT-CONFIGURE-FLAGS list manually
+ (not (member (build-system-name (package-build-system spec))
+ %BUILD-SYSTEMS-WITHOUT-CONFIGURE-FLAGS)))
+
+ (define cflags
+ ;; Spec/flag alist.
+ (coalesce-alist
+ (map (lambda (spec)
+ (match (string-tokenize spec %not-equal)
+ ((spec flag)
+ (cons spec flag))
+ (_
+ (raise (formatted-message
+ (G_ "~a: invalid package configure-flags
specification")
+ spec)))))
+ specs)))
+
+ (define rewrite
+ (package-input-rewriting/spec
+ (map (match-lambda
+ ((spec . flags)
+ (cons spec (cut package-with-configure-flag <> flags))))
+ cflags)))
+
+ (lambda (obj)
+ (if (and
+ (package? obj)
+ (build-system-supports-flags? obj))
* guix/transformations.scm (transform-package-configure-flag): New function, changes to %transformations and show-transformation-options-help/detailed --- guix/transformations.scm | 70 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) + (rewrite obj) + obj))) + (define (patched-source name source patches) "Return a file-like object with the given NAME that applies PATCHES to SOURCE. SOURCE must itself be a file-like object of any type, including @@ -845,6 +909,7 @@ (define %transformations (tune . ,transform-package-tuning) (with-debug-info . ,transform-package-with-debug-info) (without-tests . ,transform-package-tests) + (with-configure-flag . ,transform-package-configure-flag) (with-patch . ,transform-package-patches) (with-latest . ,transform-package-latest) (with-version . ,transform-package-version))) @@ -915,6 +980,8 @@ (define micro-architecture (parser 'with-debug-info)) (option '("without-tests") #t #f (parser 'without-tests)) + (option '("with-configure-flag") #t #f + (parser 'with-configure-flag)) (option '("with-patch") #t #f (parser 'with-patch)) (option '("with-latest") #t #f @@ -952,6 +1019,9 @@ (define (show-transformation-options-help/detailed) (display (G_ " --with-patch=PACKAGE=FILE add FILE to the list of patches of PACKAGE")) + (display (G_ " + --with-configure-flag=PACKAGE=FLAG + add FLAG to the list of #:configure-flags of PACKAGE")) (display (G_ " --with-latest=PACKAGE use the latest upstream release of PACKAGE"))