* [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 external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.