Skip to content
Snippets Groups Projects
Commit 6b74bb0a authored by Alex Kost's avatar Alex Kost Committed by Ludovic Courtès
Browse files

profiles: Report about upgrades.


* guix/profiles.scm (manifest-show-transaction): Report about upgrades.

Signed-off-by: default avatarLudovic Courtès <ludo@gnu.org>
parent cc69516c
No related branches found
No related tags found
No related merge requests found
...@@ -275,15 +275,34 @@ (define (manifest-perform-transaction manifest transaction) ...@@ -275,15 +275,34 @@ (define (manifest-perform-transaction manifest transaction)
(define* (manifest-show-transaction store manifest transaction (define* (manifest-show-transaction store manifest transaction
#:key dry-run?) #:key dry-run?)
"Display what will/would be installed/removed from MANIFEST by TRANSACTION." "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
;; TODO: Report upgrades more clearly. (define (package-strings name version output item)
(let ((install (manifest-transaction-install transaction)) (map (lambda (name version output item)
(remove (manifest-matching-entries (format #f " ~a-~a\t~a\t~a" name version output
manifest (manifest-transaction-remove transaction)))) (if (package? item)
(package-output store item output)
item)))
name version output item))
(let* ((remove (manifest-matching-entries
manifest (manifest-transaction-remove transaction)))
(install/upgrade (manifest-transaction-install transaction))
(install '())
(upgrade (append-map
(lambda (entry)
(let ((matching
(manifest-matching-entries
manifest
(list (manifest-pattern
(name (manifest-entry-name entry))
(output (manifest-entry-output entry)))))))
(when (null? matching)
(set! install (cons entry install)))
matching))
install/upgrade)))
(match remove (match remove
((($ <manifest-entry> name version output path _) ..1) ((($ <manifest-entry> name version output item _) ..1)
(let ((len (length name)) (let ((len (length name))
(remove (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>) (remove (package-strings name version output item)))
name version output path)))
(if dry-run? (if dry-run?
(format (current-error-port) (format (current-error-port)
(N_ "The following package would be removed:~%~{~a~%~}~%" (N_ "The following package would be removed:~%~{~a~%~}~%"
...@@ -296,15 +315,26 @@ (define* (manifest-show-transaction store manifest transaction ...@@ -296,15 +315,26 @@ (define* (manifest-show-transaction store manifest transaction
len) len)
remove)))) remove))))
(_ #f)) (_ #f))
(match upgrade
((($ <manifest-entry> name version output item _) ..1)
(let ((len (length name))
(upgrade (package-strings name version output item)))
(if dry-run?
(format (current-error-port)
(N_ "The following package would be upgraded:~%~{~a~%~}~%"
"The following packages would be upgraded:~%~{~a~%~}~%"
len)
upgrade)
(format (current-error-port)
(N_ "The following package will be upgraded:~%~{~a~%~}~%"
"The following packages will be upgraded:~%~{~a~%~}~%"
len)
upgrade))))
(_ #f))
(match install (match install
((($ <manifest-entry> name version output item _) ..1) ((($ <manifest-entry> name version output item _) ..1)
(let ((len (length name)) (let ((len (length name))
(install (map (lambda (name version output item) (install (package-strings name version output item)))
(format #f " ~a-~a\t~a\t~a" name version output
(if (package? item)
(package-output store item output)
item)))
name version output item)))
(if dry-run? (if dry-run?
(format (current-error-port) (format (current-error-port)
(N_ "The following package would be installed:~%~{~a~%~}~%" (N_ "The following package would be installed:~%~{~a~%~}~%"
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment