summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/package.scm49
1 files changed, 35 insertions, 14 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 4018a34ed7..25ec63c772 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -157,6 +157,14 @@ case when generations have been deleted (there are \"holes\")."
(define (profile-derivation store packages)
"Return a derivation that builds a profile (a user environment) with
all of PACKAGES, a list of name/version/output/path/deps tuples."
+ (define packages*
+ ;; Turn any package object in PACKAGES into its output path.
+ (map (match-lambda
+ ((name version output path (deps ...))
+ `(,name ,version ,output ,path
+ ,(map input->name+path deps))))
+ packages))
+
(define builder
`(begin
(use-modules (ice-9 pretty-print)
@@ -173,16 +181,26 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(call-with-output-file (string-append output "/manifest")
(lambda (p)
(pretty-print '(manifest (version 1)
- (packages ,packages))
+ (packages ,packages*))
p))))))
+ (define ensure-valid-input
+ ;; If a package object appears in the given input, turn it into a
+ ;; derivation path.
+ (match-lambda
+ ((name (? package? p) sub-drv ...)
+ `(,name ,(package-derivation (%store) p) ,@sub-drv))
+ (input
+ input)))
+
(build-expression->derivation store "user-environment"
(%current-system)
builder
(append-map (match-lambda
((name version output path deps)
`((,name ,path)
- ,@deps)))
+ ,@(map ensure-valid-input
+ deps))))
packages)
#:modules '((guix build union))))
@@ -256,15 +274,12 @@ matching packages."
"Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
(let loop ((input input))
(match input
- ((name package)
+ ((name (? package? package))
(loop `(,name ,package "out")))
- ((name package sub-drv)
- (let*-values (((_ drv)
- (package-derivation (%store) package))
- ((out)
- (derivation-output-path
- (assoc-ref (derivation-outputs drv) sub-drv))))
- `(,name ,out))))))
+ ((name (? package? package) sub-drv)
+ `(,name ,(package-output (%store) package sub-drv)))
+ (_
+ input))))
(define %sigint-prompt
;; The prompt to jump to upon SIGINT.
@@ -619,12 +634,18 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
;; where each input is a name/path tuple.
(define (same? d1 d2)
(match d1
- ((_ path1)
+ ((_ p1)
+ (match d2
+ ((_ p2) (eq? p1 p2))
+ (_ #f)))
+ ((_ p1 out1)
(match d2
- ((_ path2)
- (string=? path1 path2))))))
+ ((_ p2 out2)
+ (and (string=? out1 out2)
+ (eq? p1 p2)))
+ (_ #f)))))
- (delete-duplicates (map input->name+path deps) same?))
+ (delete-duplicates deps same?))
(define (package->tuple p)
(let ((path (package-derivation (%store) p))