mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 13:58:15 -05:00
ui: 'show-manifest-transaction' tabulates upgraded package lists.
This also changes "1.0.0 → 1.0.0" to "(dependencies changed)", which is probably less confusing. * guix/ui.scm (tabulate): New procedure. (show-manifest-transaction)[upgrade-string]: Rewrite to take lists of names, versions, and outputs instead of single elements. Use 'tabulate'. Adjust callers accordingly.
This commit is contained in:
parent
cf2b91aad0
commit
3e5ab0a7a9
1 changed files with 54 additions and 11 deletions
65
guix/ui.scm
65
guix/ui.scm
|
@ -1104,6 +1104,43 @@ (define (right-arrow port)
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
"->"))))
|
"->"))))
|
||||||
|
|
||||||
|
(define* (tabulate rows #:key (initial-indent 0) (max-width 25)
|
||||||
|
(inter-column " "))
|
||||||
|
"Return a list of strings where each string is a tabulated representation of
|
||||||
|
an element of ROWS. All the ROWS must be lists of the same number of cells.
|
||||||
|
|
||||||
|
Add INITIAL-INDENT white space at the beginning of each row. Ensure that
|
||||||
|
columns are at most MAX-WIDTH characters wide. Use INTER-COLUMN as a
|
||||||
|
separator between subsequent columns."
|
||||||
|
(define column-widths
|
||||||
|
;; List of column widths.
|
||||||
|
(let loop ((rows rows)
|
||||||
|
(widths '()))
|
||||||
|
(match rows
|
||||||
|
(((? null?) ...)
|
||||||
|
(reverse widths))
|
||||||
|
(((column rest ...) ...)
|
||||||
|
(loop rest
|
||||||
|
(cons (min (apply max (map string-length column))
|
||||||
|
max-width)
|
||||||
|
widths))))))
|
||||||
|
|
||||||
|
(define indent
|
||||||
|
(make-string initial-indent #\space))
|
||||||
|
|
||||||
|
(define (string-pad-right* str len)
|
||||||
|
(if (> (string-length str) len)
|
||||||
|
str
|
||||||
|
(string-pad-right str len)))
|
||||||
|
|
||||||
|
(map (lambda (row)
|
||||||
|
(string-trim-right
|
||||||
|
(string-append indent
|
||||||
|
(string-join
|
||||||
|
(map string-pad-right* row column-widths)
|
||||||
|
inter-column))))
|
||||||
|
rows))
|
||||||
|
|
||||||
(define* (show-manifest-transaction store manifest transaction
|
(define* (show-manifest-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."
|
||||||
|
@ -1120,13 +1157,18 @@ (define (package-strings name version output item)
|
||||||
(define → ;an arrow that can be represented on stderr
|
(define → ;an arrow that can be represented on stderr
|
||||||
(right-arrow (current-error-port)))
|
(right-arrow (current-error-port)))
|
||||||
|
|
||||||
(define (upgrade-string name old-version new-version output item)
|
(define (upgrade-string names old-version new-version outputs)
|
||||||
(format #f " ~a~:[:~a~;~*~]\t~a ~a ~a\t~a"
|
(tabulate (zip (map (lambda (name output)
|
||||||
name (equal? output "out") output
|
(if (string=? output "out")
|
||||||
old-version → new-version
|
name
|
||||||
(if (package? item)
|
(string-append name ":" output)))
|
||||||
(package-output store item output)
|
names outputs)
|
||||||
item)))
|
(map (lambda (old new)
|
||||||
|
(if (string=? old new)
|
||||||
|
(G_ "(dependencies changed)")
|
||||||
|
(string-append old " " → " " new)))
|
||||||
|
old-version new-version))
|
||||||
|
#:initial-indent 3))
|
||||||
|
|
||||||
(let-values (((remove install upgrade downgrade)
|
(let-values (((remove install upgrade downgrade)
|
||||||
(manifest-transaction-effects manifest transaction)))
|
(manifest-transaction-effects manifest transaction)))
|
||||||
|
@ -1150,8 +1192,8 @@ (define (upgrade-string name old-version new-version output item)
|
||||||
(((($ <manifest-entry> name old-version)
|
(((($ <manifest-entry> name old-version)
|
||||||
. ($ <manifest-entry> _ new-version output item)) ..1)
|
. ($ <manifest-entry> _ new-version output item)) ..1)
|
||||||
(let ((len (length name))
|
(let ((len (length name))
|
||||||
(downgrade (map upgrade-string
|
(downgrade (upgrade-string name old-version new-version
|
||||||
name old-version new-version output item)))
|
output)))
|
||||||
(if dry-run?
|
(if dry-run?
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
(N_ "The following package would be downgraded:~%~{~a~%~}~%"
|
(N_ "The following package would be downgraded:~%~{~a~%~}~%"
|
||||||
|
@ -1168,8 +1210,9 @@ (define (upgrade-string name old-version new-version output item)
|
||||||
(((($ <manifest-entry> name old-version)
|
(((($ <manifest-entry> name old-version)
|
||||||
. ($ <manifest-entry> _ new-version output item)) ..1)
|
. ($ <manifest-entry> _ new-version output item)) ..1)
|
||||||
(let ((len (length name))
|
(let ((len (length name))
|
||||||
(upgrade (map upgrade-string
|
(upgrade (upgrade-string name
|
||||||
name old-version new-version output item)))
|
old-version new-version
|
||||||
|
output)))
|
||||||
(if dry-run?
|
(if dry-run?
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
(N_ "The following package would be upgraded:~%~{~a~%~}~%"
|
(N_ "The following package would be upgraded:~%~{~a~%~}~%"
|
||||||
|
|
Loading…
Reference in a new issue