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 > ;;; Copyright © 2021 Pierre Langlois > ;;; Copyright © 2021 Oleg Pykhalov > +;;; Copyright © 2022 Ludovic Courtès > ;;; > ;;; 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 . > + (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" -- Best regards, Andrew Tropin