(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludovic.courtes@inria.fr)
20210917081848.14264-1-ludo@gnu.org
From: Ludovic Courtès <ludovic.courtes@inria.fr>
* guix/graph.scm (export-graph): Add #:max-depth and honor it, adding
'depths' argument to 'loop'.
* guix/scripts/graph.scm (%options, show-help): Add '--max-depth'.
(%default-options): Add 'max-depth'.
(guix-graph): Pass #:max-depth to 'export-graph'.
* tests/graph.scm ("package DAG, limited depth"): New test.
* doc/guix.texi (Invoking guix graph): Document it.
---
doc/guix.texi | 14 +++++++++++++
guix/graph.scm | 45 ++++++++++++++++++++++++++----------------
guix/scripts/graph.scm | 11 ++++++++++-
tests/graph.scm | 21 +++++++++++++++++++-
4 files changed, 72 insertions(+), 19 deletions(-)
Hello!
This patch adds a long-overdue ‘--max-depth’ option to ‘guix graph’,
which helps visualization somewhat.
Trimming of nodes beyond the max depth happens at export time. The
implementation is a bit naive (with a list containing the depth of
each node) but performance is mostly unchanged.
Feedback welcome!
Ludo’.
Toggle diff (186 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 2fc9687910..6c0a581463 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12598,6 +12598,20 @@ $ guix graph --path -t references emacs libunistring
/gnu/store/@dots{}-libunistring-0.9.10
@end example
+Sometimes you still want to visualize the graph but would like to trim
+it so it can actually be displayed. One way to do it is via the
+@option{--max-depth} (or @option{-M}) option, which lets you specify the
+maximum depth of the graph. In the example below, we visualize only
+@code{libreoffice} and the nodes whose distance to @code{libreoffice} is
+at most 2:
+
+@example
+guix graph -M 2 libreoffice | xdot -f fdp -
+@end example
+
+Mind you, that's still a big ball of spaghetti, but at least
+@command{dot} can render it quickly and it can be browsed somewhat.
+
The available options are the following:
@table @option
diff --git a/guix/graph.scm b/guix/graph.scm
index 0d4cd83667..3a1cab244b 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -337,11 +337,12 @@ nodeArray.push(nodes[\"~a\"]);~%"
(define* (export-graph sinks port
#:key
- reverse-edges? node-type
+ reverse-edges? node-type (max-depth +inf.0)
(backend %graphviz-backend))
"Write to PORT the representation of the DAG with the given SINKS, using the
given BACKEND. Use NODE-TYPE to traverse the DAG. When REVERSE-EDGES? is
-true, draw reverse arrows."
+true, draw reverse arrows. Do not represent nodes whose distance to one of
+the SINKS is greater than MAX-DEPTH."
(match backend
(($ <graph-backend> _ _ emit-prologue emit-epilogue emit-node emit-edge)
(emit-prologue (node-type-name node-type) port)
@@ -349,6 +350,7 @@ true, draw reverse arrows."
(match node-type
(($ <node-type> node-identifier node-label node-edges)
(let loop ((nodes sinks)
+ (depths (make-list (length sinks) 0))
(visited (set)))
(match nodes
(()
@@ -356,20 +358,29 @@ true, draw reverse arrows."
(emit-epilogue port)
(store-return #t)))
((head . tail)
- (mlet %store-monad ((id (node-identifier head)))
- (if (set-contains? visited id)
- (loop tail visited)
- (mlet* %store-monad ((dependencies (node-edges head))
- (ids (mapm %store-monad
- node-identifier
- dependencies)))
- (emit-node id (node-label head) port)
- (for-each (lambda (dependency dependency-id)
- (if reverse-edges?
- (emit-edge dependency-id id port)
- (emit-edge id dependency-id port)))
- dependencies ids)
- (loop (append dependencies tail)
- (set-insert id visited)))))))))))))
+ (match depths
+ ((depth . depths)
+ (mlet %store-monad ((id (node-identifier head)))
+ (if (set-contains? visited id)
+ (loop tail depths visited)
+ (mlet* %store-monad ((dependencies
+ (if (= depth max-depth)
+ (return '())
+ (node-edges head)))
+ (ids
+ (mapm %store-monad
+ node-identifier
+ dependencies)))
+ (emit-node id (node-label head) port)
+ (for-each (lambda (dependency dependency-id)
+ (if reverse-edges?
+ (emit-edge dependency-id id port)
+ (emit-edge id dependency-id port)))
+ dependencies ids)
+ (loop (append dependencies tail)
+ (append (make-list (length dependencies)
+ (+ 1 depth))
+ depths)
+ (set-insert id visited)))))))))))))))
;;; graph.scm ends here
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 66de824ef4..439fae0b52 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -500,6 +500,10 @@ package modules, while attempting to retain user package modules."
(lambda (opt name arg result)
(alist-cons 'backend (lookup-backend arg)
result)))
+ (option '(#\M "max-depth") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'max-depth (string->number* arg)
+ result)))
(option '("list-backends") #f #f
(lambda (opt name arg result)
(list-backends)
@@ -537,6 +541,8 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
-t, --type=TYPE represent nodes of the given TYPE"))
(display (G_ "
--list-types list the available graph types"))
+ (display (G_ "
+ --max-depth=DEPTH limit to nodes within distance DEPTH"))
(display (G_ "
--path display the shortest path between the given nodes"))
(display (G_ "
@@ -559,6 +565,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
(define %default-options
`((node-type . ,%package-node-type)
(backend . ,%graphviz-backend)
+ (max-depth . +inf.0)
(system . ,(%current-system))))
@@ -582,6 +589,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
(with-store store
(let* ((transform (options->transformation opts))
+ (max-depth (assoc-ref opts 'max-depth))
(items (filter-map (match-lambda
(('argument . (? store-path? item))
item)
@@ -613,7 +621,8 @@ nodes (given ~a)~%")
(export-graph (concatenate nodes)
(current-output-port)
#:node-type type
- #:backend backend)))
+ #:backend backend
+ #:max-depth max-depth)))
#:system (assq-ref opts 'system)))))
#t)
diff --git a/tests/graph.scm b/tests/graph.scm
index e374dad1a5..fadac265f9 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -94,6 +94,25 @@ edges."
(list p3 p3 p2)
(list p2 p1 p1))))))))
+(test-assert "package DAG, limited depth"
+ (let-values (((backend nodes+edges) (make-recording-backend)))
+ (let* ((p1 (dummy-package "p1"))
+ (p2 (dummy-package "p2" (inputs `(("p1" ,p1)))))
+ (p3 (dummy-package "p3" (inputs `(("p1" ,p1)))))
+ (p4 (dummy-package "p4" (inputs `(("p2" ,p2) ("p3" ,p3))))))
+ (run-with-store %store
+ (export-graph (list p4) 'port
+ #:max-depth 1
+ #:node-type %package-node-type
+ #:backend backend))
+ ;; We should see nothing more than these 3 packages.
+ (let-values (((nodes edges) (nodes+edges)))
+ (and (equal? nodes (map package->tuple (list p4 p2 p3)))
+ (equal? edges
+ (map edge->tuple
+ (list p4 p4)
+ (list p2 p3))))))))
+
(test-assert "reverse package DAG"
(let-values (((backend nodes+edges) (make-recording-backend)))
(run-with-store %store
--
2.33.0