[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and '
From: |
Andrew Tropin |
Subject: |
[bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. |
Date: |
Thu, 17 Mar 2022 08:14:47 +0300 |
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"
--
Best regards,
Andrew Tropin
signature.asc
Description: PGP signature