nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

profiles: Report about upgrades. 

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

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Alex Kost 2014-08-20 15:52:36 +04:00 committed by Ludovic Courtès
parent cc69516cdd
commit 6b74bb0ae3
1 changed files with 43 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
guix/profiles.scm
View File

@ -275,15 +275,34 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
(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 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
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~%~}~%"