04/07: environment: For --ad-hoc, allow users to specify an output.

[Ludovic Courtès]

civodul pushed a commit to branch wip-environment
in repository guix.

commit 321553083e8d9239540f52c17d450536ad449903
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jun 30 23:16:42 2015 +0200

    environment: For --ad-hoc, allow users to specify an output.
    
    * guix/scripts/environment.scm (package+propagated-inputs): Add 'output'
      parameter.  Use it in return value.
      (options/resolve-packages): Use 'append-map' instead of 'map'.  For 'load'
      and 'expression', return all the outputs of the resulting package.  For
      'package', use 'specification->package+output' instead of
      'specification->package'.
      (guix-environment): Adjust uses of PACKAGES accordingly.
    * doc/guix.texi (Invoking guix environment): Document it.
    * tests/guix-environment.sh: Add test for --ad-hoc guile-bootstrap:out.
---
 doc/guix.texi                |    5 ++++
 guix/scripts/environment.scm |   47 +++++++++++++++++++++++++++--------------
 tests/guix-environment.sh    |    3 ++
 3 files changed, 39 insertions(+), 16 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 71167df..119c2d9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4211,6 +4211,11 @@ guix environment --ad-hoc guile guile-sdl -E guile
 runs @command{guile} in an environment where Guile and Guile-SDL are
 available.
 
+Note that this example implicitly asks for the default output of
address@hidden and @code{guile-sdl} but it is possible to ask for a
+specific output---e.g., @code{glib:bin} asks for the @code{bin} output
+of @code{glib} (@pxref{Packages with Multiple Outputs}).
+
 @item --pure
 Unset existing environment variables when building the new environment.
 This has the effect of creating an environment in which search paths
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 7a7664a..c0a7da1 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -32,6 +32,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (srfi srfi-98)
@@ -91,9 +92,9 @@ existing environment variables with additional search paths."
                (newline)))
             (evaluate-input-search-paths inputs search-paths)))
 
-(define (package+propagated-inputs package)
-  "Return the union of PACKAGE and its transitive propagated inputs."
-  `((,(package-name package) ,package)
+(define (package+propagated-inputs package output)
+  "Return the union of PACKAGE's OUTPUT and its transitive propagated inputs."
+  `((,(package-name package) ,package ,output)
     ,@(package-transitive-propagated-inputs package)))
 
 (define (show-help)
@@ -185,17 +186,26 @@ shell command in that environment.\n"))
 (define (options/resolve-packages opts)
   "Return OPTS with package specification strings replaced by actual
 packages."
-  (map (match-lambda
-        (('package . (? string? spec))
-         `(package . ,(specification->package spec)))
-        (('expression . str)
-         (match (read/eval str)
-           ((? package? p)
-            `(package . ,p))))
-        (('load . file)
-         `(package . ,(load (string-append (getcwd) "/" file))))
-        (opt opt))
-       opts))
+  (append-map (match-lambda
+                (('package . (? string? spec))
+                 (let-values (((package output)
+                               (specification->package+output spec)))
+                   `((package ,package ,output))))
+                (('expression . str)
+                 ;; Add all the outputs of the package STR evaluates to.
+                 (match (read/eval str)
+                   ((? package? package)
+                    (map (lambda (output)
+                           `(package ,package ,output))
+                         (package-outputs package)))))
+                (('load . file)
+                 ;; Add all the outputs of the package defined in FILE.
+                 (let ((package (load (string-append (getcwd) "/" file))))
+                   (map (lambda (output)
+                          `(package ,package ,output))
+                        (package-outputs package))))
+                (opt (list opt)))
+              opts))
 
 (define (build-inputs inputs opts)
   "Build the derivations in INPUTS, a list of (DERIVATION) or (DERIVATION
@@ -228,9 +238,14 @@ OUTPUT) tuples, using the build options in OPTS."
            (command  (assoc-ref opts 'exec))
            (packages (pick-all (options/resolve-packages opts) 'package))
            (inputs   (if ad-hoc?
-                         (append-map package+propagated-inputs packages)
+                         (append-map (match-lambda
+                                       ((package output)
+                                        (package+propagated-inputs package
+                                                                   output)))
+                                     packages)
                          (append-map (compose bag-transitive-inputs
-                                              package->bag)
+                                              package->bag
+                                              first)
                                      packages)))
            (paths    (delete-duplicates
                       (cons $PATH
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index d04e6a6..08c97cb 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -31,11 +31,14 @@ mkdir "$tmpdir"
 
 # Check the environment variables for the bootstrap Guile.
 guix environment --ad-hoc guile-bootstrap --pure --search-paths > "$tmpdir/a"
+guix environment --ad-hoc guile-bootstrap:out --pure --search-paths > 
"$tmpdir/b"
 
 # $PATH must appear in the search paths, and nothing else.
 grep -E '^export PATH=.*guile-bootstrap-[0-9.]+/bin' "$tmpdir/a"
 test "`wc -l < "$tmpdir/a"`" = 1
 
+cmp "$tmpdir/a" "$tmpdir/b"
+
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
     # Compute the build environment for the initial GNU Make.