summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-24 14:08:51 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-24 15:44:45 +0100
commit3e5ab0a7a9399bb098b9ced46bf3cbf4085c6bab (patch)
tree3e06320d70b1c076375ce0928a2d31cd11a5140a
parentcf2b91aad04172b49c8716ea8c27a07d512c04f1 (diff)
downloadpatches-3e5ab0a7a9399bb098b9ced46bf3cbf4085c6bab.tar
patches-3e5ab0a7a9399bb098b9ced46bf3cbf4085c6bab.tar.gz
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.
-rw-r--r--guix/ui.scm65
1 files changed, 54 insertions, 11 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index a469494d78..2dd9ba9673 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1104,6 +1104,43 @@ replacement if PORT is not Unicode-capable."
(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
#:key dry-run?)
"Display what will/would be installed/removed from MANIFEST by TRANSACTION."
@@ -1120,13 +1157,18 @@ replacement if PORT is not Unicode-capable."
(define → ;an arrow that can be represented on stderr
(right-arrow (current-error-port)))
- (define (upgrade-string name old-version new-version output item)
- (format #f " ~a~:[:~a~;~*~]\t~a ~a ~a\t~a"
- name (equal? output "out") output
- old-version → new-version
- (if (package? item)
- (package-output store item output)
- item)))
+ (define (upgrade-string names old-version new-version outputs)
+ (tabulate (zip (map (lambda (name output)
+ (if (string=? output "out")
+ name
+ (string-append name ":" output)))
+ names outputs)
+ (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)
(manifest-transaction-effects manifest transaction)))
@@ -1150,8 +1192,8 @@ replacement if PORT is not Unicode-capable."
(((($ <manifest-entry> name old-version)
. ($ <manifest-entry> _ new-version output item)) ..1)
(let ((len (length name))
- (downgrade (map upgrade-string
- name old-version new-version output item)))
+ (downgrade (upgrade-string name old-version new-version
+ output)))
(if dry-run?
(format (current-error-port)
(N_ "The following package would be downgraded:~%~{~a~%~}~%"
@@ -1168,8 +1210,9 @@ replacement if PORT is not Unicode-capable."
(((($ <manifest-entry> name old-version)
. ($ <manifest-entry> _ new-version output item)) ..1)
(let ((len (length name))
- (upgrade (map upgrade-string
- name old-version new-version output item)))
+ (upgrade (upgrade-string name
+ old-version new-version
+ output)))
(if dry-run?
(format (current-error-port)
(N_ "The following package would be upgraded:~%~{~a~%~}~%"