* [bug#54344] [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' @ 2022-03-11 21:32 Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 1/3] graph: Factorize 'lookup-backend' Ludovic Courtès 0 siblings, 1 reply; 6+ messages in thread From: Ludovic Courtès @ 2022-03-11 21:32 UTC (permalink / raw) To: 54344; +Cc: Ludovic Courtès, Andrew Tropin Hello! These patches implement ‘guix home extension-graph’ and ‘guix home shepherd-graph’, similar to what ‘guix system’ provides. Until now these two commands were silently ignored. Thoughts? Ludo’. Ludovic Courtès (3): graph: Factorize 'lookup-backend'. home: services: Export record type accessors. guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. doc/guix.texi | 31 +++++++++ gnu/home/services/shepherd.scm | 21 +++++- guix/graph.scm | 14 +++- guix/scripts/graph.scm | 9 +-- guix/scripts/home.scm | 117 +++++++++++++++++++++++++-------- guix/scripts/system.scm | 14 ++-- po/guix/POTFILES.in | 1 + tests/guix-home.sh | 8 +++ 8 files changed, 165 insertions(+), 50 deletions(-) base-commit: 5397c18157f12e9127b5a9a59b0aa5a4eb058839 -- 2.34.0 ^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#54344] [PATCH 1/3] graph: Factorize 'lookup-backend'. 2022-03-11 21:32 [bug#54344] [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' Ludovic Courtès @ 2022-03-11 21:34 ` Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 2/3] home: services: Export record type accessors Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions Ludovic Courtès 0 siblings, 2 replies; 6+ messages in thread From: Ludovic Courtès @ 2022-03-11 21:34 UTC (permalink / raw) To: 54344; +Cc: Ludovic Courtès * guix/graph.scm (lookup-backend): New procedure. * guix/scripts/graph.scm (lookup-backend): Remove. * guix/scripts/system.scm (lookup-backend): Remove. * po/guix/POTFILES.in: Add 'guix/graph.scm'. --- guix/graph.scm | 14 +++++++++++++- guix/scripts/graph.scm | 9 +-------- guix/scripts/system.scm | 9 +-------- po/guix/POTFILES.in | 1 + 4 files changed, 16 insertions(+), 17 deletions(-) diff --git a/guix/graph.scm b/guix/graph.scm index 3a1cab244b..41219ab67d 100644 --- a/guix/graph.scm +++ b/guix/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015-2016, 2020-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -22,10 +22,13 @@ (define-module (guix graph) #:use-module (guix monads) #:use-module (guix records) #:use-module (guix sets) + #:autoload (guix diagnostics) (formatted-message) + #:autoload (guix i18n) (G_) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:export (node-type @@ -47,6 +50,8 @@ (define-module (guix graph) %graph-backends %d3js-backend %graphviz-backend + lookup-backend + graph-backend? graph-backend graph-backend-name @@ -335,6 +340,13 @@ (define %graph-backends %d3js-backend %cypher-backend)) +(define (lookup-backend name) + "Return the graph backend called NAME. Raise an error if it is not found." + (or (find (lambda (backend) + (string=? (graph-backend-name backend) name)) + %graph-backends) + (raise (formatted-message (G_ "~a: unknown graph backend") name)))) + (define* (export-graph sinks port #:key reverse-edges? node-type (max-depth +inf.0) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 8943e87099..535875c858 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -429,13 +429,6 @@ (define (lookup-node-type name) %node-types) (leave (G_ "~a: unknown node type~%") name))) -(define (lookup-backend name) - "Return the graph backend called NAME. Raise an error if it is not found." - (or (find (lambda (backend) - (string=? (graph-backend-name backend) name)) - %graph-backends) - (leave (G_ "~a: unknown backend~%") name))) - (define (list-node-types) "Print the available node types along with their synopsis." (display (G_ "The available node types are:\n")) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index a6e717d52c..6f7dcd4643 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -51,7 +51,7 @@ (define-module (guix scripts system) delete-matching-generations) #:autoload (guix scripts pull) (channel-commit-hyperlink) #:autoload (guix graph) (export-graph node-type - graph-backend-name %graph-backends) + graph-backend-name lookup-backend) #:use-module (guix scripts graph) #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) @@ -887,13 +887,6 @@ (define bootcfg (register-root* (list output) gc-root)) (return output))))))))) -(define (lookup-backend name) ;TODO: factorize - "Return the graph backend called NAME. Raise an error if it is not found." - (or (find (lambda (backend) - (string=? (graph-backend-name backend) name)) - %graph-backends) - (leave (G_ "~a: unknown backend~%") name))) - (define* (export-extension-graph os port #:key (backend (lookup-backend "graphviz"))) "Export the service extension graph of OS to PORT using BACKEND." diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index d97ba8c209..49a8edfef3 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -66,6 +66,7 @@ guix/ci.scm guix/cve.scm guix/git-authenticate.scm guix/gnupg.scm +guix/graph.scm guix/lint.scm guix/scripts/download.scm guix/scripts/package.scm -- 2.34.0 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#54344] [PATCH 2/3] home: services: Export record type accessors. 2022-03-11 21:34 ` [bug#54344] [PATCH 1/3] graph: Factorize 'lookup-backend' Ludovic Courtès @ 2022-03-11 21:34 ` Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions Ludovic Courtès 1 sibling, 0 replies; 6+ messages in thread From: Ludovic Courtès @ 2022-03-11 21:34 UTC (permalink / raw) To: 54344; +Cc: Ludovic Courtès * gnu/home/services/shepherd.scm: Export <home-shepherd-configuration> accessors. Re-export <shepherd-service> accessors. --- gnu/home/services/shepherd.scm | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm index 7a9cc064bb..feff130259 100644 --- a/gnu/home/services/shepherd.scm +++ b/gnu/home/services/shepherd.scm @@ -24,12 +24,27 @@ (define-module (gnu home services shepherd) #:use-module (guix sets) #:use-module (guix gexp) #:use-module (guix records) - #:use-module (srfi srfi-1) - #:export (home-shepherd-service-type - home-shepherd-configuration) + + home-shepherd-configuration + home-shepherd-configuration? + home-shepherd-configuration-shepherd + home-shepherd-configuration-auto-start? + home-shepherd-configuration-services) #:re-export (shepherd-service + shepherd-service? + shepherd-service-documentation + shepherd-service-provision + shepherd-service-canonical-name + shepherd-service-requirement + shepherd-service-one-shot? + shepherd-service-respawn? + shepherd-service-start + shepherd-service-stop + shepherd-service-auto-start? + shepherd-service-modules + shepherd-action)) (define-record-type* <home-shepherd-configuration> -- 2.34.0 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. 2022-03-11 21:34 ` [bug#54344] [PATCH 1/3] graph: Factorize 'lookup-backend' Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 2/3] home: services: Export record type accessors Ludovic Courtès @ 2022-03-11 21:34 ` Ludovic Courtès 2022-03-17 5:14 ` Andrew Tropin 1 sibling, 1 reply; 6+ messages in thread From: Ludovic Courtès @ 2022-03-11 21:34 UTC (permalink / raw) To: 54344; +Cc: Ludovic Courtès 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 +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"))) \f ;;; ;;; 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)) \f ;;; 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" -- 2.34.0 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. 2022-03-11 21:34 ` [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions Ludovic Courtès @ 2022-03-17 5:14 ` Andrew Tropin 2022-03-18 15:11 ` bug#54344: [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' Ludovic Courtès 0 siblings, 1 reply; 6+ messages in thread From: Andrew Tropin @ 2022-03-17 5:14 UTC (permalink / raw) To: Ludovic Courtès, 54344; +Cc: Ludovic Courtès [-- Attachment #1: Type: text/plain, Size: 13687 bytes --] 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"))) > > \f > ;;; > ;;; 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)) > > \f > ;;; > 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 [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 853 bytes --] ^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#54344: [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' 2022-03-17 5:14 ` Andrew Tropin @ 2022-03-18 15:11 ` Ludovic Courtès 0 siblings, 0 replies; 6+ messages in thread From: Ludovic Courtès @ 2022-03-18 15:11 UTC (permalink / raw) To: Andrew Tropin; +Cc: 54344-done Hi Andrew, Thanks for your feedback! I incorporated your suggestions and pushed as 25261cbf96a3bf58abc6e836d71bdabe9154a83c. Ludo’. ^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2022-03-18 15:18 UTC | newest] Thread overview: 6+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2022-03-11 21:32 [bug#54344] [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 1/3] graph: Factorize 'lookup-backend' Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 2/3] home: services: Export record type accessors Ludovic Courtès 2022-03-11 21:34 ` [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions Ludovic Courtès 2022-03-17 5:14 ` Andrew Tropin 2022-03-18 15:11 ` bug#54344: [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' Ludovic Courtès
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/guix.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).