me
/
guix
Archived
1
0
Fork 0
Code

guix package: 'transaction-upgrade-entry' uses 'lower-manifest-entry'. 

* guix/profiles.scm (lower-manifest-entry): Export.
* guix/scripts/package.scm (transaction-upgrade-entry)[lower-manifest-entry*]
[upgrade]: New procedures.
Use 'lower-manifest-entry*' instead of 'package-derivation' to compute
the output file name of PKG.
master
Ludovic Courtès 2020-03-30 21:48:51 +02:00
parent df7bb43bd0
commit 190ddfe21e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guix/profiles.scm
View File

@ -87,6 +87,7 @@
manifest-entry-search-paths manifest-entry-search-paths
manifest-entry-parent manifest-entry-parent
manifest-entry-properties manifest-entry-properties
lower-manifest-entry
manifest-pattern manifest-pattern
manifest-pattern? manifest-pattern?
@ -272,6 +273,7 @@ file name."
(output -> (manifest-entry-output entry))) (output -> (manifest-entry-output entry)))
(return (manifest-entry (return (manifest-entry
(inherit entry) (inherit entry)
;; TODO: Lower dependencies, recursively.
(item (derivation->output-path drv output)))))))) (item (derivation->output-path drv output))))))))
(define* (check-for-collisions manifest system #:key target) (define* (check-for-collisions manifest system #:key target)

73
guix/scripts/package.scm
View File

@ -199,6 +199,10 @@ non-zero relevance score."
(define (transaction-upgrade-entry store entry transaction) (define (transaction-upgrade-entry store entry transaction)
"Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
<manifest-entry>." <manifest-entry>."
(define (lower-manifest-entry* entry)
(run-with-store store
(lower-manifest-entry entry (%current-system))))
(define (supersede old new) (define (supersede old new)
(info (G_ "package '~a' has been superseded by '~a'~%") (info (G_ "package '~a' has been superseded by '~a'~%")
(manifest-entry-name old) (package-name new)) (manifest-entry-name old) (package-name new))
@ -211,40 +215,41 @@ non-zero relevance score."
(output (manifest-entry-output old))) (output (manifest-entry-output old)))
transaction))) transaction)))
(match (if (manifest-transaction-removal-candidate? entry transaction) (define (upgrade entry)
'dismiss (match entry
entry) (($ <manifest-entry> name version output (? string? path))
('dismiss (match (find-best-packages-by-name name #f)
transaction) ((pkg . rest)
(($ <manifest-entry> name version output (? string? path)) (let ((candidate-version (package-version pkg)))
(match (find-best-packages-by-name name #f) (match (package-superseded pkg)
((pkg . rest) ((? package? new)
(let ((candidate-version (package-version pkg))) (supersede entry new))
(match (package-superseded pkg) (#f
((? package? new) (case (version-compare candidate-version version)
(supersede entry new)) ((>)
(#f (manifest-transaction-install-entry
(case (version-compare candidate-version version) (package->manifest-entry* pkg output)
((>) transaction))
(manifest-transaction-install-entry ((<)
(package->manifest-entry* pkg output) transaction)
transaction)) ((=)
((<) (let* ((new (package->manifest-entry* pkg output)))
transaction) ;; XXX: When there are propagated inputs, assume we need to
((=) ;; upgrade the whole entry.
(let ((candidate-path (derivation->output-path (if (and (string=? (manifest-entry-item
(package-derivation store pkg)))) (lower-manifest-entry* new))
;; XXX: When there are propagated inputs, assume we need to (manifest-entry-item entry))
;; upgrade the whole entry. (null? (package-propagated-inputs pkg)))
(if (and (string=? path candidate-path) transaction
(null? (package-propagated-inputs pkg))) (manifest-transaction-install-entry
transaction new transaction)))))))))
(manifest-transaction-install-entry (()
(package->manifest-entry* pkg output) (warning (G_ "package '~a' no longer exists~%") name)
transaction))))))))) transaction)))))
(()
(warning (G_ "package '~a' no longer exists~%") name) (if (manifest-transaction-removal-candidate? entry transaction)
transaction))))) transaction
(upgrade entry)))
;;; ;;;