01/01: guix environment: Add --ad-hoc option.

[David Thompson]

davexunit pushed a commit to branch master
in repository guix.

commit a54bd6d72dc91f649fb2b6cb3c612da1639d9b72
Author: David Thompson <address@hidden>
Date:   Thu May 28 08:41:04 2015 -0400

    guix environment: Add --ad-hoc option.
    
    * guix/scripts/environment.scm (%options): Add "ad-hoc" option.
      (show-help): Display help for "--ad-hoc".
      (packages+propagated-inputs): New procedure.
      (guix-environment): Create ad hoc environment when asked.
    * doc/guix.texi ("invoking guix environment"): Document it.
---
 doc/guix.texi                |   17 ++++++++++++++++-
 guix/scripts/environment.scm |   27 ++++++++++++++++++++++++---
 2 files changed, 40 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1956dbc..2d10ec9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2381,7 +2381,7 @@ the @code{#:haddock-flags} parameter.  If the file 
@code{Setup.hs} is
 not found, the build system looks for @code{Setup.lhs} instead.
 
 Which Haskell compiler is used can be specified with the @code{#:haskell}
-parameter which defaults to @code{ghc}. 
+parameter which defaults to @code{ghc}.
 @end defvr
 
 Lastly, for packages that do not need anything as sophisticated, a
@@ -3932,6 +3932,21 @@ evaluates to.
 @item -E @var{command}
 Execute @var{command} in the new environment.
 
address@hidden --ad-hoc
+Include all specified packages in the resulting environment, as if an
address@hidden hoc} package were defined with them as inputs.  This option is
+useful for quickly creating an environment without having to write a
+package expression to contain the desired inputs.
+
+For instance, the command:
+
address@hidden
+guix environment --ad-hoc guile guile-sdl -E guile
address@hidden example
+
+runs @command{guile} in an environment where Guile and Guile-SDL are
+available.
+
 @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 d053daf..4217809 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014 David Thompson <address@hidden>
+;;; Copyright © 2014, 2015 David Thompson <address@hidden>
 ;;; Copyright © 2015 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -103,6 +103,9 @@ shell command in that environment.\n"))
   (display (_ "
   -E, --exec=COMMAND     execute COMMAND in new environment"))
   (display (_ "
+      --ad-hoc           include all specified packages in the environment 
instead
+                         of only their inputs"))
+  (display (_ "
       --pure             unset existing environment variables"))
   (display (_ "
       --search-paths     display needed environment variable definitions"))
@@ -147,6 +150,9 @@ shell command in that environment.\n"))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
+         (option '("ad-hoc") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'ad-hoc? #t result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
@@ -191,6 +197,18 @@ packages."
   (delete-duplicates
    (append-map transitive-inputs packages)))
 
+(define (packages+propagated-inputs packages)
+  "Return a list containing PACKAGES plus all of their propagated inputs."
+  (delete-duplicates
+   (append packages
+           (map (match-lambda
+                  ((or (_ (? package? package))
+                       (_ (? package? package) _))
+                   package)
+                  (_ #f))
+                (append-map package-transitive-propagated-inputs
+                            packages)))))
+
 (define (build-inputs inputs opts)
   "Build the packages in INPUTS using the build options in OPTS."
   (let ((substitutes? (assoc-ref opts 'substitutes?))
@@ -218,9 +236,12 @@ packages."
       (let* ((opts  (parse-command-line args %options (list %default-options)
                                         #:argument-handler handle-argument))
              (pure? (assoc-ref opts 'pure))
+             (ad-hoc? (assoc-ref opts 'ad-hoc?))
              (command (assoc-ref opts 'exec))
-             (inputs (packages->transitive-inputs
-                      (pick-all (options/resolve-packages opts) 'package)))
+             (packages (pick-all (options/resolve-packages opts) 'package))
+             (inputs (if ad-hoc?
+                         (packages+propagated-inputs packages)
+                         (packages->transitive-inputs packages)))
              (drvs (run-with-store store
                      (mbegin %store-monad
                        (set-guile-for-build (default-guile))