Subject: [bug#62551] Added new transformation option: --with-configure-flag

From: Sarthak Shah <[email-masked]>
Date: Fri, 31 Mar 2023 01:22:41 +0530

This patch adds a new transformation option that lets the user specify a
package to add an extra #:configure-flags value to. Functionally, it is
quite similar to the --with-patch transform.
Currently, I've generated a list of build systems that do not support
#:configure-flags that this transform checks against, but this could be
improved by making the transform check if any given transform has the
#:configure-flags keyword in its arguments.
Please test this patch if possible; my preliminary testing indicates that
it is working, however it could fail for edge cases I have not considered.
CCing Ludovic as he might be interested in this.

---
 guix/transformations.scm | 70 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

diff --git a/guix/transformations.scm b/guix/transformations.scm
index 8ff472ad21..8f260807dc 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -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))
+        (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"))
-- 
2.40.0