summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-01-04 16:43:20 +0100
committerLudovic Courtès <ludo@gnu.org>2021-01-04 23:54:15 +0100
commit6c3690fc572bf3231ae60743671b357ffd243017 (patch)
tree567683e1c410f1b515412cedb6833e5ff7eea174 /guix
parent475c3278df4f9dc1bc708e1092e8c93d0618711a (diff)
guix system: Add '--graph-backend'.
* guix/scripts/system.scm (lookup-backend): New procedure. (export-extension-graph, export-shepherd-graph): Add #:backend parameter and honor it. (show-help, %options): Add "--graph-backend". (%default-options): Add 'graph-backend'. (process-action): Pass #:backend to 'export-extension-graph' and 'export-shepherd-graph'. * doc/guix.texi (Invoking guix system): Document '--graph-backend'.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/system.scm43
1 files changed, 34 insertions, 9 deletions
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