guix home: Implement the 'extension-graph' and 'shepherd-graph' actions.
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.master
parent
e607c377bb
commit
25261cbf96
|
@ -38848,7 +38848,38 @@ environment. Note that not every home service that exists is supported
|
||||||
$ guix home import ~/guix-config
|
$ guix home import ~/guix-config
|
||||||
guix home: '/home/alice/guix-config' populated with all the Home configuration files
|
guix home: '/home/alice/guix-config' populated with all the Home configuration files
|
||||||
@end example
|
@end example
|
||||||
|
@end table
|
||||||
|
|
||||||
|
And there's more! @command{guix home} also provides the 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
|
@end table
|
||||||
|
|
||||||
@var{options} can contain any of the common build options (@pxref{Common
|
@var{options} can contain any of the common build options (@pxref{Common
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
|
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
|
||||||
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
|
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
|
||||||
|
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -25,6 +26,9 @@
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu home)
|
#:use-module (gnu home)
|
||||||
#:use-module (gnu home services)
|
#: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 channels)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
|
@ -33,13 +37,16 @@
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
|
#:autoload (guix graph) (lookup-backend export-graph)
|
||||||
#:use-module (guix scripts)
|
#:use-module (guix scripts)
|
||||||
#:use-module (guix scripts package)
|
#:use-module (guix scripts package)
|
||||||
#:use-module (guix scripts build)
|
#:use-module (guix scripts build)
|
||||||
#:autoload (guix scripts system search) (service-type->recutils)
|
#:autoload (guix scripts system search) (service-type->recutils)
|
||||||
#:use-module (guix scripts system reconfigure)
|
#:use-module (guix scripts system reconfigure)
|
||||||
#:autoload (guix scripts pull) (channel-commit-hyperlink)
|
#: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 status) #:select (with-status-verbosity))
|
||||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
#:use-module ((guix build utils) #:select (mkdir-p))
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
@ -87,6 +94,10 @@ Some ACTIONS support additional ARGS.\n"))
|
||||||
build build the home environment without installing anything\n"))
|
build build the home environment without installing anything\n"))
|
||||||
(display (G_ "\
|
(display (G_ "\
|
||||||
import generates a home environment definition from dotfiles\n"))
|
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)
|
(show-build-options-help)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
|
@ -97,6 +108,9 @@ Some ACTIONS support additional ARGS.\n"))
|
||||||
channel revisions"))
|
channel revisions"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
|
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
|
||||||
|
(display (G_ "
|
||||||
|
--graph-backend=BACKEND
|
||||||
|
use BACKEND for 'extension-graph' and 'shepherd-graph'"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
|
@ -136,6 +150,10 @@ Some ACTIONS support additional ARGS.\n"))
|
||||||
(alist-cons 'validate-reconfigure
|
(alist-cons 'validate-reconfigure
|
||||||
warn-about-backward-reconfigure
|
warn-about-backward-reconfigure
|
||||||
result)))
|
result)))
|
||||||
|
(option '("graph-backend") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'graph-backend arg result)))
|
||||||
|
|
||||||
%standard-build-options))
|
%standard-build-options))
|
||||||
|
|
||||||
(define %default-options
|
(define %default-options
|
||||||
|
@ -147,18 +165,49 @@ Some ACTIONS support additional ARGS.\n"))
|
||||||
(multiplexed-build-output? . #t)
|
(multiplexed-build-output? . #t)
|
||||||
(verbosity . #f) ;default
|
(verbosity . #f) ;default
|
||||||
(debug . 0)
|
(debug . 0)
|
||||||
(validate-reconfigure . ,ensure-forward-reconfigure)))
|
(validate-reconfigure . ,ensure-forward-reconfigure)
|
||||||
|
(graph-backend . "graphviz")))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Actions.
|
;;; 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) 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 port
|
||||||
|
#:backend backend
|
||||||
|
#:node-type (shepherd-service-node-type shepherds)
|
||||||
|
#:reverse-edges? #t)))
|
||||||
|
|
||||||
(define* (perform-action action he
|
(define* (perform-action action he
|
||||||
#:key
|
#:key
|
||||||
dry-run?
|
dry-run?
|
||||||
derivations-only?
|
derivations-only?
|
||||||
use-substitutes?
|
use-substitutes?
|
||||||
|
(graph-backend "graphviz")
|
||||||
(validate-reconfigure ensure-forward-reconfigure))
|
(validate-reconfigure ensure-forward-reconfigure))
|
||||||
"Perform ACTION for home environment. "
|
"Perform ACTION for home environment. "
|
||||||
|
|
||||||
|
@ -169,6 +218,14 @@ Some ACTIONS support additional ARGS.\n"))
|
||||||
(check-forward-update validate-reconfigure
|
(check-forward-update validate-reconfigure
|
||||||
#:current-channels (home-provenance %guix-home)))
|
#:current-channels (home-provenance %guix-home)))
|
||||||
|
|
||||||
|
(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
|
(mlet* %store-monad
|
||||||
((he-drv (home-environment-derivation he))
|
((he-drv (home-environment-derivation he))
|
||||||
(drvs (mapm/accumulate-builds lower-object (list he-drv)))
|
(drvs (mapm/accumulate-builds lower-object (list he-drv)))
|
||||||
|
@ -197,7 +254,7 @@ Some ACTIONS support additional ARGS.\n"))
|
||||||
(return he-out-path)))
|
(return he-out-path)))
|
||||||
(else
|
(else
|
||||||
(newline)
|
(newline)
|
||||||
(return he-out-path)))))))
|
(return he-out-path)))))))))
|
||||||
|
|
||||||
(define (process-action action args opts)
|
(define (process-action action args opts)
|
||||||
"Process ACTION, a sub-command, with the arguments are listed in ARGS.
|
"Process ACTION, a sub-command, with the arguments are listed in ARGS.
|
||||||
|
@ -256,7 +313,9 @@ resulting from command-line parsing."
|
||||||
#:derivations-only? (assoc-ref opts 'derivations-only?)
|
#:derivations-only? (assoc-ref opts 'derivations-only?)
|
||||||
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
#:use-substitutes? (assoc-ref opts 'substitutes?)
|
||||||
#:validate-reconfigure
|
#:validate-reconfigure
|
||||||
(assoc-ref opts 'validate-reconfigure))))))
|
(assoc-ref opts 'validate-reconfigure)
|
||||||
|
#:graph-backend
|
||||||
|
(assoc-ref opts 'graph-backend))))))
|
||||||
(warn-about-disk-space)))
|
(warn-about-disk-space)))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -88,7 +88,10 @@
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:export (guix-system
|
#:export (guix-system
|
||||||
read-operating-system))
|
read-operating-system
|
||||||
|
|
||||||
|
service-node-type
|
||||||
|
shepherd-service-node-type))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -93,6 +93,14 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
|
||||||
"# the content of bashrc-test-config.sh"))))))))
|
"# the content of bashrc-test-config.sh"))))))))
|
||||||
EOF
|
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"
|
guix home reconfigure "${test_directory}/home.scm"
|
||||||
test -d "${HOME}/.guix-home"
|
test -d "${HOME}/.guix-home"
|
||||||
test -h "${HOME}/.bash_profile"
|
test -h "${HOME}/.bash_profile"
|
||||||
|
|
Reference in New Issue