From patchwork Fri Sep 17 08:18:48 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 33089 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5BFD327BBE3; Fri, 17 Sep 2021 09:38:48 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id B7B2027BBE1 for ; Fri, 17 Sep 2021 09:38:47 +0100 (BST) Received: from localhost ([::1]:39896 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mR9OQ-0006M3-Lx for patchwork@mira.cbaines.net; Fri, 17 Sep 2021 04:38:46 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43962) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mR96I-0001D8-RF for guix-patches@gnu.org; Fri, 17 Sep 2021 04:20:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46887) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mR96I-0003fv-JR for guix-patches@gnu.org; Fri, 17 Sep 2021 04:20:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mR96I-0001hw-EA for guix-patches@gnu.org; Fri, 17 Sep 2021 04:20:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#50632] [PATCH] graph: Add '--max-depth'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 17 Sep 2021 08:20:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 50632 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 50632@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.16318667496477 (code B ref -1); Fri, 17 Sep 2021 08:20:02 +0000 Received: (at submit) by debbugs.gnu.org; 17 Sep 2021 08:19:09 +0000 Received: from localhost ([127.0.0.1]:58427 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mR95Q-0001gP-HH for submit@debbugs.gnu.org; Fri, 17 Sep 2021 04:19:09 -0400 Received: from lists.gnu.org ([209.51.188.17]:52132) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mR95O-0001gG-1a for submit@debbugs.gnu.org; Fri, 17 Sep 2021 04:19:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:43884) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mR95N-0007yk-2m for guix-patches@gnu.org; Fri, 17 Sep 2021 04:19:05 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:53532) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mR95L-0002uV-Bq; Fri, 17 Sep 2021 04:19:03 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=35746 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mR95K-0007Au-Ty; Fri, 17 Sep 2021 04:19:03 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Fri, 17 Sep 2021 10:18:48 +0200 Message-Id: <20210917081848.14264-1-ludo@gnu.org> X-Mailer: git-send-email 2.33.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches From: Ludovic Courtès * 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’. 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 (($ _ _ 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-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 +;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; ;;; 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