Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 11 Mar 2022 21:33:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 54344 in the body.
You can then email your comments to 54344 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
andrew <at> trop.in, guix-patches <at> gnu.org:bug#54344; Package guix-patches.
(Fri, 11 Mar 2022 21:33:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:andrew <at> trop.in, guix-patches <at> gnu.org.
(Fri, 11 Mar 2022 21:33:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' Date: Fri, 11 Mar 2022 22:32:33 +0100
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
guix-patches <at> gnu.org:bug#54344; Package guix-patches.
(Fri, 11 Mar 2022 21:35:02 GMT) Full text and rfc822 format available.Message #8 received at 54344 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54344 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 1/3] graph: Factorize 'lookup-backend'. Date: Fri, 11 Mar 2022 22:34:16 +0100
* 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 <at> gnu.org>
+;;; Copyright © 2015-2016, 2020-2022 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado <at> 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 <at> gnu.org>
+;;; Copyright © 2015-2022 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2019 Simon Tournier <zimon.toutoune <at> 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
guix-patches <at> gnu.org:bug#54344; Package guix-patches.
(Fri, 11 Mar 2022 21:35:03 GMT) Full text and rfc822 format available.Message #11 received at 54344 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54344 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 2/3] home: services: Export record type accessors. Date: Fri, 11 Mar 2022 22:34:17 +0100
* 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
guix-patches <at> gnu.org:bug#54344; Package guix-patches.
(Fri, 11 Mar 2022 21:35:03 GMT) Full text and rfc822 format available.Message #14 received at 54344 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 54344 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. Date: Fri, 11 Mar 2022 22:34:18 +0100
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 <at> yoctocell.xyz>
;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
;;; Copyright © 2021 Oleg Pykhalov <go.wigust <at> gmail.com>
+;;; Copyright © 2022 Ludovic Courtès <ludo <at> 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)
+ #: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))
;;;
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
guix-patches <at> gnu.org:bug#54344; Package guix-patches.
(Thu, 17 Mar 2022 05:16:02 GMT) Full text and rfc822 format available.Message #17 received at 54344 <at> debbugs.gnu.org (full text, mbox):
From: Andrew Tropin <andrew <at> trop.in> To: Ludovic Courtès <ludo <at> gnu.org>, 54344 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: Re: [bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions. Date: Thu, 17 Mar 2022 08:14:47 +0300
[Message part 1 (text/plain, inline)]
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 <at> yoctocell.xyz>
> ;;; Copyright © 2021 Pierre Langlois <pierre.langlois <at> gmx.com>
> ;;; Copyright © 2021 Oleg Pykhalov <go.wigust <at> gmail.com>
> +;;; Copyright © 2022 Ludovic Courtès <ludo <at> 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 (application/pgp-signature, inline)]
Ludovic Courtès <ludo <at> gnu.org>:Ludovic Courtès <ludo <at> gnu.org>:Message #22 received at 54344-done <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Andrew Tropin <andrew <at> trop.in> Cc: 54344-done <at> debbugs.gnu.org Subject: Re: bug#54344: [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph' Date: Fri, 18 Mar 2022 16:11:22 +0100
Hi Andrew, Thanks for your feedback! I incorporated your suggestions and pushed as 25261cbf96a3bf58abc6e836d71bdabe9154a83c. Ludo’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Sat, 16 Apr 2022 11:24:07 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.