Message ID | 20220712225007.23875-1-antero@mailbox.org |
---|---|
State | Accepted |
Headers | show |
Series | [bug#56428,v3] home: Add -I, --list-installed option. | expand |
Context | Check | Description |
---|---|---|
cbaines/comparison | success | View comparision |
cbaines/git-branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
On 2022-07-12 22:50, Antero Mejr wrote: > * guix/scripts/package.scm (list-installed): New procedure. > * guix/scripts/home.scm: Use it. > * guix/scripts/utils.scm (pretty-print-table): New argument "left-pad". > * doc/guix.texi (Invoking Guix Home): Add information and example for > --list-installed flag. > --- > doc/guix.texi | 15 ++++++++++++ > guix/scripts/home.scm | 52 +++++++++++++++++++++++++++++----------- > guix/scripts/package.scm | 31 ++++++++++++++---------- > guix/utils.scm | 4 ++-- > 4 files changed, 73 insertions(+), 29 deletions(-) > > diff --git a/doc/guix.texi b/doc/guix.texi > index 097e4a362b..fc3a2d962d 100644 > --- a/doc/guix.texi > +++ b/doc/guix.texi > @@ -40312,6 +40312,17 @@ install anything. > Describe the current home generation: its file name, as well as > provenance information when available. > > +To show installed packages in the current home generation's profile, > +the @code{--list-installed} flag is provided, with the same syntax that > +is used in @command{guix package --list-installed} > +(@pxref{Invoking guix package}). For instance, the following command > +shows a table of all emacs-related packages installed in the > +current home generation's profile, at the end of the description: > + > +@example > +guix home describe --list-installed=emacs > +@end example > + > @item list-generations > List a summary of each generation of the home environment available on > disk, in a human-readable way. This is similar to the > @@ -40327,6 +40338,10 @@ generations that are up to 10 days old: > $ guix home list-generations 10d > @end example > > +The @code{--list-installed} flag may also be specified, with the same > +syntax that is used in @command{guix home describe}. This may be helpful > +if trying to determine when a package was added to the home profile. > + > @item import > Generate a @dfn{home environment} from the packages in the default > profile and configuration files found in the user's home directory. The > diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm > index 0f5c3388a1..97d626114a 100644 > --- a/guix/scripts/home.scm > +++ b/guix/scripts/home.scm > @@ -4,6 +4,7 @@ > ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com> > ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> > ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> > +;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -143,6 +144,11 @@ (define (show-help) > use BACKEND for 'extension-graph' and 'shepherd-graph'")) > (newline) > (display (G_ " > + -I, --list-installed[=REGEXP] > + for 'describe' or 'list-generations', list installed > + packages matching REGEXP")) > + (newline) > + (display (G_ " > -h, --help display this help and exit")) > (display (G_ " > -V, --version display version information and exit")) > @@ -183,6 +189,9 @@ (define %options > (option '("graph-backend") #t #f > (lambda (opt name arg result) > (alist-cons 'graph-backend arg result))) > + (option '(#\I "list-installed") #f #t > + (lambda (opt name arg result) > + (alist-cons 'list-installed (or arg "") result))) > > ;; Container options. > (option '(#\N "network") #f #f > @@ -569,17 +578,20 @@ (define-syntax-rule (with-store* store exp ...) > deploy the home environment described by these files.\n") > destination)))) > ((describe) > - (match (generation-number %guix-home) > - (0 > - (leave (G_ "no home environment generation, nothing to describe~%"))) > - (generation > - (display-home-environment-generation generation)))) > + (let ((list-installed-regex (assoc-ref opts 'list-installed))) > + (match (generation-number %guix-home) > + (0 > + (leave (G_ "no home environment generation, nothing to describe~%"))) > + (generation > + (display-home-environment-generation > + generation #:list-installed-regex list-installed-regex))))) > ((list-generations) > - (let ((pattern (match args > + (let ((list-installed-regex (assoc-ref opts 'list-installed)) > + (pattern (match args > (() #f) > ((pattern) pattern) > (x (leave (G_ "wrong number of arguments~%")))))) > - (list-generations pattern))) > + (list-generations pattern #:list-installed-regex list-installed-regex))) > ((switch-generation) > (let ((pattern (match args > ((pattern) pattern) > @@ -748,7 +760,8 @@ (define (search . args) > > (define* (display-home-environment-generation > number > - #:optional (profile %guix-home)) > + #:optional (profile %guix-home) > + #:key (list-installed-regex #f)) > "Display a summary of home-environment generation NUMBER in a > human-readable format." > (define (display-channel channel) > @@ -782,9 +795,16 @@ (define-values (channels config-file) > (format #t (G_ " configuration file: ~a~%") > (if (supports-hyperlinks?) > (file-hyperlink config-file) > - config-file)))))) > - > -(define* (list-generations pattern #:optional (profile %guix-home)) > + config-file))) > + (when list-installed-regex > + (format #t (G_ " packages:\n")) > + (pretty-print-table (list-installed > + list-installed-regex > + (list (string-append generation "/profile"))) > + #:left-pad 4))))) > + > +(define* (list-generations pattern #:optional (profile %guix-home) > + #:key (list-installed-regex #f)) > "Display in a human-readable format all the home environment > generations matching PATTERN, a string. When PATTERN is #f, display > all the home environment generations." > @@ -792,14 +812,18 @@ (define* (list-generations pattern #:optional (profile %guix-home)) > (raise (condition (&profile-not-found-error > (profile profile))))) > ((not pattern) > - (for-each display-home-environment-generation (profile-generations profile))) > + (for-each (cut display-home-environment-generation <> > + #:list-installed-regex list-installed-regex) > + (profile-generations profile))) > ((matching-generations pattern profile) > => > (lambda (numbers) > (if (null-list? numbers) > (exit 1) > - (leave-on-EPIPE > - (for-each display-home-environment-generation numbers))))))) > + (leave-on-EPIPE (for-each > + (cut display-home-environment-generation <> > + #:list-installed-regex list-installed-regex) > + numbers))))))) > > > ;;; > diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm > index 99a6cfaa29..af61b50222 100644 > --- a/guix/scripts/package.scm > +++ b/guix/scripts/package.scm > @@ -11,6 +11,7 @@ > ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> > ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com> > ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> > +;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -67,6 +68,7 @@ (define-module (guix scripts package) > delete-generations > delete-matching-generations > guix-package > + list-installed > > search-path-environment-variables > manifest-entry-version-prefix > @@ -773,6 +775,20 @@ (define absolute > > (add-indirect-root store absolute)) > > +(define (list-installed regexp profiles) > + (let* ((regexp (and regexp (make-regexp* regexp regexp/icase))) > + (manifest (concatenate-manifests > + (map profile-manifest profiles))) > + (installed (manifest-entries manifest))) > + (leave-on-EPIPE > + (let ((rows (filter-map > + (match-lambda > + (($ <manifest-entry> name version output path _) > + (and (regexp-exec regexp name) > + (list name (or version "?") output path)))) > + installed))) > + rows)))) > + > > ;;; > ;;; Queries and actions. > @@ -824,19 +840,8 @@ (define (diff-profiles profile numbers) > #t) > > (('list-installed regexp) > - (let* ((regexp (and regexp (make-regexp* regexp regexp/icase))) > - (manifest (concatenate-manifests > - (map profile-manifest profiles))) > - (installed (manifest-entries manifest))) > - (leave-on-EPIPE > - (let ((rows (filter-map > - (match-lambda > - (($ <manifest-entry> name version output path _) > - (and (regexp-exec regexp name) > - (list name (or version "?") output path)))) > - installed))) > - ;; Show most recently installed packages last. > - (pretty-print-table (reverse rows))))) > + ;; Show most recently installed packages last. > + (pretty-print-table (reverse (list-installed regexp profiles))) > #t) > > (('list-available regexp) > diff --git a/guix/utils.scm b/guix/utils.scm > index 745da98a79..8484442b29 100644 > --- a/guix/utils.scm > +++ b/guix/utils.scm > @@ -1124,7 +1124,7 @@ (define* (string-closest trial tests #:key (threshold 3)) > ;;; Prettified output. > ;;; > > -(define* (pretty-print-table rows #:key (max-column-width 20)) > +(define* (pretty-print-table rows #:key (max-column-width 20) (left-pad 0)) > "Print ROWS in neat columns. All rows should be lists of strings and each > row should have the same length. The columns are separated by a tab > character, and aligned using spaces. The maximum width of each column is > @@ -1143,7 +1143,7 @@ (define* (pretty-print-table rows #:key (max-column-width 20)) > (map (cut min <> max-column-width) > column-widths))) > (fmt (string-append (string-join column-formats "\t") "\t~a"))) > - (for-each (cut format #t "~?~%" fmt <>) rows))) > + (for-each (cut format #t "~v_~?~%" left-pad fmt <>) rows))) > > ;;; Local Variables: > ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1) Applied locally, tested, LGTM.
Hi, Antero Mejr <antero@mailbox.org> skribis: > * guix/scripts/package.scm (list-installed): New procedure. > * guix/scripts/home.scm: Use it. > * guix/scripts/utils.scm (pretty-print-table): New argument "left-pad". > * doc/guix.texi (Invoking Guix Home): Add information and example for > --list-installed flag. I tweaked the wording in the manual, added a docstring to ‘list-installed’ (info "(guix) Formatting Code"), adjusted that of ‘pretty-print-table’, tweaked the commit log to list all the changes, and committed. Thanks! Ludo’.
diff --git a/doc/guix.texi b/doc/guix.texi index 097e4a362b..fc3a2d962d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -40312,6 +40312,17 @@ install anything. Describe the current home generation: its file name, as well as provenance information when available. +To show installed packages in the current home generation's profile, +the @code{--list-installed} flag is provided, with the same syntax that +is used in @command{guix package --list-installed} +(@pxref{Invoking guix package}). For instance, the following command +shows a table of all emacs-related packages installed in the +current home generation's profile, at the end of the description: + +@example +guix home describe --list-installed=emacs +@end example + @item list-generations List a summary of each generation of the home environment available on disk, in a human-readable way. This is similar to the @@ -40327,6 +40338,10 @@ generations that are up to 10 days old: $ guix home list-generations 10d @end example +The @code{--list-installed} flag may also be specified, with the same +syntax that is used in @command{guix home describe}. This may be helpful +if trying to determine when a package was added to the home profile. + @item import Generate a @dfn{home environment} from the packages in the default profile and configuration files found in the user's home directory. The diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index 0f5c3388a1..97d626114a 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -143,6 +144,11 @@ (define (show-help) use BACKEND for 'extension-graph' and 'shepherd-graph'")) (newline) (display (G_ " + -I, --list-installed[=REGEXP] + for 'describe' or 'list-generations', list installed + packages matching REGEXP")) + (newline) + (display (G_ " -h, --help display this help and exit")) (display (G_ " -V, --version display version information and exit")) @@ -183,6 +189,9 @@ (define %options (option '("graph-backend") #t #f (lambda (opt name arg result) (alist-cons 'graph-backend arg result))) + (option '(#\I "list-installed") #f #t + (lambda (opt name arg result) + (alist-cons 'list-installed (or arg "") result))) ;; Container options. (option '(#\N "network") #f #f @@ -569,17 +578,20 @@ (define-syntax-rule (with-store* store exp ...) deploy the home environment described by these files.\n") destination)))) ((describe) - (match (generation-number %guix-home) - (0 - (leave (G_ "no home environment generation, nothing to describe~%"))) - (generation - (display-home-environment-generation generation)))) + (let ((list-installed-regex (assoc-ref opts 'list-installed))) + (match (generation-number %guix-home) + (0 + (leave (G_ "no home environment generation, nothing to describe~%"))) + (generation + (display-home-environment-generation + generation #:list-installed-regex list-installed-regex))))) ((list-generations) - (let ((pattern (match args + (let ((list-installed-regex (assoc-ref opts 'list-installed)) + (pattern (match args (() #f) ((pattern) pattern) (x (leave (G_ "wrong number of arguments~%")))))) - (list-generations pattern))) + (list-generations pattern #:list-installed-regex list-installed-regex))) ((switch-generation) (let ((pattern (match args ((pattern) pattern) @@ -748,7 +760,8 @@ (define (search . args) (define* (display-home-environment-generation number - #:optional (profile %guix-home)) + #:optional (profile %guix-home) + #:key (list-installed-regex #f)) "Display a summary of home-environment generation NUMBER in a human-readable format." (define (display-channel channel) @@ -782,9 +795,16 @@ (define-values (channels config-file) (format #t (G_ " configuration file: ~a~%") (if (supports-hyperlinks?) (file-hyperlink config-file) - config-file)))))) - -(define* (list-generations pattern #:optional (profile %guix-home)) + config-file))) + (when list-installed-regex + (format #t (G_ " packages:\n")) + (pretty-print-table (list-installed + list-installed-regex + (list (string-append generation "/profile"))) + #:left-pad 4))))) + +(define* (list-generations pattern #:optional (profile %guix-home) + #:key (list-installed-regex #f)) "Display in a human-readable format all the home environment generations matching PATTERN, a string. When PATTERN is #f, display all the home environment generations." @@ -792,14 +812,18 @@ (define* (list-generations pattern #:optional (profile %guix-home)) (raise (condition (&profile-not-found-error (profile profile))))) ((not pattern) - (for-each display-home-environment-generation (profile-generations profile))) + (for-each (cut display-home-environment-generation <> + #:list-installed-regex list-installed-regex) + (profile-generations profile))) ((matching-generations pattern profile) => (lambda (numbers) (if (null-list? numbers) (exit 1) - (leave-on-EPIPE - (for-each display-home-environment-generation numbers))))))) + (leave-on-EPIPE (for-each + (cut display-home-environment-generation <> + #:list-installed-regex list-installed-regex) + numbers))))))) ;;; diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 99a6cfaa29..af61b50222 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> +;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -67,6 +68,7 @@ (define-module (guix scripts package) delete-generations delete-matching-generations guix-package + list-installed search-path-environment-variables manifest-entry-version-prefix @@ -773,6 +775,20 @@ (define absolute (add-indirect-root store absolute)) +(define (list-installed regexp profiles) + (let* ((regexp (and regexp (make-regexp* regexp regexp/icase))) + (manifest (concatenate-manifests + (map profile-manifest profiles))) + (installed (manifest-entries manifest))) + (leave-on-EPIPE + (let ((rows (filter-map + (match-lambda + (($ <manifest-entry> name version output path _) + (and (regexp-exec regexp name) + (list name (or version "?") output path)))) + installed))) + rows)))) + ;;; ;;; Queries and actions. @@ -824,19 +840,8 @@ (define (diff-profiles profile numbers) #t) (('list-installed regexp) - (let* ((regexp (and regexp (make-regexp* regexp regexp/icase))) - (manifest (concatenate-manifests - (map profile-manifest profiles))) - (installed (manifest-entries manifest))) - (leave-on-EPIPE - (let ((rows (filter-map - (match-lambda - (($ <manifest-entry> name version output path _) - (and (regexp-exec regexp name) - (list name (or version "?") output path)))) - installed))) - ;; Show most recently installed packages last. - (pretty-print-table (reverse rows))))) + ;; Show most recently installed packages last. + (pretty-print-table (reverse (list-installed regexp profiles))) #t) (('list-available regexp) diff --git a/guix/utils.scm b/guix/utils.scm index 745da98a79..8484442b29 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -1124,7 +1124,7 @@ (define* (string-closest trial tests #:key (threshold 3)) ;;; Prettified output. ;;; -(define* (pretty-print-table rows #:key (max-column-width 20)) +(define* (pretty-print-table rows #:key (max-column-width 20) (left-pad 0)) "Print ROWS in neat columns. All rows should be lists of strings and each row should have the same length. The columns are separated by a tab character, and aligned using spaces. The maximum width of each column is @@ -1143,7 +1143,7 @@ (define* (pretty-print-table rows #:key (max-column-width 20)) (map (cut min <> max-column-width) column-widths))) (fmt (string-append (string-join column-formats "\t") "\t~a"))) - (for-each (cut format #t "~?~%" fmt <>) rows))) + (for-each (cut format #t "~v_~?~%" left-pad fmt <>) rows))) ;;; Local Variables: ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)