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)

25
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,11 +215,8 @@ 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)
('dismiss
transaction)
(($ <manifest-entry> name version output (? string? path)) (($ <manifest-entry> name version output (? string? path))
(match (find-best-packages-by-name name #f) (match (find-best-packages-by-name name #f)
((pkg . rest) ((pkg . rest)
@ -232,20 +233,24 @@ non-zero relevance score."
((<) ((<)
transaction) transaction)
((=) ((=)
(let ((candidate-path (derivation->output-path (let* ((new (package->manifest-entry* pkg output)))
(package-derivation store pkg))))
;; XXX: When there are propagated inputs, assume we need to ;; XXX: When there are propagated inputs, assume we need to
;; upgrade the whole entry. ;; upgrade the whole entry.
(if (and (string=? path candidate-path) (if (and (string=? (manifest-entry-item
(lower-manifest-entry* new))
(manifest-entry-item entry))
(null? (package-propagated-inputs pkg))) (null? (package-propagated-inputs pkg)))
transaction transaction
(manifest-transaction-install-entry (manifest-transaction-install-entry
(package->manifest-entry* pkg output) new transaction)))))))))
transaction)))))))))
(() (()
(warning (G_ "package '~a' no longer exists~%") name) (warning (G_ "package '~a' no longer exists~%") name)
transaction))))) transaction)))))
(if (manifest-transaction-removal-candidate? entry transaction)
transaction
(upgrade entry)))
;;; ;;;
;;; Search paths. ;;; Search paths.