summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-10-25 22:33:33 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-10-29 16:24:12 -0400
commitcc90fbbf39e310a166e356f7019036eb30d4808a (patch)
treecb60b1749a2fe13f7cbe0030488bec06292ff25b /guix
parent6726282b20918f98ba7197ea1301376f29a248af (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/environment.scm85
1 files changed, 51 insertions, 34 deletions
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