| Message ID | 20220311213418.12472-3-ludo@gnu.org |
|---|---|
| State | Accepted |
| Headers | show |
| Series | Add 'guix home extension-graph' and 'shepherd-graph' | 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-03-11 22:34, Ludovic Courtès wrote: > Until now these two actions were silently ignored. > > * guix/scripts/home.scm (show-help, %options): Add "--graph-backend". > (%default-options): Add 'graph-backend' key. > (export-extension-graph, export-shepherd-graph): New procedures. > (perform-action): Add #:graph-backend parameter. Add cases for the > 'extension-graph' and 'shepherd-graph' actions. > (process-action): Pass #:graph-backend to 'perform-action'. > * guix/scripts/system.scm (service-node-type) > (shepherd-service-node-type): Export > * tests/guix-home.sh: Add tests. > * doc/guix.texi (Invoking guix home): Document it. > --- > doc/guix.texi | 31 +++++++++++ > guix/scripts/home.scm | 117 ++++++++++++++++++++++++++++++---------- > guix/scripts/system.scm | 5 +- > tests/guix-home.sh | 8 +++ > 4 files changed, 131 insertions(+), 30 deletions(-) > > diff --git a/doc/guix.texi b/doc/guix.texi > index 4b71fb7010..e7d862f5be 100644 > --- a/doc/guix.texi > +++ b/doc/guix.texi > @@ -38848,7 +38848,38 @@ environment. Note that not every home service that exists is supported > $ guix home import ~/guix-config > guix home: '/home/alice/guix-config' populated with all the Home configuration files > @end example > +@end table > > +And there's more! @command{guix home} also provides the follow s/follow/following > +sub-commands to visualize how the services of your home environment > +relate to one another: > + > +@table @code > +@cindex service extension graph, of a home environment > +@item extension-graph > +Emit to standard output the @dfn{service extension graph} of the home > +environment defined in @var{file} (@pxref{Service Composition}, for more > +information on service extensions). By default the output is in > +Dot/Graphviz format, but you can choose a different format with > +@option{--graph-backend}, as with @command{guix graph} (@pxref{Invoking > +guix graph, @option{--backend}}): > + > +The command: > + > +@example > +$ guix home extension-graph @var{file} | xdot - > +@end example > + > +shows the extension relations among services. > + > +@cindex Shepherd dependency graph, for a home environment > +@item shepherd-graph > +Emit to standard output the @dfn{dependency graph} of shepherd services > +of the home environment defined in @var{file}. @xref{Shepherd > +Services}, for more information and for an example graph. > + > +Again, the default output format is Dot/Graphviz, but you can pass > +@option{--graph-backend} to select a different one. > @end table > > @var{options} can contain any of the common build options (@pxref{Common > diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm > index 837fd96361..db98a1df48 100644 > --- a/guix/scripts/home.scm > +++ b/guix/scripts/home.scm > @@ -3,6 +3,7 @@ > ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> > ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com> > ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> > +;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -25,6 +26,9 @@ (define-module (guix scripts home) > #:use-module (gnu packages) > #:use-module (gnu home) > #:use-module (gnu home services) > + #:autoload (gnu home services shepherd) (home-shepherd-service-type > + home-shepherd-configuration-services > + shepherd-service-requirement) > #:use-module (guix channels) > #:use-module (guix derivations) > #:use-module (guix ui) > @@ -33,13 +37,16 @@ (define-module (guix scripts home) > #:use-module (guix profiles) > #:use-module (guix store) > #:use-module (guix utils) > + #:autoload (guix graph) (lookup-backend export-graph) > #:use-module (guix scripts) > #:use-module (guix scripts package) > #:use-module (guix scripts build) > #:autoload (guix scripts system search) (service-type->recutils) > #:use-module (guix scripts system reconfigure) > #:autoload (guix scripts pull) (channel-commit-hyperlink) > - #:use-module (guix scripts home import) > + #:autoload (guix scripts system) (service-node-type > + shepherd-service-node-type) > + #:autoload (guix scripts home import) (import-manifest) > #:use-module ((guix status) #:select (with-status-verbosity)) > #:use-module ((guix build utils) #:select (mkdir-p)) > #:use-module (guix gexp) > @@ -87,6 +94,10 @@ (define (show-help) > build build the home environment without installing anything\n")) > (display (G_ "\ > import generates a home environment definition from dotfiles\n")) > + (display (G_ "\ > + extension-graph emit the service extension graph\n")) > + (display (G_ "\ > + shepherd-graph emit the graph of shepherd services\n")) > > (show-build-options-help) > (display (G_ " > @@ -97,6 +108,9 @@ (define (show-help) > channel revisions")) > (display (G_ " > -v, --verbosity=LEVEL use the given verbosity LEVEL")) > + (display (G_ " > + --graph-backend=BACKEND > + use BACKEND for 'extension-graph' and 'shepherd-graph'")) > (newline) > (display (G_ " > -h, --help display this help and exit")) > @@ -136,6 +150,10 @@ (define %options > (alist-cons 'validate-reconfigure > warn-about-backward-reconfigure > result))) > + (option '("graph-backend") #t #f > + (lambda (opt name arg result) > + (alist-cons 'graph-backend arg result))) > + > %standard-build-options)) > > (define %default-options > @@ -147,18 +165,49 @@ (define %default-options > (multiplexed-build-output? . #t) > (verbosity . #f) ;default > (debug . 0) > - (validate-reconfigure . ,ensure-forward-reconfigure))) > + (validate-reconfigure . ,ensure-forward-reconfigure) > + (graph-backend . "graphviz"))) > > > ;;; > ;;; Actions. > ;;; > > +(define* (export-extension-graph home port > + #:key (backend (lookup-backend "graphviz"))) > + "Export the service extension graph of HOME to PORT using BACKEND." > + (let* ((services (home-environment-services home)) > + (home (find (lambda (service) > + (eq? (service-kind service) home-service-type)) > + services))) > + (export-graph (list home) (current-output-port) s/current-output-port/port > + #:backend backend > + #:node-type (service-node-type services) > + #:reverse-edges? #t))) > + > +(define* (export-shepherd-graph home port > + #:key (backend (lookup-backend "graphviz"))) > + "Export the graph of shepherd services of HOME to PORT using BACKEND." > + (let* ((services (home-environment-services home)) > + (root (fold-services services > + #:target-type home-shepherd-service-type)) > + ;; Get the list of <shepherd-service>. > + (shepherds (home-shepherd-configuration-services > + (service-value root))) > + (sinks (filter (lambda (service) > + (null? (shepherd-service-requirement service))) > + shepherds))) > + (export-graph sinks (current-output-port) s/current-output-port/port > + #:backend backend > + #:node-type (shepherd-service-node-type shepherds) > + #:reverse-edges? #t))) > + > (define* (perform-action action he > #:key > dry-run? > derivations-only? > use-substitutes? > + (graph-backend "graphviz") > (validate-reconfigure ensure-forward-reconfigure)) > "Perform ACTION for home environment. " > > @@ -169,35 +218,43 @@ (define println > (check-forward-update validate-reconfigure > #:current-channels (home-provenance %guix-home))) > > - (mlet* %store-monad > - ((he-drv (home-environment-derivation he)) > - (drvs (mapm/accumulate-builds lower-object (list he-drv))) > - (% (if derivations-only? > - (return > - (for-each (compose println derivation-file-name) drvs)) > - (built-derivations drvs))) > + (case action > + ((extension-graph) > + (export-extension-graph he (current-output-port) > + #:backend (lookup-backend graph-backend))) > + ((shepherd-graph) > + (export-shepherd-graph he (current-output-port) > + #:backend (lookup-backend graph-backend))) > + (else > + (mlet* %store-monad > + ((he-drv (home-environment-derivation he)) > + (drvs (mapm/accumulate-builds lower-object (list he-drv))) > + (% (if derivations-only? > + (return > + (for-each (compose println derivation-file-name) drvs)) > + (built-derivations drvs))) > > - (he-out-path -> (derivation->output-path he-drv))) > - (if (or dry-run? derivations-only?) > - (return #f) > - (begin > - (for-each (compose println derivation->output-path) drvs) > + (he-out-path -> (derivation->output-path he-drv))) > + (if (or dry-run? derivations-only?) > + (return #f) > + (begin > + (for-each (compose println derivation->output-path) drvs) > > - (case action > - ((reconfigure) > - (let* ((number (generation-number %guix-home)) > - (generation (generation-file-name > - %guix-home (+ 1 number)))) > + (case action > + ((reconfigure) > + (let* ((number (generation-number %guix-home)) > + (generation (generation-file-name > + %guix-home (+ 1 number)))) > > - (switch-symlinks generation he-out-path) > - (switch-symlinks %guix-home generation) > - (setenv "GUIX_NEW_HOME" he-out-path) > - (primitive-load (string-append he-out-path "/activate")) > - (setenv "GUIX_NEW_HOME" #f) > - (return he-out-path))) > - (else > - (newline) > - (return he-out-path))))))) > + (switch-symlinks generation he-out-path) > + (switch-symlinks %guix-home generation) > + (setenv "GUIX_NEW_HOME" he-out-path) > + (primitive-load (string-append he-out-path "/activate")) > + (setenv "GUIX_NEW_HOME" #f) > + (return he-out-path))) > + (else > + (newline) > + (return he-out-path))))))))) > > (define (process-action action args opts) > "Process ACTION, a sub-command, with the arguments are listed in ARGS. > @@ -256,7 +313,9 @@ (define (ensure-home-environment file-or-exp obj) > #:derivations-only? (assoc-ref opts 'derivations-only?) > #:use-substitutes? (assoc-ref opts 'substitutes?) > #:validate-reconfigure > - (assoc-ref opts 'validate-reconfigure)))))) > + (assoc-ref opts 'validate-reconfigure) > + #:graph-backend > + (assoc-ref opts 'graph-backend)))))) > (warn-about-disk-space))) > > > diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm > index 6f7dcd4643..55e9b8ba30 100644 > --- a/guix/scripts/system.scm > +++ b/guix/scripts/system.scm > @@ -88,7 +88,10 @@ (define-module (guix scripts system) > #:use-module (ice-9 match) > #:use-module (rnrs bytevectors) > #:export (guix-system > - read-operating-system)) > + read-operating-system > + > + service-node-type > + shepherd-service-node-type)) > > > ;;; > diff --git a/tests/guix-home.sh b/tests/guix-home.sh > index f054d15172..48dbcbd28f 100644 > --- a/tests/guix-home.sh > +++ b/tests/guix-home.sh > @@ -93,6 +93,14 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT > "# the content of bashrc-test-config.sh")))))))) > EOF > > + # Check whether the graph commands work as expected. > + guix home extension-graph "home.scm" | grep 'label = "home-activation"' > + guix home extension-graph "home.scm" | grep 'label = "home-symlink-manager"' > + guix home extension-graph "home.scm" | grep 'label = "home"' > + > + # There are no Shepherd services so the one below must fail. > + ! guix home shepherd-graph "home.scm" > + > guix home reconfigure "${test_directory}/home.scm" > test -d "${HOME}/.guix-home" > test -h "${HOME}/.bash_profile"
Hi Andrew, Thanks for your feedback! I incorporated your suggestions and pushed as 25261cbf96a3bf58abc6e836d71bdabe9154a83c. Ludo’.
diff --git a/doc/guix.texi b/doc/guix.texi index 4b71fb7010..e7d862f5be 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38848,7 +38848,38 @@ environment. Note that not every home service that exists is supported $ guix home import ~/guix-config guix home: '/home/alice/guix-config' populated with all the Home configuration files @end example +@end table +And there's more! @command{guix home} also provides the follow +sub-commands to visualize how the services of your home environment +relate to one another: + +@table @code +@cindex service extension graph, of a home environment +@item extension-graph +Emit to standard output the @dfn{service extension graph} of the home +environment defined in @var{file} (@pxref{Service Composition}, for more +information on service extensions). By default the output is in +Dot/Graphviz format, but you can choose a different format with +@option{--graph-backend}, as with @command{guix graph} (@pxref{Invoking +guix graph, @option{--backend}}): + +The command: + +@example +$ guix home extension-graph @var{file} | xdot - +@end example + +shows the extension relations among services. + +@cindex Shepherd dependency graph, for a home environment +@item shepherd-graph +Emit to standard output the @dfn{dependency graph} of shepherd services +of the home environment defined in @var{file}. @xref{Shepherd +Services}, for more information and for an example graph. + +Again, the default output format is Dot/Graphviz, but you can pass +@option{--graph-backend} to select a different one. @end table @var{options} can contain any of the common build options (@pxref{Common diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index 837fd96361..db98a1df48 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,9 @@ (define-module (guix scripts home) #:use-module (gnu packages) #:use-module (gnu home) #:use-module (gnu home services) + #:autoload (gnu home services shepherd) (home-shepherd-service-type + home-shepherd-configuration-services + shepherd-service-requirement) #:use-module (guix channels) #:use-module (guix derivations) #:use-module (guix ui) @@ -33,13 +37,16 @@ (define-module (guix scripts home) #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix utils) + #:autoload (guix graph) (lookup-backend export-graph) #:use-module (guix scripts) #:use-module (guix scripts package) #:use-module (guix scripts build) #:autoload (guix scripts system search) (service-type->recutils) #:use-module (guix scripts system reconfigure) #:autoload (guix scripts pull) (channel-commit-hyperlink) - #:use-module (guix scripts home import) + #:autoload (guix scripts system) (service-node-type + shepherd-service-node-type) + #:autoload (guix scripts home import) (import-manifest) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (guix gexp) @@ -87,6 +94,10 @@ (define (show-help) build build the home environment without installing anything\n")) (display (G_ "\ import generates a home environment definition from dotfiles\n")) + (display (G_ "\ + extension-graph emit the service extension graph\n")) + (display (G_ "\ + shepherd-graph emit the graph of shepherd services\n")) (show-build-options-help) (display (G_ " @@ -97,6 +108,9 @@ (define (show-help) channel revisions")) (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " + --graph-backend=BACKEND + use BACKEND for 'extension-graph' and 'shepherd-graph'")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -136,6 +150,10 @@ (define %options (alist-cons 'validate-reconfigure warn-about-backward-reconfigure result))) + (option '("graph-backend") #t #f + (lambda (opt name arg result) + (alist-cons 'graph-backend arg result))) + %standard-build-options)) (define %default-options @@ -147,18 +165,49 @@ (define %default-options (multiplexed-build-output? . #t) (verbosity . #f) ;default (debug . 0) - (validate-reconfigure . ,ensure-forward-reconfigure))) + (validate-reconfigure . ,ensure-forward-reconfigure) + (graph-backend . "graphviz"))) ;;; ;;; Actions. ;;; +(define* (export-extension-graph home port + #:key (backend (lookup-backend "graphviz"))) + "Export the service extension graph of HOME to PORT using BACKEND." + (let* ((services (home-environment-services home)) + (home (find (lambda (service) + (eq? (service-kind service) home-service-type)) + services))) + (export-graph (list home) (current-output-port) + #:backend backend + #:node-type (service-node-type services) + #:reverse-edges? #t))) + +(define* (export-shepherd-graph home port + #:key (backend (lookup-backend "graphviz"))) + "Export the graph of shepherd services of HOME to PORT using BACKEND." + (let* ((services (home-environment-services home)) + (root (fold-services services + #:target-type home-shepherd-service-type)) + ;; Get the list of <shepherd-service>. + (shepherds (home-shepherd-configuration-services + (service-value root))) + (sinks (filter (lambda (service) + (null? (shepherd-service-requirement service))) + shepherds))) + (export-graph sinks (current-output-port) + #:backend backend + #:node-type (shepherd-service-node-type shepherds) + #:reverse-edges? #t))) + (define* (perform-action action he #:key dry-run? derivations-only? use-substitutes? + (graph-backend "graphviz") (validate-reconfigure ensure-forward-reconfigure)) "Perform ACTION for home environment. " @@ -169,35 +218,43 @@ (define println (check-forward-update validate-reconfigure #:current-channels (home-provenance %guix-home))) - (mlet* %store-monad - ((he-drv (home-environment-derivation he)) - (drvs (mapm/accumulate-builds lower-object (list he-drv))) - (% (if derivations-only? - (return - (for-each (compose println derivation-file-name) drvs)) - (built-derivations drvs))) + (case action + ((extension-graph) + (export-extension-graph he (current-output-port) + #:backend (lookup-backend graph-backend))) + ((shepherd-graph) + (export-shepherd-graph he (current-output-port) + #:backend (lookup-backend graph-backend))) + (else + (mlet* %store-monad + ((he-drv (home-environment-derivation he)) + (drvs (mapm/accumulate-builds lower-object (list he-drv))) + (% (if derivations-only? + (return + (for-each (compose println derivation-file-name) drvs)) + (built-derivations drvs))) - (he-out-path -> (derivation->output-path he-drv))) - (if (or dry-run? derivations-only?) - (return #f) - (begin - (for-each (compose println derivation->output-path) drvs) + (he-out-path -> (derivation->output-path he-drv))) + (if (or dry-run? derivations-only?) + (return #f) + (begin + (for-each (compose println derivation->output-path) drvs) - (case action - ((reconfigure) - (let* ((number (generation-number %guix-home)) - (generation (generation-file-name - %guix-home (+ 1 number)))) + (case action + ((reconfigure) + (let* ((number (generation-number %guix-home)) + (generation (generation-file-name + %guix-home (+ 1 number)))) - (switch-symlinks generation he-out-path) - (switch-symlinks %guix-home generation) - (setenv "GUIX_NEW_HOME" he-out-path) - (primitive-load (string-append he-out-path "/activate")) - (setenv "GUIX_NEW_HOME" #f) - (return he-out-path))) - (else - (newline) - (return he-out-path))))))) + (switch-symlinks generation he-out-path) + (switch-symlinks %guix-home generation) + (setenv "GUIX_NEW_HOME" he-out-path) + (primitive-load (string-append he-out-path "/activate")) + (setenv "GUIX_NEW_HOME" #f) + (return he-out-path))) + (else + (newline) + (return he-out-path))))))))) (define (process-action action args opts) "Process ACTION, a sub-command, with the arguments are listed in ARGS. @@ -256,7 +313,9 @@ (define (ensure-home-environment file-or-exp obj) #:derivations-only? (assoc-ref opts 'derivations-only?) #:use-substitutes? (assoc-ref opts 'substitutes?) #:validate-reconfigure - (assoc-ref opts 'validate-reconfigure)))))) + (assoc-ref opts 'validate-reconfigure) + #:graph-backend + (assoc-ref opts 'graph-backend)))))) (warn-about-disk-space))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6f7dcd4643..55e9b8ba30 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -88,7 +88,10 @@ (define-module (guix scripts system) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:export (guix-system - read-operating-system)) + read-operating-system + + service-node-type + shepherd-service-node-type)) ;;; diff --git a/tests/guix-home.sh b/tests/guix-home.sh index f054d15172..48dbcbd28f 100644 --- a/tests/guix-home.sh +++ b/tests/guix-home.sh @@ -93,6 +93,14 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT "# the content of bashrc-test-config.sh")))))))) EOF + # Check whether the graph commands work as expected. + guix home extension-graph "home.scm" | grep 'label = "home-activation"' + guix home extension-graph "home.scm" | grep 'label = "home-symlink-manager"' + guix home extension-graph "home.scm" | grep 'label = "home"' + + # There are no Shepherd services so the one below must fail. + ! guix home shepherd-graph "home.scm" + guix home reconfigure "${test_directory}/home.scm" test -d "${HOME}/.guix-home" test -h "${HOME}/.bash_profile"