graph: Add '--max-depth'.
* 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.
This commit is contained in:
parent
be32889902
commit
5b32ad4f6f
|
@ -12644,6 +12644,20 @@ $ guix graph --path -t references emacs libunistring
|
||||||
/gnu/store/@dots{}-libunistring-0.9.10
|
/gnu/store/@dots{}-libunistring-0.9.10
|
||||||
@end example
|
@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:
|
The available options are the following:
|
||||||
|
|
||||||
@table @option
|
@table @option
|
||||||
|
|
|
@ -337,11 +337,12 @@ nodeArray.push(nodes[\"~a\"]);~%"
|
||||||
|
|
||||||
(define* (export-graph sinks port
|
(define* (export-graph sinks port
|
||||||
#:key
|
#:key
|
||||||
reverse-edges? node-type
|
reverse-edges? node-type (max-depth +inf.0)
|
||||||
(backend %graphviz-backend))
|
(backend %graphviz-backend))
|
||||||
"Write to PORT the representation of the DAG with the given SINKS, using the
|
"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
|
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
|
(match backend
|
||||||
(($ <graph-backend> _ _ emit-prologue emit-epilogue emit-node emit-edge)
|
(($ <graph-backend> _ _ emit-prologue emit-epilogue emit-node emit-edge)
|
||||||
(emit-prologue (node-type-name node-type) port)
|
(emit-prologue (node-type-name node-type) port)
|
||||||
|
@ -349,6 +350,7 @@ true, draw reverse arrows."
|
||||||
(match node-type
|
(match node-type
|
||||||
(($ <node-type> node-identifier node-label node-edges)
|
(($ <node-type> node-identifier node-label node-edges)
|
||||||
(let loop ((nodes sinks)
|
(let loop ((nodes sinks)
|
||||||
|
(depths (make-list (length sinks) 0))
|
||||||
(visited (set)))
|
(visited (set)))
|
||||||
(match nodes
|
(match nodes
|
||||||
(()
|
(()
|
||||||
|
@ -356,20 +358,29 @@ true, draw reverse arrows."
|
||||||
(emit-epilogue port)
|
(emit-epilogue port)
|
||||||
(store-return #t)))
|
(store-return #t)))
|
||||||
((head . tail)
|
((head . tail)
|
||||||
(mlet %store-monad ((id (node-identifier head)))
|
(match depths
|
||||||
(if (set-contains? visited id)
|
((depth . depths)
|
||||||
(loop tail visited)
|
(mlet %store-monad ((id (node-identifier head)))
|
||||||
(mlet* %store-monad ((dependencies (node-edges head))
|
(if (set-contains? visited id)
|
||||||
(ids (mapm %store-monad
|
(loop tail depths visited)
|
||||||
node-identifier
|
(mlet* %store-monad ((dependencies
|
||||||
dependencies)))
|
(if (= depth max-depth)
|
||||||
(emit-node id (node-label head) port)
|
(return '())
|
||||||
(for-each (lambda (dependency dependency-id)
|
(node-edges head)))
|
||||||
(if reverse-edges?
|
(ids
|
||||||
(emit-edge dependency-id id port)
|
(mapm %store-monad
|
||||||
(emit-edge id dependency-id port)))
|
node-identifier
|
||||||
dependencies ids)
|
dependencies)))
|
||||||
(loop (append dependencies tail)
|
(emit-node id (node-label head) port)
|
||||||
(set-insert id visited)))))))))))))
|
(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
|
;;; graph.scm ends here
|
||||||
|
|
|
@ -500,6 +500,10 @@ package modules, while attempting to retain user package modules."
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'backend (lookup-backend arg)
|
(alist-cons 'backend (lookup-backend arg)
|
||||||
result)))
|
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
|
(option '("list-backends") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(list-backends)
|
(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"))
|
-t, --type=TYPE represent nodes of the given TYPE"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--list-types list the available graph types"))
|
--list-types list the available graph types"))
|
||||||
|
(display (G_ "
|
||||||
|
--max-depth=DEPTH limit to nodes within distance DEPTH"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--path display the shortest path between the given nodes"))
|
--path display the shortest path between the given nodes"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
|
@ -559,6 +565,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
|
||||||
(define %default-options
|
(define %default-options
|
||||||
`((node-type . ,%package-node-type)
|
`((node-type . ,%package-node-type)
|
||||||
(backend . ,%graphviz-backend)
|
(backend . ,%graphviz-backend)
|
||||||
|
(max-depth . +inf.0)
|
||||||
(system . ,(%current-system))))
|
(system . ,(%current-system))))
|
||||||
|
|
||||||
|
|
||||||
|
@ -582,6 +589,7 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
|
||||||
|
|
||||||
(with-store store
|
(with-store store
|
||||||
(let* ((transform (options->transformation opts))
|
(let* ((transform (options->transformation opts))
|
||||||
|
(max-depth (assoc-ref opts 'max-depth))
|
||||||
(items (filter-map (match-lambda
|
(items (filter-map (match-lambda
|
||||||
(('argument . (? store-path? item))
|
(('argument . (? store-path? item))
|
||||||
item)
|
item)
|
||||||
|
@ -613,7 +621,8 @@ nodes (given ~a)~%")
|
||||||
(export-graph (concatenate nodes)
|
(export-graph (concatenate nodes)
|
||||||
(current-output-port)
|
(current-output-port)
|
||||||
#:node-type type
|
#:node-type type
|
||||||
#:backend backend)))
|
#:backend backend
|
||||||
|
#:max-depth max-depth)))
|
||||||
#:system (assq-ref opts 'system)))))
|
#:system (assq-ref opts 'system)))))
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -94,6 +94,25 @@ edges."
|
||||||
(list p3 p3 p2)
|
(list p3 p3 p2)
|
||||||
(list p2 p1 p1))))))))
|
(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"
|
(test-assert "reverse package DAG"
|
||||||
(let-values (((backend nodes+edges) (make-recording-backend)))
|
(let-values (((backend nodes+edges) (make-recording-backend)))
|
||||||
(run-with-store %store
|
(run-with-store %store
|
||||||
|
|
Loading…
Reference in New Issue