From cc90fbbf39e310a166e356f7019036eb30d4808a Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 25 Oct 2015 22:33:33 -0400 Subject: [PATCH] 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. --- doc/guix.texi | 20 +++++++++ guix/scripts/environment.scm | 85 +++++++++++++++++++++--------------- tests/guix-environment.sh | 14 ++++++ 3 files changed, 85 insertions(+), 34 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 844f9fa75d..6b6e937c6d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4699,6 +4699,20 @@ NumPy: guix environment --ad-hoc python2-numpy python-2.7 -- python @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 possible, for maximal purity and reproducibility. In particular, when 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 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 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 1d21a768dc..188838574f 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -166,6 +166,16 @@ COMMAND or an interactive shell in that environment.\n")) (max-silent-time . 3600) (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 ;; Specification of the command-line options. (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))) (option '(#\l "load") #t #f (lambda (opt name arg result) - (alist-cons 'load arg result))) + (alist-cons 'load + (tag-package-arg result arg) + result))) (option '(#\e "expression") #t #f (lambda (opt name arg result) - (alist-cons 'expression arg result))) + (alist-cons 'expression + (tag-package-arg result arg) + result))) (option '("ad-hoc") #f #f (lambda (opt name arg result) (alist-cons 'ad-hoc? #t result))) @@ -232,29 +246,34 @@ COMMAND or an interactive shell in that environment.\n")) (_ memo))) '() alist)) +(define (compact lst) + "Remove all #f elements from LST." + (filter identity lst)) + (define (options/resolve-packages opts) "Return OPTS with package specification strings replaced by actual packages." - (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) + (compact + (append-map (match-lambda + (('package mode (? string? spec)) + (let-values (((package output) + (specification->package+output spec))) + (list (list mode package output)))) + (('expression mode str) + ;; Add all the outputs of the package STR evaluates to. + (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) - `(package ,package ,output)) - (package-outputs package))))) - (('load . file) - ;; Add all the outputs of the package defined in FILE. - (let ((package (load* file (make-user-module '())))) - (map (lambda (output) - `(package ,package ,output)) - (package-outputs package)))) - (opt (list opt))) - opts)) + (list mode package output)) + (package-outputs package)))) + (_ '(#f))) + opts))) (define (build-inputs inputs opts) "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) "Parse the list of command line arguments ARGS." (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 operands. @@ -420,22 +439,20 @@ Otherwise, return the derivation for the Bash package." (pure? (assoc-ref opts 'pure)) (container? (assoc-ref opts 'container?)) (network? (assoc-ref opts 'network?)) - (ad-hoc? (assoc-ref opts 'ad-hoc?)) (bootstrap? (assoc-ref opts 'bootstrap?)) (system (assoc-ref opts 'system)) (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)) - (inputs (if ad-hoc? - (append-map (match-lambda - ((package output) - (package+propagated-inputs package - output))) - packages) - (append-map (compose bag-transitive-inputs - package->bag - first) - packages))) + (inputs (delete-duplicates + (append-map (match-lambda + (('ad-hoc-package package output) + (package+propagated-inputs package + output)) + (('package package output) + (bag-transitive-inputs + (package->bag package)))) + packages))) (paths (delete-duplicates (cons $PATH (append-map (match-lambda diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index f91c78a801..49b3b1ccc3 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -97,4 +97,18 @@ then # Make sure the "debug" output is not listed. 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