scripts: environment: Allow mixing regular and ad-hoc packages.

This patch changes the --ad-hoc flag to be positional.  That is, the
packages that appear before --ad-hoc are interpreted as packages whose
inputs should be in the environment; the packages that appear after are
interpreted as packages to be directly added to the environment.

* guix/scripts/environment.scm (tag-package-arg, compact): New
  procedures.
  (%options): Tweak the handlers for --load and --expression options.
  (options/resolve-packages): Preserve package mode tag.
  (parse-args): Tweak argument handler to use package tagging procedure.
  (guix-environment): Apply ad-hoc behavior on a per package basis.
* tests/guix-environment.sh: Add test.
* doc/guix.texi ("invoking guix environment"): Document new behavior of
  --ad-hoc.
This commit is contained in:
David Thompson 2015-10-25 22:33:33 -04:00
parent 6726282b20
commit cc90fbbf39
3 changed files with 85 additions and 34 deletions

View File

@ -4699,6 +4699,20 @@ NumPy:
guix environment --ad-hoc python2-numpy python-2.7 -- python guix environment --ad-hoc python2-numpy python-2.7 -- python
@end example @end example
Furthermore, one might want the dependencies of a package and also some
additional packages that are not build-time or runtime dependencies, but
are useful when developing nonetheless. Because of this, the
@code{--ad-hoc} flag is positional. Packages appearing before
@code{--ad-hoc} are interpreted as packages whose dependencies will be
added to the environment. Packages appearing after are interpreted as
packages that will be added to the environment directly. For example,
the following command creates a Guix development environment that
additionally includes Git and strace:
@example
guix environment guix --ad-hoc git strace
@end example
Sometimes it is desirable to isolate the environment as much as Sometimes it is desirable to isolate the environment as much as
possible, for maximal purity and reproducibility. In particular, when possible, for maximal purity and reproducibility. In particular, when
using Guix on a host distro that is not GuixSD, it is desirable to using Guix on a host distro that is not GuixSD, it is desirable to
@ -4759,6 +4773,12 @@ Note that this example implicitly asks for the default output of
specific output---e.g., @code{glib:bin} asks for the @code{bin} output specific output---e.g., @code{glib:bin} asks for the @code{bin} output
of @code{glib} (@pxref{Packages with Multiple Outputs}). of @code{glib} (@pxref{Packages with Multiple Outputs}).
This option may be composed with the default behavior of @command{guix
environment}. Packages appearing before @code{--ad-hoc} are interpreted
as packages whose dependencies will be added to the environment, the
default behavior. Packages appearing after are interpreted as packages
that will be added to the environment directly.
@item --pure @item --pure
Unset existing environment variables when building the new environment. Unset existing environment variables when building the new environment.
This has the effect of creating an environment in which search paths This has the effect of creating an environment in which search paths

View File

@ -166,6 +166,16 @@ COMMAND or an interactive shell in that environment.\n"))
(max-silent-time . 3600) (max-silent-time . 3600)
(verbosity . 0))) (verbosity . 0)))
(define (tag-package-arg opts arg)
"Return a two-element list with the form (TAG ARG) that tags ARG with either
'ad-hoc' in OPTS has the 'ad-hoc?' key set to #t, or 'inputs' otherwise."
;; Normally, the transitive inputs to a package are added to an environment,
;; but the ad-hoc? flag changes the meaning of a package argument such that
;; the package itself is added to the environment instead.
(if (assoc-ref opts 'ad-hoc?)
`(ad-hoc-package ,arg)
`(package ,arg)))
(define %options (define %options
;; Specification of the command-line options. ;; Specification of the command-line options.
(cons* (option '(#\h "help") #f #f (cons* (option '(#\h "help") #f #f
@ -186,10 +196,14 @@ COMMAND or an interactive shell in that environment.\n"))
(alist-cons 'search-paths #t result))) (alist-cons 'search-paths #t result)))
(option '(#\l "load") #t #f (option '(#\l "load") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'load arg result))) (alist-cons 'load
(tag-package-arg result arg)
result)))
(option '(#\e "expression") #t #f (option '(#\e "expression") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'expression arg result))) (alist-cons 'expression
(tag-package-arg result arg)
result)))
(option '("ad-hoc") #f #f (option '("ad-hoc") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'ad-hoc? #t result))) (alist-cons 'ad-hoc? #t result)))
@ -232,29 +246,34 @@ COMMAND or an interactive shell in that environment.\n"))
(_ memo))) (_ memo)))
'() alist)) '() alist))
(define (compact lst)
"Remove all #f elements from LST."
(filter identity lst))
(define (options/resolve-packages opts) (define (options/resolve-packages opts)
"Return OPTS with package specification strings replaced by actual "Return OPTS with package specification strings replaced by actual
packages." packages."
(append-map (match-lambda (compact
(('package . (? string? spec)) (append-map (match-lambda
(let-values (((package output) (('package mode (? string? spec))
(specification->package+output spec))) (let-values (((package output)
`((package ,package ,output)))) (specification->package+output spec)))
(('expression . str) (list (list mode package output))))
;; Add all the outputs of the package STR evaluates to. (('expression mode str)
(match (read/eval str) ;; Add all the outputs of the package STR evaluates to.
((? package? package) (match (read/eval str)
((? package? package)
(map (lambda (output)
(list mode package output))
(package-outputs package)))))
(('load mode file)
;; Add all the outputs of the package defined in FILE.
(let ((package (load* file (make-user-module '()))))
(map (lambda (output) (map (lambda (output)
`(package ,package ,output)) (list mode package output))
(package-outputs package))))) (package-outputs package))))
(('load . file) (_ '(#f)))
;; Add all the outputs of the package defined in FILE. opts)))
(let ((package (load* file (make-user-module '()))))
(map (lambda (output)
`(package ,package ,output))
(package-outputs package))))
(opt (list opt)))
opts))
(define (build-inputs inputs opts) (define (build-inputs inputs opts)
"Build the derivations in INPUTS, a list of (DERIVATION) or (DERIVATION "Build the derivations in INPUTS, a list of (DERIVATION) or (DERIVATION
@ -402,7 +421,7 @@ Otherwise, return the derivation for the Bash package."
(define (parse-args args) (define (parse-args args)
"Parse the list of command line arguments ARGS." "Parse the list of command line arguments ARGS."
(define (handle-argument arg result) (define (handle-argument arg result)
(alist-cons 'package arg result)) (alist-cons 'package (tag-package-arg result arg) result))
;; The '--' token is used to separate the command to run from the rest of ;; The '--' token is used to separate the command to run from the rest of
;; the operands. ;; the operands.
@ -420,22 +439,20 @@ Otherwise, return the derivation for the Bash package."
(pure? (assoc-ref opts 'pure)) (pure? (assoc-ref opts 'pure))
(container? (assoc-ref opts 'container?)) (container? (assoc-ref opts 'container?))
(network? (assoc-ref opts 'network?)) (network? (assoc-ref opts 'network?))
(ad-hoc? (assoc-ref opts 'ad-hoc?))
(bootstrap? (assoc-ref opts 'bootstrap?)) (bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system)) (system (assoc-ref opts 'system))
(command (assoc-ref opts 'exec)) (command (assoc-ref opts 'exec))
(packages (pick-all (options/resolve-packages opts) 'package)) (packages (options/resolve-packages opts))
(mappings (pick-all opts 'file-system-mapping)) (mappings (pick-all opts 'file-system-mapping))
(inputs (if ad-hoc? (inputs (delete-duplicates
(append-map (match-lambda (append-map (match-lambda
((package output) (('ad-hoc-package package output)
(package+propagated-inputs package (package+propagated-inputs package
output))) output))
packages) (('package package output)
(append-map (compose bag-transitive-inputs (bag-transitive-inputs
package->bag (package->bag package))))
first) packages)))
packages)))
(paths (delete-duplicates (paths (delete-duplicates
(cons $PATH (cons $PATH
(append-map (match-lambda (append-map (match-lambda

View File

@ -97,4 +97,18 @@ then
# Make sure the "debug" output is not listed. # Make sure the "debug" output is not listed.
if grep -E "$make_boot0_debug" "$tmpdir/a"; then false; else true; fi if grep -E "$make_boot0_debug" "$tmpdir/a"; then false; else true; fi
# Compute the build environment for the initial GNU Make, but add in the
# bootstrap Guile as an ad-hoc addition.
guix environment -e '(@@ (gnu packages commencement) gnu-make-boot0)' \
--ad-hoc guile-bootstrap --no-substitutes --search-paths \
--pure > "$tmpdir/a"
# Make sure the bootstrap binaries are all listed where they belong.
cat $tmpdir/a
grep -E '^export PATH=.*-bootstrap-binaries-0/bin' "$tmpdir/a"
grep -E '^export PATH=.*-guile-bootstrap-2.0/bin' "$tmpdir/a"
grep -E '^export CPATH=.*-gcc-bootstrap-0/include' "$tmpdir/a"
grep -E '^export CPATH=.*-glibc-bootstrap-0/include' "$tmpdir/a"
grep -E '^export LIBRARY_PATH=.*-glibc-bootstrap-0/lib' "$tmpdir/a"
fi fi