* 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(-)
Toggle diff (135 lines)
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
