Subject: [PATCH v2 02/16] packages: Allow inputs to be plain package lists.

From: Ludovic Courtès <[email-masked]>
Date: Wed, 30 Jun 2021 22:48:18 +0200

* guix/packages.scm (add-input-label, sanitize-inputs): New procedures.
(<package>)[inputs, propagated-inputs, native-inputs]: Add 'sanitize' property.
* doc/guix.texi (Defining Packages, package Reference):
(Defining Package Variants): Adjust examples accordingly.
* tests/packages.scm ("transaction-upgrade-entry, zero upgrades, propagated inputs")
("transaction-upgrade-entry, grafts")
("package-transitive-inputs")
("package-transitive-supported-systems")
("package-closure")
("supported-package?")
("package-derivation, inputs deduplicated")
("package-transitive-native-search-paths")
("package-grafts, indirect grafts")
("package-grafts, indirect grafts, propagated inputs")
("package-grafts, same replacement twice")
("package-grafts, dependency on several outputs")
("replacement also grafted")
("package->bag, sensitivity to %current-target-system")
("package->bag, propagated inputs")
("package->bag, sensitivity to %current-system")
("package-input-rewriting/spec, identity")
("package-input-rewriting, identity"): Use the label-less input style.
---
 doc/guix.texi      | 44 +++++++++++++++++-------
 guix/packages.scm  | 35 +++++++++++++++++--
 tests/packages.scm | 86 ++++++++++++++++++++++------------------------
 3 files changed, 106 insertions(+), 59 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 53766fbec2..1659a2687a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6476,7 +6476,7 @@ package looks like this:
                 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
     (build-system gnu-build-system)
     (arguments '(#:configure-flags '("--enable-silent-rules")))
-    (inputs `(("gawk" ,gawk)))
+    (inputs (list gawk))
     (synopsis "Hello, GNU world: An example GNU package")
     (description "Guess what GNU Hello prints!")
     (home-page "https://www.gnu.org/software/hello/")
@@ -6564,8 +6564,8 @@ Reference Manual}).
 
 @item
 The @code{inputs} field specifies inputs to the build process---i.e.,
-build-time or run-time dependencies of the package.  Here, we define an
-input called @code{"gawk"} whose value is that of the @code{gawk}
+build-time or run-time dependencies of the package.  Here, we add
+an input, a reference to the @code{gawk}
 variable; @code{gawk} is itself bound to a @code{<package>} object.
 
 @cindex backquote (quasiquote)
@@ -6690,20 +6690,41 @@ list, typically containing sequential keyword-value pairs.
 @itemx @code{native-inputs} (default: @code{'()})
 @itemx @code{propagated-inputs} (default: @code{'()})
 @cindex inputs, of packages
-These fields list dependencies of the package.  Each one is a list of
-tuples, where each tuple has a label for the input (a string) as its
+These fields list dependencies of the package.  Each element of these
+lists is either a package, origin, or other ``file-like object''
+(@pxref{G-Expressions}); to specify the output of that file-like object
+that should be used, pass a two-element list where the second element is
+the output (@pxref{Packages with Multiple Outputs}, for more on package
+outputs).  For example, the list below specifies three inputs:
+
+@lisp
+(list libffi libunistring
+      `(,glib "bin"))      ;the "bin" output of GLib
+@end lisp
+
+In the example above, the @code{"out"} output of @code{libffi} and
+@code{libunistring} is used.
+
+@quotation Compatibility Note
+Until version 1.3.0, input lists were a list of tuples,
+where each tuple has a label for the input (a string) as its
 first element, a package, origin, or derivation as its second element,
 and optionally the name of the output thereof that should be used, which
-defaults to @code{"out"} (@pxref{Packages with Multiple Outputs}, for
-more on package outputs).  For example, the list below specifies three
-inputs:
+defaults to @code{"out"}.  For example, the list below is equivalent to
+the one above, but using the @dfn{old input style}:
 
 @lisp
+;; Old input style (deprecated).
 `(("libffi" ,libffi)
   ("libunistring" ,libunistring)
-  ("glib:bin" ,glib "bin"))  ;the "bin" output of Glib
+  ("glib:bin" ,glib "bin"))  ;the "bin" output of GLib
 @end lisp
 
+This style is now deprecated; it is still supported but support will be
+removed in a future version.  It should not be used for new package
+definitions.
+@end quotation
+
 @cindex cross compilation, package dependencies
 The distinction between @code{native-inputs} and @code{inputs} is
 necessary when considering cross-compilation.  When cross-compiling,
@@ -6789,7 +6810,7 @@ cross-compiling:
   ;; When cross-compiled, Guile, for example, depends on
   ;; a native version of itself.  Add it here.
   (native-inputs (if (%current-target-system)
-                     `(("self" ,this-package))
+                     (list this-package)
                      '())))
 @end lisp
 
@@ -7105,8 +7126,7 @@ depends on it:
     (name name)
     (version "3.0")
     ;; several fields omitted
-    (inputs
-     `(("lua" ,lua)))
+    (inputs (list lua))
     (synopsis "Socket library for Lua")))
 
 (define-public lua5.1-socket
diff --git a/guix/packages.scm b/guix/packages.scm
index a66dbea1b7..087e6e6a4a 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -366,6 +366,14 @@ name of its URI."
   ;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
   (fold delete %supported-systems '("mips64el-linux" "powerpc-linux")))
 
+(define-inlinable (sanitize-inputs inputs)
+  "Sanitize INPUTS by turning it into a list of name/package tuples if it's
+not already the case."
+  (cond ((null? inputs) inputs)
+        ((and (pair? (car inputs))
+              (string? (caar inputs)))
+         inputs)
+        (else (map add-input-label inputs))))
 
 ;; A package.
 (define-record-type* <package>
@@ -380,11 +388,14 @@ name of its URI."
              (default '()) (thunked))
 
   (inputs package-inputs                  ; input packages or derivations
-          (default '()) (thunked))
+          (default '()) (thunked)
+          (sanitize sanitize-inputs))
   (propagated-inputs package-propagated-inputs    ; same, but propagated
-                     (default '()) (thunked))
+                     (default '()) (thunked)
+                     (sanitize sanitize-inputs))
   (native-inputs package-native-inputs    ; native input packages/derivations
-                 (default '()) (thunked))
+                 (default '()) (thunked)
+                 (sanitize sanitize-inputs))
 
   (outputs package-outputs                ; list of strings
            (default '("out")))
@@ -415,6 +426,24 @@ name of its URI."
                             source-properties->location))
             (innate)))
 
+(define (add-input-label input)
+  "Add an input label to INPUT."
+  (match input
+    ((? package? package)
+     (list (package-name package) package))
+    (((? package? package) output)                ;XXX: ugly?
+     (list (package-name package) package output))
+    ((? gexp-input?)       ;XXX: misplaced because 'native?' field is ignored?
+     (let ((obj    (gexp-input-thing input))
+           (output (gexp-input-output input)))
+       `(,(if (package? obj)
+              (package-name obj)
+              "_")
+         ,obj
+         ,@(if (string=? output "out") '() (list output)))))
+    (x
+     `("_" ,x))))
+
 (set-record-type-printer! <package>
                           (lambda (package port)
                             (let ((loc    (package-location package))
diff --git a/tests/packages.scm b/tests/packages.scm
index 47d10af5bc..936aede4ff 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -137,7 +137,7 @@
   ;; inputs.  See <https://bugs.gnu.org/35872>.
   (let* ((dep (dummy-package "dep" (version "2")))
          (old (dummy-package "foo" (version "1")
-                             (propagated-inputs `(("dep" ,dep)))))
+                             (propagated-inputs (list dep))))
          (drv (package-derivation %store old))
          (tx  (mock ((gnu packages) find-best-packages-by-name
                      (const (list old)))
@@ -225,7 +225,7 @@
              (bar (dummy-package "bar" (version "0")
                                  (replacement old)))
              (new (dummy-package "foo" (version "1")
-                                 (inputs `(("bar" ,bar)))))
+                                 (inputs (list bar))))
              (tx  (mock ((gnu packages) find-best-packages-by-name
                          (const (list new)))
                         (transaction-upgrade-entry
@@ -275,13 +275,13 @@
 (test-assert "package-transitive-inputs"
   (let* ((a (dummy-package "a"))
          (b (dummy-package "b"
-              (propagated-inputs `(("a" ,a)))))
+              (propagated-inputs (list a))))
          (c (dummy-package "c"
-              (inputs `(("a" ,a)))))
+              (inputs (list a))))
          (d (dummy-package "d"
               (propagated-inputs `(("x" "something.drv")))))
          (e (dummy-package "e"
-              (inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
+              (inputs (list b c d)))))
     (and (null? (package-transitive-inputs a))
          (equal? `(("a" ,a)) (package-transitive-inputs b))
          (equal? `(("a" ,a)) (package-transitive-inputs c))
@@ -327,19 +327,19 @@
          (b (dummy-package "b"
               (build-system trivial-build-system)
               (supported-systems '("x" "y"))
-              (inputs `(("a" ,a)))))
+              (inputs (list a))))
          (c (dummy-package "c"
               (build-system trivial-build-system)
               (supported-systems '("y" "z"))
-              (inputs `(("b" ,b)))))
+              (inputs (list b))))
          (d (dummy-package "d"
               (build-system trivial-build-system)
               (supported-systems '("x" "y" "z"))
-              (inputs `(("b" ,b) ("c" ,c)))))
+              (inputs (list b c))))
          (e (dummy-package "e"
               (build-system trivial-build-system)
               (supported-systems '("x" "y" "z"))
-              (inputs `(("d" ,d))))))
+              (inputs (list d)))))
     (list (package-transitive-supported-systems a)
           (package-transitive-supported-systems b)
           (package-transitive-supported-systems c)
@@ -355,13 +355,13 @@
                      (build-system trivial-build-system))))))
     (let* ((a (dummy-package/no-implicit "a"))
            (b (dummy-package/no-implicit "b"
-                (propagated-inputs `(("a" ,a)))))
+                (propagated-inputs (list a))))
            (c (dummy-package/no-implicit "c"
-                (inputs `(("a" ,a)))))
+                (inputs (list a))))
            (d (dummy-package/no-implicit "d"
-                (native-inputs `(("b" ,b)))))
+                (native-inputs (list b))))
            (e (dummy-package/no-implicit "e"
-                (inputs `(("c" ,c) ("d" ,d))))))
+                (inputs (list c d)))))
       (lset= eq?
              (list a b c d e)
              (package-closure (list e))
@@ -384,12 +384,11 @@
        (u (dummy-origin))
        (i (dummy-origin))
        (a (dummy-package "a"))
-       (b (dummy-package "b"
-            (inputs `(("a" ,a) ("i" ,i)))))
+       (b (dummy-package "b" (inputs (list a i))))
        (c (package (inherit b) (source o)))
        (d (dummy-package "d"
             (build-system trivial-build-system)
-            (source u) (inputs `(("c" ,c))))))
+            (source u) (inputs (list c)))))
   (test-assert "package-direct-sources, no source"
     (null? (package-direct-sources a)))
   (test-equal "package-direct-sources, #f source"
@@ -457,7 +456,7 @@
               (supported-systems '("x86_64-linux"))))
          (p (dummy-package "foo"
               (build-system gnu-build-system)
-              (inputs `(("d" ,d)))
+              (inputs (list d))
               (supported-systems '("x86_64-linux" "armhf-linux")))))
     (and (supported-package? p "x86_64-linux")
          (not (supported-package? p "i686-linux"))
@@ -706,7 +705,7 @@
 
 (test-assert "package-derivation, inputs deduplicated"
   (let* ((dep (dummy-package "dep"))
-         (p0  (dummy-package "p" (inputs `(("dep" ,dep)))))
+         (p0  (dummy-package "p" (inputs (list dep))))
          (p1  (package (inherit p0)
                        (inputs `(("dep" ,(package (inherit dep)))
                                  ,@(package-inputs p0))))))
@@ -755,7 +754,7 @@
   (parameterize ((%graft? #f))
     (let* ((dep (dummy-package "dep"))
            (p   (dummy-package "p"
-                  (inputs `(("dep" ,dep "non-existent"))))))
+                  (inputs (list `(,dep "non-existent"))))))
       (guard (c ((derivation-missing-output-error? c)
                  (and (string=? (derivation-missing-output c) "non-existent")
                       (equal? (package-derivation %store dep)
@@ -913,12 +912,12 @@
          (p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
          (p2 (dummy-package "p2"
                (native-search-paths (sp "PATH2"))
-               (inputs `(("p0" ,p0)))
-               (propagated-inputs `(("p1" ,p1)))))
+               (inputs (list p0))
+               (propagated-inputs (list p1))))
          (p3 (dummy-package "p3"
                (native-search-paths (sp "PATH3"))
-               (native-inputs `(("p0" ,p0)))
-               (propagated-inputs `(("p2" ,p2))))))
+               (native-inputs (list p0))
+               (propagated-inputs (list p2)))))
     (lset= string=?
            '("PATH1" "PATH2" "PATH3")
            (map search-path-specification-variable
@@ -972,7 +971,7 @@
          (dep*  (package (inherit dep) (replacement new)))
          (dummy (dummy-package "dummy"
                   (arguments '(#:implicit-inputs? #f))
-                  (inputs `(("dep" ,dep*))))))
+                  (inputs (list dep*)))))
     (equal? (package-grafts %store dummy)
             (list (graft
                     (origin (package-derivation %store dep))
@@ -1004,11 +1003,11 @@
          (dep   (package (inherit new) (version "0.0")))
          (dep*  (package (inherit dep) (replacement new)))
          (prop  (dummy-package "propagated"
-                  (propagated-inputs `(("dep" ,dep*)))
+                  (propagated-inputs (list dep*))
                   (arguments '(#:implicit-inputs? #f))))
          (dummy (dummy-package "dummy"
                   (arguments '(#:implicit-inputs? #f))
-                  (inputs `(("prop" ,prop))))))
+                  (inputs (list prop)))))
     (equal? (package-grafts %store dummy)
             (list (graft
                     (origin (package-derivation %store dep))
@@ -1021,16 +1020,16 @@
          (dep  (package (inherit new) (version "0") (replacement new)))
          (p1   (dummy-package "intermediate1"
                  (arguments '(#:implicit-inputs? #f))
-                 (inputs `(("dep" ,dep)))))
+                 (inputs (list dep))))
          (p2   (dummy-package "intermediate2"
                  (arguments '(#:implicit-inputs? #f))
                  ;; Here we copy DEP to have an equivalent package that is not
                  ;; 'eq?' to DEP.  This is similar to what happens with
                  ;; 'package-with-explicit-inputs' & co.
-                 (inputs `(("dep" ,(package (inherit dep)))))))
+                 (inputs (list (package (inherit dep))))))
          (p3   (dummy-package "final"
                  (arguments '(#:implicit-inputs? #f))
-                 (inputs `(("p1" ,p1) ("p2" ,p2))))))
+                 (inputs (list p1 p2)))))
     (equal? (package-grafts %store p3)
             (list (graft
                     (origin (package-derivation %store
@@ -1048,8 +1047,7 @@
             (p0* (package (inherit p0) (version "1.1")))
             (p1  (dummy-package "p1"
                    (arguments '(#:implicit-inputs? #f))
-                   (inputs `(("p0" ,p0)
-                             ("p0:lib" ,p0 "lib"))))))
+                   (inputs (list p0 `(,p0 "lib"))))))
     (lset= equal? (pk (package-grafts %store p1))
            (list (graft
                    (origin (package-derivation %store p0))
@@ -1097,7 +1095,7 @@
                                #t)))))
          (p2r (dummy-package "P2"
                 (build-system trivial-build-system)
-                (inputs `(("p1" ,p1)))
+                (inputs (list p1))
                 (arguments
                  `(#:guile ,%bootstrap-guile
                    #:builder (let ((out (assoc-ref %outputs "out")))
@@ -1118,7 +1116,7 @@
                                #t)))))
          (p3  (dummy-package "p3"
                 (build-system trivial-build-system)
-                (inputs `(("p2" ,p2)))
+                (inputs (list p2))
                 (arguments
                  `(#:guile ,%bootstrap-guile
                    #:builder (let ((out (assoc-ref %outputs "out")))
@@ -1187,7 +1185,7 @@
                   (lower lower)))
          (dep   (dummy-package "dep" (build-system bs)))
          (pkg   (dummy-package "example"
-                  (native-inputs `(("dep" ,dep)))))
+                  (native-inputs (list dep))))
          (do-not-build (lambda (continue store lst . _) lst)))
     (equal? (with-build-handler do-not-build
               (parameterize ((%current-target-system "powerpc64le-linux-gnu")
@@ -1214,9 +1212,9 @@
 (test-assert "package->bag, propagated inputs"
   (let* ((dep    (dummy-package "dep"))
          (prop   (dummy-package "prop"
-                   (propagated-inputs `(("dep" ,dep)))))
+                   (propagated-inputs (list dep))))
          (dummy  (dummy-package "dummy"
-                   (inputs `(("prop" ,prop)))))
+                   (inputs (list prop))))
          (inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
     (match (assoc "dep" inputs)
       (("dep" package)
@@ -1229,7 +1227,7 @@
                                        `(("libxml2" ,libxml2))
                                        '()))))
          (pkg (dummy-package "foo"
-                (native-inputs `(("dep" ,dep)))))
+                (native-inputs (list dep))))
          (bag (package->bag pkg (%current-system) "i586-gnu")))
     (equal? (parameterize ((%current-system "x86_64-linux"))
               (bag-transitive-inputs bag))
@@ -1242,7 +1240,7 @@
                                        `(("libxml2" ,libxml2))
                                        '()))))
          (pkg (dummy-package "foo"
-                (native-inputs `(("dep" ,dep)))))
+                (native-inputs (list dep))))
          (bag (package->bag pkg (%current-system) "foo86-hurd")))
     (equal? (parameterize ((%current-target-system "foo64-gnu"))
               (bag-transitive-inputs bag))
@@ -1548,11 +1546,11 @@
                     (build-system trivial-build-system)))
          (glib    (dummy-package "glib"
                     (build-system trivial-build-system)
-                    (propagated-inputs `(("libffi" ,libffi)))))
+                    (propagated-inputs (list libffi))))
          (gobject (dummy-package "gobject-introspection"
                     (build-system trivial-build-system)
-                    (inputs `(("glib" ,glib)))
-                    (propagated-inputs `(("libffi" ,libffi)))))
+                    (inputs (list glib))
+                    (propagated-inputs (list libffi))))
          (rewrite (package-input-rewriting/spec
                    `(("glib" . ,identity)))))
     (and (= (length (package-transitive-inputs gobject))
@@ -1569,11 +1567,11 @@
                     (build-system trivial-build-system)))
          (glib    (dummy-package "glib"
                     (build-system trivial-build-system)
-                    (propagated-inputs `(("libffi" ,libffi)))))
+                    (propagated-inputs (list libffi))))
          (gobject (dummy-package "gobject-introspection"
                     (build-system trivial-build-system)
-                    (inputs `(("glib" ,glib)))
-                    (propagated-inputs `(("libffi" ,libffi)))))
+                    (inputs (list glib))
+                    (propagated-inputs (list libffi))))
          (rewrite (package-input-rewriting `((,glib . ,glib)))))
     (and (= (length (package-transitive-inputs gobject))
             (length (package-transitive-inputs (rewrite gobject))))
-- 
2.32.0