diff options
| -rw-r--r-- | guix-package.in | 70 |
1 files changed, 55 insertions, 15 deletions
diff --git a/guix-package.in b/guix-package.in index d7b1270255..ae3d2cd70e 100644 --- a/guix-package.in +++ b/guix-package.in @@ -80,13 +80,22 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ (let ((manifest (string-append profile "/manifest"))) (if (file-exists? manifest) (call-with-input-file manifest read) - '(manifest (version 0) (packages ()))))) + '(manifest (version 1) (packages ()))))) (define (manifest-packages manifest) "Return the packages listed in MANIFEST." (match manifest - (('manifest ('version 0) ('packages packages)) + (('manifest ('version 0) + ('packages ((name version output path) ...))) + (zip name version output path + (make-list (length name) '()))) + + ;; Version 1 adds a list of propagated inputs to the + ;; name/version/output/path tuples. + (('manifest ('version 1) + ('packages (packages ...))) packages) + (_ (error "unsupported manifest format" manifest)))) @@ -157,7 +166,7 @@ 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 tuples." +all of PACKAGES, a list of name/version/output/path/deps tuples." (define builder `(begin (use-modules (ice-9 pretty-print) @@ -173,17 +182,18 @@ all of PACKAGES, a list of name/version/output/path tuples." (union-build output inputs) (call-with-output-file (string-append output "/manifest") (lambda (p) - (pretty-print '(manifest (version 0) + (pretty-print '(manifest (version 1) (packages ,packages)) p)))))) (build-expression->derivation store "user-environment" (%current-system) builder - (map (match-lambda - ((name version output path) - `(,name ,path))) - packages) + (append-map (match-lambda + ((name version output path deps) + `((,name ,path) + ,@deps))) + packages) #:modules '((guix build union)))) (define (profile-number profile) @@ -260,6 +270,20 @@ matching packages." (package-name p2)))) same-location?)) +(define (input->name+path input) + "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple." + (let loop ((input input)) + (match input + ((name 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)))))) + ;;; ;;; Command-line options. @@ -419,7 +443,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (package-name->name+version name))) (match (find-packages-by-name name version) ((p) - (list name (package-version p) sub-drv (ensure-output p sub-drv))) + (list name (package-version p) sub-drv (ensure-output p sub-drv) + (package-transitive-propagated-inputs p))) ((p p* ...) (format (current-error-port) (_ "warning: ambiguous package specification `~a'~%") @@ -428,7 +453,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (_ "warning: choosing ~a from ~a~%") (package-full-name p) (location->string (package-location p))) - (list name (package-version p) sub-drv (ensure-output p sub-drv))) + (list name (package-version p) sub-drv (ensure-output p sub-drv) + (package-transitive-propagated-inputs p))) (() (leave (_ "~a: package not found~%") request))))) @@ -467,6 +493,18 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (define verbose? (assoc-ref opts 'verbose?)) (define profile (assoc-ref opts 'profile)) + (define (canonicalize-deps deps) + ;; Remove duplicate entries from DEPS, a list of propagated inputs, + ;; where each input is a name/path tuple. + (define (same? d1 d2) + (match d1 + ((_ path1) + (match d2 + ((_ path2) + (string=? path1 path2)))))) + + (delete-duplicates (map input->name+path deps) same?)) + ;; First roll back if asked to. (if (and (assoc-ref opts 'roll-back?) (not dry-run?)) (begin @@ -481,7 +519,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) opts)) (drv (filter-map (match-lambda ((name version sub-drv - (? package? package)) + (? package? package) + (deps ...)) (package-derivation (%store) package)) (_ #f)) install)) @@ -492,16 +531,17 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (package-name->name+version (store-path-package-name path)))) - `(,name ,version #f ,path))) + `(,name ,version #f ,path ()))) (_ #f)) opts) (map (lambda (tuple drv) (match tuple - ((name version sub-drv _) + ((name version sub-drv _ (deps ...)) (let ((output-path (derivation-path->output-path drv sub-drv))) - `(,name ,version ,sub-drv ,output-path))))) + `(,name ,version ,sub-drv ,output-path + ,(canonicalize-deps deps)))))) install drv))) (remove (filter-map (match-lambda (('remove . package) @@ -564,7 +604,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (manifest (profile-manifest profile)) (installed (manifest-packages manifest))) (for-each (match-lambda - ((name version output path) + ((name version output path _) (when (or (not regexp) (regexp-exec regexp name)) (format #t "~a\t~a\t~a\t~a~%" |