Subject: [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs'.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 22 Jun 2021 11:08:24 +0200

* guix/packages.scm (inputs-sans-labels, replace-input): New procedures.
(prepend, replace, modify-inputs): New macros.
* doc/guix.texi (Defining Package Variants): Document 'modify-inputs'.
---
 doc/guix.texi     | 38 ++++++++++++++++++++------
 guix/packages.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 98 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index aeb0b2160a..b16a2c48a8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7105,20 +7105,42 @@ optional dependency, you can define a variant that removes that
 dependency like so:
 
 @lisp
-(use-modules (gnu packages gdb)    ;for 'gdb'
-             (srfi srfi-1))        ;for 'alist-delete'
+(use-modules (gnu packages gdb))   ;for 'gdb'
 
 (define gdb-sans-guile
   (package
     (inherit gdb)
-    (inputs (alist-delete "guile"
-                          (package-inputs gdb)))))
+    (inputs (modify-inputs (package-inputs gdb)
+              (delete "guile")))))
 @end lisp
 
-The @code{alist-delete} call above removes the tuple from the
-@code{inputs} field that has @code{"guile"} as its first element
-(@pxref{SRFI-1 Association Lists,,, guile, GNU Guile Reference
-Manual}).
+The @code{modify-inputs} form above removes the @code{"guile"} package
+from the @code{inputs} field of @code{gdb}.  The @code{modify-inputs}
+macro is a helper that can prove useful anytime you want to remove, add,
+or replace package inputs.
+
+@deffn {Scheme Syntax} modify-inputs @var{inputs} @var{clauses}
+Modify the given package inputs, as returned by @code{package-inputs} & co.,
+according to the given clauses.  The example below removes the GMP and ACL
+inputs of Coreutils and adds libcap to the back of the input list:
+
+@lisp
+(modify-inputs (package-inputs coreutils)
+  (delete "gmp" "acl")
+  (append libcap))
+@end lisp
+
+The example below replaces the @code{guile} package from the inputs of
+@code{guile-redis} with @code{guile-2.2}:
+
+@lisp
+(modify-inputs (package-inputs guile-redis)
+  (replace "guile" guile-2.2))
+@end lisp
+
+The last type of clause is @code{prepend}, to add inputs to the front of
+the list.
+@end deffn
 
 In some cases, you may find it useful to write functions
 (``procedures'', in Scheme parlance) that return a package based on some
diff --git a/guix/packages.scm b/guix/packages.scm
index c845026827..4ac1624ce2 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -55,6 +55,7 @@
   #:re-export (%current-system
                %current-target-system
                search-path-specification)         ;for convenience
+  #:re-export-and-replace (delete)                ;used as syntactic keyword
   #:export (content-hash
             content-hash?
             content-hash-algorithm
@@ -113,6 +114,10 @@
             lookup-package-propagated-input
             lookup-package-direct-input
 
+            prepend                               ;syntactic keyword
+            replace                               ;syntactic keyword
+            modify-inputs
+
             package-direct-sources
             package-transitive-sources
             package-direct-inputs
@@ -923,6 +928,69 @@ otherwise."
 otherwise."
   (lookup-input (package-direct-inputs package) name))
 
+(define (inputs-sans-labels inputs)
+  "Return INPUTS stripped of any input labels."
+  (map (match-lambda
+         ((label obj) obj)
+         ((label obj output) `(,obj ,output)))
+       inputs))
+
+(define (replace-input name replacement inputs)
+  "Replace input NAME by REPLACEMENT within INPUTS."
+  (map (lambda (input)
+         (match input
+           (((? string? label) . _)
+            (if (string=? label name)
+                (match replacement        ;does REPLACEMENT specify an output?
+                  ((_ _) (cons label replacement))
+                  (_     (list label replacement)))
+                input))))
+       inputs))
+
+(define-syntax prepend
+  (lambda (s)
+    (syntax-violation 'prepend
+                      "'prepend' may only be used within 'modify-inputs'"
+                      s)))
+
+(define-syntax replace
+  (lambda (s)
+    (syntax-violation 'replace
+                      "'replace' may only be used within 'modify-inputs'"
+                      s)))
+
+(define-syntax modify-inputs
+  (syntax-rules (delete prepend append replace)
+    "Modify the given package inputs, as returned by 'package-inputs' & co.,
+according to the given clauses.  The example below removes the GMP and ACL
+inputs of Coreutils and adds libcap:
+
+  (modify-inputs (package-inputs coreutils)
+    (delete \"gmp\" \"acl\")
+    (append libcap))
+
+Other types of clauses include 'prepend' and 'replace'."
+    ;; Note: This macro hides the fact that INPUTS, as returned by
+    ;; 'package-inputs' & co., is actually an alist with labels.  Eventually,
+    ;; it will operate on list of inputs without labels.
+    ((_ inputs (delete name) clauses ...)
+     (modify-inputs (alist-delete name inputs)
+                    clauses ...))
+    ((_ inputs (delete names ...) clauses ...)
+     (modify-inputs (fold alist-delete inputs (list names ...))
+                    clauses ...))
+    ((_ inputs (prepend lst ...) clauses ...)
+     (modify-inputs (append (list lst ...) (inputs-sans-labels inputs))
+                    clauses ...))
+    ((_ inputs (append lst ...) clauses ...)
+     (modify-inputs (append (inputs-sans-labels inputs) (list lst ...))
+                    clauses ...))
+    ((_ inputs (replace name replacement) clauses ...)
+     (modify-inputs (replace-input name replacement inputs)
+                    clauses ...))
+    ((_ inputs)
+     inputs)))
+
 (define (package-direct-sources package)
   "Return all source origins associated with PACKAGE; including origins in
 PACKAGE's inputs."
-- 
2.32.0