[bug#67172] [PATCH 0/2] Turning <gexp-input> into lowerable objects

[bug#67172] [PATCH 0/2] Turning <gexp-input> into lowerable objects

[Ludovic Courtès]

Hello there!

These patches address a long-standing issue with gexps: the gexp
writer has full control over the type of references used in the gexp
(they get to choose between ‘ungexp’ and ‘ungexp-native’, they also
choose which output of the file-like to refer to), but whoever passes
a value that ends up in the gexp has no power over the type of
reference.

The goal here is to provide a more control over that, as shown in
this manual excerpt added here:

--8<---------------cut here---------------start------------->8---
-- Procedure: gexp-input OBJ [OUTPUT] [#:native? #f]
     Return a “gexp input” record for the given OUTPUT of file-like
     object OBJ, with ‘#:native?’ determining whether this is a native
     reference (as with ‘ungexp-native’) or not.

     This procedure is helpful when you want to pass a reference to a
     specific output of an object to some procedure that may not know
     about that output.  For example, assume you have this procedure,
     which takes one file-like object:

          (define (make-symlink target)
            (computed-file "the-symlink"
                           #~(symlink #$target #$output)))

     Here ‘make-symlink’ can only ever refer to the default output of
     TARGET—the ‘"out"’ output (*note Packages with Multiple Outputs::).
     To have it refer to, say, the ‘"lib"’ output of the ‘hwloc’
     package, you can call it like so:

          (make-symlink (gexp-input hwloc "lib"))

     You can also compose it like any other file-like object:

          (make-symlink
            (file-append (gexp-input hwloc "lib") "/lib/libhwloc.so"))
--8<---------------cut here---------------end--------------->8---

Thoughts?

Ludo’.

Ludovic Courtès (2):
  gexp: Add compiler for <gexp-input>.
  gexp: #:references-graphs accepts and honors <gexp-input> records.

 doc/guix.texi  | 45 ++++++++++++++++++++++++++++++++++++----
 guix/gexp.scm  | 31 +++++++++++++++++++++++-----
 tests/gexp.scm | 56 +++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 122 insertions(+), 10 deletions(-)


base-commit: 08d94fe20eca47b69678b3eced8749dd02c700a4
-- 
2.41.0

[bug#67172] [PATCH 1/2] gexp: Add compiler for <gexp-input>.

[Ludovic Courtès]

* guix/gexp.scm (gexp-input-compiler): New procedure.
* tests/gexp.scm ("gexp references non-existent output")
("gexp-input, as first-class input"): New tests.
* doc/guix.texi (G-Expressions): Document it.

Change-Id: I95b58d6e4d77a54364026b4324fbb00125a9402e
---
 doc/guix.texi  | 38 ++++++++++++++++++++++++++++++++++++++
 guix/gexp.scm  | 19 ++++++++++++++++++-
 tests/gexp.scm | 26 +++++++++++++++++++++++++-
 3 files changed, 81 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 9f06f1c325..8492f0ada3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12096,6 +12096,11 @@ G-Expressions
 @var{output} of @var{obj}---this is useful when @var{obj} produces
 multiple outputs (@pxref{Packages with Multiple Outputs}).
 
+Sometimes a gexp unconditionally refers to the @code{"out"} output, but
+the user of that gexp would still like to insert a reference to another
+output.  The @code{gexp-input} procedure aims to address that.
+@xref{gexp-input}.
+
 @item #+@var{obj}
 @itemx #+@var{obj}:output
 @itemx (ungexp-native @var{obj})
@@ -12489,6 +12494,39 @@ G-Expressions
 of Coreutils, regardless of the current value of @code{%current-system}.
 @end defmac
 
+@anchor{gexp-input}
+@deffn {Procedure} gexp-input @var{obj} [@var{output}] [#:native? #f]
+Return a @dfn{gexp input} record for the given @var{output} of file-like
+object @var{obj}, with @code{#:native?} determining whether this is a
+native reference (as with @code{ungexp-native}) or not.
+
+This procedure is helpful when you want to pass a reference to a
+specific output of an object to some procedure that may not know about
+that output.  For example, assume you have this procedure, which takes
+one file-like object:
+
+@lisp
+(define (make-symlink target)
+  (computed-file "the-symlink"
+                 #~(symlink #$target #$output)))
+@end lisp
+
+Here @code{make-symlink} can only ever refer to the default output of
+@var{target}---the @code{"out"} output (@pxref{Packages with Multiple
+Outputs}).  To have it refer to, say, the @code{"lib"} output of the
+@code{hwloc} package, you can call it like so:
+
+@lisp
+(make-symlink (gexp-input hwloc "lib"))
+@end lisp
+
+You can also compose it like any other file-like object:
+
+@lisp
+(make-symlink
+  (file-append (gexp-input hwloc "lib") "/lib/libhwloc.so"))
+@end lisp
+@end deffn
 
 Of course, in addition to gexps embedded in ``host'' code, there are
 also modules containing build tools.  To make it clear that they are
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 0fe4f1c98a..a7f4256d24 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -775,6 +775,23 @@ (define* (gexp-input thing                        ;convenience procedure
 whether this should be considered a \"native\" input or not."
   (%gexp-input thing output native?))
 
+;; Allow <gexp-input>s to be used within gexps.  This is useful when willing
+;; to force a specific reference to an object, as in (gexp-input hwloc "bin"),
+;; which forces a reference to the "bin" output of 'hwloc' instead of leaving
+;; it up to the recipient to pick the right output.
+(define-gexp-compiler gexp-input-compiler <gexp-input>
+  compiler => (lambda (obj system target)
+                (match obj
+                  (($ <gexp-input> thing output native?)
+                   (lower-object thing system
+                                 #:target (and (not native?) target)))))
+  expander => (lambda (obj lowered output/ignored)
+                (match obj
+                  (($ <gexp-input> thing output native?)
+                   (let ((expand (or (lookup-expander thing)
+                                     (lookup-expander lowered))))
+                     (expand thing lowered output))))))
+
 ;; Reference to one of the derivation's outputs, for gexps used in
 ;; derivations.
 (define-record-type <gexp-output>
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 7a90f8dcbf..a3147405d7 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -393,6 +393,30 @@ (define %extension-package
                  (list item))
          (null? (lowered-gexp-inputs lexp)))))
 
+(test-equal "gexp references non-existent output"
+  "no-default-output"
+  (guard (c ((derivation-missing-output-error? c)
+             (derivation-name (derivation-error-derivation c))))
+    (let* ((obj  (computed-file "no-default-output"
+                                #~(mkdir #$output:bar)))
+           (exp  #~(symlink #$obj #$output))
+           (drv  (run-with-store %store (lower-gexp exp))))
+      (pk 'oops! drv #f))))
+
+(test-assert "gexp-input, as first-class input"
+  ;; Insert a <gexp-input> record in a gexp as a way to specify which output
+  ;; of OBJ should be used.
+  (let* ((obj  (computed-file "foo" #~(mkdir #$output:bar)))
+         (exp  #~(list #$(gexp-input obj "bar")))
+         (drv  (run-with-store %store (lower-object obj)))
+         (item (derivation->output-path drv "bar"))
+         (lexp (run-with-store %store (lower-gexp exp))))
+    (and (match (lowered-gexp-inputs lexp)
+           ((input)
+            (eq? (derivation-input-derivation input) drv)))
+         (equal? (lowered-gexp-sexp lexp)
+                 `(list ,item)))))
+
 (test-assertm "with-parameters for %current-system"
   (mlet* %store-monad ((system -> (match (%current-system)
                                     ("aarch64-linux" "x86_64-linux")
-- 
2.41.0

[bug#67172] [PATCH 2/2] gexp: #:references-graphs accepts and honors <gexp-input> records.

[Ludovic Courtès]

* guix/gexp.scm (lower-reference-graphs)[tuple->gexp-input]: Add
‘gexp-input?’ case.
(gexp->derivation): Update docstring.
* doc/guix.texi (G-Expressions): Adjust accordingly.
* tests/gexp.scm ("references-file, non-default output"): New test.

Change-Id: I595cb75da0867ab8ab44552887dc06ed1d23315e
---
 doc/guix.texi  |  7 +++----
 guix/gexp.scm  | 12 ++++++++----
 tests/gexp.scm | 30 ++++++++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8492f0ada3..5f90ec6eb4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12213,10 +12213,9 @@ G-Expressions
 following forms:
 
 @example
-(@var{file-name} @var{package})
-(@var{file-name} @var{package} @var{output})
-(@var{file-name} @var{derivation})
-(@var{file-name} @var{derivation} @var{output})
+(@var{file-name} @var{obj})
+(@var{file-name} @var{obj} @var{output})
+(@var{file-name} @var{gexp-input})
 (@var{file-name} @var{store-item})
 @end example
 
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a7f4256d24..29819878fa 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -934,6 +934,11 @@ (define* (lower-reference-graphs graphs #:key system target)
 corresponding <derivation-input> or store item."
   (define tuple->gexp-input
     (match-lambda
+      (((? gexp-input? input))
+       ;; This case lets users specify the output of interest more
+       ;; conveniently, for instance by passing (gexp-input hwloc "lib") to
+       ;; the 'references-file' procedure.
+       input)
       ((thing)
        (%gexp-input thing "out" (not target)))
       ((thing output)
@@ -1152,10 +1157,9 @@ (define* (gexp->derivation name exp
 When REFERENCES-GRAPHS is true, it must be a list of tuples of one of the
 following forms:
 
-  (FILE-NAME PACKAGE)
-  (FILE-NAME PACKAGE OUTPUT)
-  (FILE-NAME DERIVATION)
-  (FILE-NAME DERIVATION OUTPUT)
+  (FILE-NAME OBJ)
+  (FILE-NAME OBJ OUTPUT)
+  (FILE-NAME GEXP-INPUT)
   (FILE-NAME STORE-ITEM)
 
 The right-hand-side of each element of REFERENCES-GRAPHS is automatically made
diff --git a/tests/gexp.scm b/tests/gexp.scm
index a3147405d7..481755138e 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1651,6 +1651,36 @@ (define shebang
                            read)
                          refs)))))))
 
+(test-assertm "references-file, non-default output"
+  (let* ((exp      #~(begin
+                       (mkdir #$output)
+                       (symlink #$%bootstrap-guile #$output:extra)))
+         (computed (computed-file "computed" exp
+                                  #:guile %bootstrap-guile))
+         (refs1    (references-file computed
+                                    #:guile %bootstrap-guile))
+         ;; Wrap COMPUTE in 'gexp-input' to get the "extra" output.
+         (refs2    (references-file (gexp-input computed "extra")
+                                    #:guile %bootstrap-guile)))
+    (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile))
+                         (drv1 (lower-object computed))
+                         (drv2 (lower-object refs2))
+                         (drv3 (lower-object refs1)))
+      (mbegin %store-monad
+        (built-derivations (list drv2 drv3))
+        (mlet %store-monad ((refs ((store-lift requisites)
+                                   (list (derivation->output-path
+                                          drv1 "extra")))))
+          (return
+           (and (lset= string=?
+                       (call-with-input-file (derivation->output-path drv2)
+                         read)
+                       refs)
+                (lset= string=?
+                       (call-with-input-file (derivation->output-path drv3)
+                         read)
+                       (list (derivation->output-path drv1))))))))))
+
 (test-assert "lower-object & gexp-input-error?"
   (guard (c ((gexp-input-error? c)
              (gexp-error-invalid-input c)))
-- 
2.41.0

[bug#67172] [PATCH 1/2] gexp: Add compiler for <gexp-input>.

[Maxim Cournoyer]

Hello!

Ludovic Courtès <ludo@gnu.org> writes:

> * guix/gexp.scm (gexp-input-compiler): New procedure.
> * tests/gexp.scm ("gexp references non-existent output")
> ("gexp-input, as first-class input"): New tests.
> * doc/guix.texi (G-Expressions): Document it.

This looks useful, and a summary read of the implementation looks sane
(I'm not much knowledgeable yet w.r.t. to gexp compiler/expander
though).

Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

-- 
Thanks,
Maxim

[bug#67172] [PATCH 2/2] gexp: #:references-graphs accepts and honors <gexp-input> records.

[Maxim Cournoyer]

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> * guix/gexp.scm (lower-reference-graphs)[tuple->gexp-input]: Add
> ‘gexp-input?’ case.
> (gexp->derivation): Update docstring.
> * doc/guix.texi (G-Expressions): Adjust accordingly.
> * tests/gexp.scm ("references-file, non-default output"): New test.

The test was a bit dense for me to parse, but other than that,

Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

-- 
Thanks,
Maxim

bug#67172: [PATCH 2/2] gexp: #:references-graphs accepts and honors <gexp-input> records.

[Ludovic Courtès]

Hi,

Thanks for your feedback, pushed!

  11a454f9da * gexp: #:references-graphs accepts and honors <gexp-input> records.
  d9190abbd2 * gexp: Add compiler for <gexp-input>.

Ludo’.