diff options
-rw-r--r-- | guix/profiles.scm | 2 | ||||
-rw-r--r-- | guix/scripts/package.scm | 73 |
2 files changed, 41 insertions, 34 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index ad9878f370..1362c4092a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -87,6 +87,7 @@ manifest-entry-search-paths manifest-entry-parent manifest-entry-properties + lower-manifest-entry manifest-pattern manifest-pattern? @@ -272,6 +273,7 @@ file name." (output -> (manifest-entry-output entry))) (return (manifest-entry (inherit entry) + ;; TODO: Lower dependencies, recursively. (item (derivation->output-path drv output)))))))) (define* (check-for-collisions manifest system #:key target) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index c7908ece6c..be2e67997e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -199,6 +199,10 @@ non-zero relevance score." (define (transaction-upgrade-entry store entry transaction) "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a <manifest-entry>." + (define (lower-manifest-entry* entry) + (run-with-store store + (lower-manifest-entry entry (%current-system)))) + (define (supersede old new) (info (G_ "package '~a' has been superseded by '~a'~%") (manifest-entry-name old) (package-name new)) @@ -211,40 +215,41 @@ non-zero relevance score." (output (manifest-entry-output old))) transaction))) - (match (if (manifest-transaction-removal-candidate? entry transaction) - 'dismiss - entry) - ('dismiss - transaction) - (($ <manifest-entry> name version output (? string? path)) - (match (find-best-packages-by-name name #f) - ((pkg . rest) - (let ((candidate-version (package-version pkg))) - (match (package-superseded pkg) - ((? package? new) - (supersede entry new)) - (#f - (case (version-compare candidate-version version) - ((>) - (manifest-transaction-install-entry - (package->manifest-entry* pkg output) - transaction)) - ((<) - transaction) - ((=) - (let ((candidate-path (derivation->output-path - (package-derivation store pkg)))) - ;; XXX: When there are propagated inputs, assume we need to - ;; upgrade the whole entry. - (if (and (string=? path candidate-path) - (null? (package-propagated-inputs pkg))) - transaction - (manifest-transaction-install-entry - (package->manifest-entry* pkg output) - transaction))))))))) - (() - (warning (G_ "package '~a' no longer exists~%") name) - transaction))))) + (define (upgrade entry) + (match entry + (($ <manifest-entry> name version output (? string? path)) + (match (find-best-packages-by-name name #f) + ((pkg . rest) + (let ((candidate-version (package-version pkg))) + (match (package-superseded pkg) + ((? package? new) + (supersede entry new)) + (#f + (case (version-compare candidate-version version) + ((>) + (manifest-transaction-install-entry + (package->manifest-entry* pkg output) + transaction)) + ((<) + transaction) + ((=) + (let* ((new (package->manifest-entry* pkg output))) + ;; XXX: When there are propagated inputs, assume we need to + ;; upgrade the whole entry. + (if (and (string=? (manifest-entry-item + (lower-manifest-entry* new)) + (manifest-entry-item entry)) + (null? (package-propagated-inputs pkg))) + transaction + (manifest-transaction-install-entry + new transaction))))))))) + (() + (warning (G_ "package '~a' no longer exists~%") name) + transaction))))) + + (if (manifest-transaction-removal-candidate? entry transaction) + transaction + (upgrade entry))) ;;; |