diff options
| -rw-r--r-- | doc/guix.texi | 13 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 43 |
2 files changed, 43 insertions, 13 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 1081ed26a3..0f6e95a65a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -21,7 +21,7 @@ @set SUBSTITUTE-URL https://@value{SUBSTITUTE-SERVER} @copying -Copyright @copyright{} 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès@* +Copyright @copyright{} 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès@* Copyright @copyright{} 2013, 2014, 2016 Andreas Enge@* Copyright @copyright{} 2013 Nikita Karetnikov@* Copyright @copyright{} 2014, 2015, 2016 Alex Kost@* @@ -31548,10 +31548,12 @@ each other: @table @code @item extension-graph -Emit in Dot/Graphviz format to standard output the @dfn{service +Emit to standard output the @dfn{service extension graph} of the operating system defined in @var{file} (@pxref{Service Composition}, for more information on service -extensions). +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: @@ -31563,11 +31565,14 @@ shows the extension relations among services. @anchor{system-shepherd-graph} @item shepherd-graph -Emit in Dot/Graphviz format to standard output the @dfn{dependency +Emit to standard output the @dfn{dependency graph} of shepherd services of the operating system 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 @node Invoking guix deploy diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 0dcf2b3afe..51c8cf2f76 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com> @@ -48,7 +48,8 @@ #:autoload (guix scripts package) (delete-generations delete-matching-generations) #:autoload (guix scripts pull) (channel-commit-hyperlink) - #:use-module (guix graph) + #:autoload (guix graph) (export-graph node-type + graph-backend-name %graph-backends) #:use-module (guix scripts graph) #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) @@ -887,18 +888,28 @@ Run 'herd status' to view the list of services on your system.\n")))))) (register-root* (list output) gc-root)) (return output))))))))) -(define (export-extension-graph os port) - "Export the service extension graph of OS to PORT." +(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." (let* ((services (operating-system-services os)) (system (find (lambda (service) (eq? (service-kind service) system-service-type)) services))) (export-graph (list system) (current-output-port) + #:backend backend #:node-type (service-node-type services) #:reverse-edges? #t))) -(define (export-shepherd-graph os port) - "Export the graph of shepherd services of OS to PORT." +(define* (export-shepherd-graph os port + #:key (backend (lookup-backend "graphviz"))) + "Export the graph of shepherd services of OS to PORT using BACKEND." (let* ((services (operating-system-services os)) (pid1 (fold-services services #:target-type shepherd-root-service-type)) @@ -907,6 +918,7 @@ Run 'herd status' to view the list of services on your system.\n")))))) (null? (shepherd-service-requirement service))) shepherds))) (export-graph sinks (current-output-port) + #:backend backend #:node-type (shepherd-service-node-type shepherds) #:reverse-edges? #t))) @@ -1015,6 +1027,10 @@ Some ACTIONS support additional ARGS.\n")) -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (display (G_ " + --graph-backend=BACKEND + use BACKEND for 'extension-graphs' and 'shepherd-graph'")) + (newline) + (display (G_ " -h, --help display this help and exit")) (display (G_ " -V, --version display version information and exit")) @@ -1109,6 +1125,9 @@ Some ACTIONS support additional ARGS.\n")) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) + (option '("graph-backend") #t #f + (lambda (opt name arg result) + (alist-cons 'graph-backend arg result))) %standard-build-options)) (define %default-options @@ -1128,7 +1147,8 @@ Some ACTIONS support additional ARGS.\n")) (image-size . guess) (install-bootloader? . #t) (label . #f) - (volatile-root? . #f))) + (volatile-root? . #f) + (graph-backend . "graphviz"))) (define (verbosity-level opts) "Return the verbosity level based on OPTS, the alist of parsed options." @@ -1191,6 +1211,9 @@ resulting from command-line parsing." (bootloader-configuration-target (operating-system-bootloader os))))) + (define (graph-backend) + (lookup-backend (assoc-ref opts 'graph-backend))) + (with-store store (set-build-options-from-command-line store opts) @@ -1205,9 +1228,11 @@ resulting from command-line parsing." (set-guile-for-build (default-guile)) (case action ((extension-graph) - (export-extension-graph os (current-output-port))) + (export-extension-graph os (current-output-port) + #:backend (graph-backend))) ((shepherd-graph) - (export-shepherd-graph os (current-output-port))) + (export-shepherd-graph os (current-output-port) + #:backend (graph-backend))) (else (unless (memq action '(build init)) (warn-about-old-distro #:suggested-command |