[bug#54344] [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph'

[bug#54344] [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph'

[Ludovic Courtès]

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

[bug#54344] [PATCH 1/3] graph: Factorize 'lookup-backend'.

[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

[bug#54344] [PATCH 2/3] home: services: Export record type accessors.

[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

[bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions.

[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

[bug#54344] [PATCH 3/3] guix home: Implement the 'extension-graph' and 'shepherd-graph' actions.

[Andrew Tropin]

[-- 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 --]

bug#54344: [PATCH 0/3] Add 'guix home extension-graph' and 'shepherd-graph'

[Ludovic Courtès]

Hi Andrew,

Thanks for your feedback!  I incorporated your suggestions and pushed as
25261cbf96a3bf58abc6e836d71bdabe9154a83c.

Ludo’.