From patchwork Sat May 9 23:27:37 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 21964 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 B413427BBE1; Sun, 10 May 2020 00:28:14 +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 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 ESMTP id E1F5727BBE3 for ; Sun, 10 May 2020 00:28:13 +0100 (BST) Received: from localhost ([::1]:50142 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXYtB-0007Eu-DT for patchwork@mira.cbaines.net; Sat, 09 May 2020 19:28:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:50734) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jXYt1-00075O-89 for guix-patches@gnu.org; Sat, 09 May 2020 19:28:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:37043) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jXYt0-00081g-VG for guix-patches@gnu.org; Sat, 09 May 2020 19:28:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jXYt0-00055Y-S7 for guix-patches@gnu.org; Sat, 09 May 2020 19:28:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41164] [PATCH 1/3] graph: reference/referrer node types work with graph traversal. References: <20200509230401.28364-1-ludo@gnu.org> In-Reply-To: <20200509230401.28364-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 09 May 2020 23:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41164 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41164@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41164-submit@debbugs.gnu.org id=B41164.158906687519531 (code B ref 41164); Sat, 09 May 2020 23:28:02 +0000 Received: (at 41164) by debbugs.gnu.org; 9 May 2020 23:27:55 +0000 Received: from localhost ([127.0.0.1]:48586 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXYst-00054r-A2 for submit@debbugs.gnu.org; Sat, 09 May 2020 19:27:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47702) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXYsr-00054P-39 for 41164@debbugs.gnu.org; Sat, 09 May 2020 19:27:53 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34093) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXYsk-0007Ag-DC; Sat, 09 May 2020 19:27:46 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=40868 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jXYsi-00020y-RK; Sat, 09 May 2020 19:27:45 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 10 May 2020 01:27:37 +0200 Message-Id: <20200509232739.29016-1-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 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 The graph traversal procedures in (guix graph) assume that nodes can be compared with 'eq?', which was not the case for nodes of %REFERENCE-NODE-TYPE and %REFERRER-NODE-TYPE (strings). * guix/scripts/graph.scm (intern): New procedure. (ensure-store-items, references*) (%reference-node-type, non-derivation-referrers) (%referrer-node-type): Use it on all store items. * tests/graph.scm ("node-transitive-edges, references"): New test. --- guix/scripts/graph.scm | 23 ++++++++++++++++------- tests/graph.scm | 27 +++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 7 deletions(-) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index fca1e3777c..d69dace14f 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -307,6 +307,14 @@ derivation graph"))))))) ;;; DAG of residual references (aka. run-time dependencies). ;;; +(define intern + (mlambda (str) + "Intern STR, a string denoting a store item." + ;; This is necessary for %REFERENCE-NODE-TYPE and %REFERRER-NODE-TYPE + ;; because their nodes are strings but the (guix graph) traversal + ;; procedures expect to be able to compare nodes with 'eq?'. + str)) + (define ensure-store-items ;; Return a list of store items as a monadic value based on the given ;; argument, which may be a store item or a package. @@ -316,10 +324,10 @@ derivation graph"))))))) (mlet %store-monad ((drv (package->derivation package))) (return (match (derivation->output-paths drv) (((_ . file-names) ...) - file-names))))) + (map intern file-names)))))) ((? store-path? item) (with-monad %store-monad - (return (list item)))) + (return (list (intern item))))) (x (raise (condition (&message (message "unsupported argument for \ @@ -333,18 +341,19 @@ substitutes." (guard (c ((store-protocol-error? c) (match (substitutable-path-info store (list item)) ((info) - (values (substitutable-references info) store)) + (values (map intern (substitutable-references info)) + store)) (() (leave (G_ "references for '~a' are not known~%") item))))) - (values (references store item) store)))) + (values (map intern (references store item)) store)))) (define %reference-node-type (node-type (name "references") (description "the DAG of run-time dependencies (store references)") (convert ensure-store-items) - (identifier (lift1 identity %store-monad)) + (identifier (lift1 intern %store-monad)) (label store-path-package-name) (edges references*))) @@ -353,14 +362,14 @@ substitutes." (lambda (item) "Return the referrers of ITEM, except '.drv' files." (mlet %store-monad ((items (referrers item))) - (return (remove derivation-path? items)))))) + (return (map intern (remove derivation-path? items))))))) (define %referrer-node-type (node-type (name "referrers") (description "the DAG of referrers in the store") (convert ensure-store-items) - (identifier (lift1 identity %store-monad)) + (identifier (lift1 intern %store-monad)) (label store-path-package-name) (edges non-derivation-referrers))) diff --git a/tests/graph.scm b/tests/graph.scm index 402847102f..983a6ed654 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -31,6 +31,7 @@ #:use-module (guix utils) #:use-module (gnu packages) #:use-module (gnu packages base) + #:use-module (gnu packages bootstrap) #:use-module (gnu packages guile) #:use-module (gnu packages libunistring) #:use-module (gnu packages bootstrap) @@ -358,6 +359,32 @@ edges." (return (lset= eq? (node-transitive-edges (list p2) edges) (list p1a p1b p0))))))) +(test-assert "node-transitive-edges, references" + (run-with-store %store + (mlet* %store-monad ((d0 (package->derivation %bootstrap-guile)) + (d1 (gexp->derivation "d1" + #~(begin + (mkdir #$output) + (symlink #$%bootstrap-guile + (string-append + #$output "/l"))))) + (d2 (gexp->derivation "d2" + #~(begin + (mkdir #$output) + (symlink #$d1 + (string-append + #$output "/l"))))) + (_ (built-derivations (list d2))) + (->node -> (node-type-convert %reference-node-type)) + (o2 (->node (derivation->output-path d2))) + (o1 (->node (derivation->output-path d1))) + (o0 (->node (derivation->output-path d0))) + (edges (node-edges %reference-node-type + (append o0 o1 o2))) + (reqs ((store-lift requisites) o2))) + (return (lset= string=? + (append o2 (node-transitive-edges o2 edges)) reqs))))) + (test-equal "node-reachable-count" '(3 3) (run-with-store %store From patchwork Sat May 9 23:27:38 2020 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: 21962 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 14AD827BBE3; Sun, 10 May 2020 00:28:09 +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,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 ESMTP id 545D727BBE1 for ; Sun, 10 May 2020 00:28:08 +0100 (BST) Received: from localhost ([::1]:49812 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXYt5-00075c-PR for patchwork@mira.cbaines.net; Sat, 09 May 2020 19:28:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:50728) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jXYt0-00075G-Qc for guix-patches@gnu.org; Sat, 09 May 2020 19:28:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:37042) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jXYt0-00081A-Gq for guix-patches@gnu.org; Sat, 09 May 2020 19:28:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jXYt0-00055R-EJ for guix-patches@gnu.org; Sat, 09 May 2020 19:28:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41164] [PATCH 2/3] graph: Add 'shortest-path'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 09 May 2020 23:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41164 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41164@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41164-submit@debbugs.gnu.org id=B41164.158906687519524 (code B ref 41164); Sat, 09 May 2020 23:28:02 +0000 Received: (at 41164) by debbugs.gnu.org; 9 May 2020 23:27:55 +0000 Received: from localhost ([127.0.0.1]:48584 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXYss-00054p-TE for submit@debbugs.gnu.org; Sat, 09 May 2020 19:27:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47708) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXYsq-00054R-R5 for 41164@debbugs.gnu.org; Sat, 09 May 2020 19:27:53 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34094) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXYsl-0007Dn-Jj; Sat, 09 May 2020 19:27:47 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=40868 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jXYsk-00020y-JV; Sat, 09 May 2020 19:27:47 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 10 May 2020 01:27:38 +0200 Message-Id: <20200509232739.29016-2-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200509232739.29016-1-ludo@gnu.org> References: <20200509232739.29016-1-ludo@gnu.org> 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 * guix/graph.scm (shortest-path): New procedure. * tests/graph.scm ("shortest-path, packages + derivations") ("shortest-path, reverse packages") ("shortest-path, references"): New tests. --- guix/graph.scm | 69 ++++++++++++++++++++++++++++++++++++++++++++++++- tests/graph.scm | 61 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+), 1 deletion(-) diff --git a/guix/graph.scm b/guix/graph.scm index d7fd5f3e4b..b695ca4306 100644 --- a/guix/graph.scm +++ b/guix/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016 Ludovic Courtès +;;; Copyright © 2015, 2016, 2020 Ludovic Courtès ;;; Copyright © 2016 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -42,6 +42,7 @@ traverse/depth-first node-transitive-edges node-reachable-count + shortest-path %graph-backends %d3js-backend @@ -140,6 +141,72 @@ typically returned by 'node-edges' or 'node-back-edges'." 0 nodes node-edges)) +(define (shortest-path node1 node2 type) + "Return as a monadic value the shorted path, represented as a list, from +NODE1 to NODE2 of the given TYPE. Return #f when there is no path." + (define node-edges + (node-type-edges type)) + + (define (find-shortest lst) + ;; Return the shortest path among LST, where each path is represented as a + ;; vlist. + (let loop ((lst lst) + (best +inf.0) + (shortest #f)) + (match lst + (() + shortest) + ((head . tail) + (let ((len (vlist-length head))) + (if (< len best) + (loop tail len head) + (loop tail best shortest))))))) + + (define (find-path node path paths) + ;; Return the a vhash that maps nodes to paths, with each path from the + ;; given node to NODE2. + (define (augment-paths child paths) + ;; When using %REFERENCE-NODE-TYPE, nodes can contain self references, + ;; hence this test. + (if (eq? child node) + (store-return paths) + (find-path child vlist-null paths))) + + (cond ((eq? node node2) + (store-return (vhash-consq node (vlist-cons node path) + paths))) + ((vhash-assq node paths) + (store-return paths)) + (else + ;; XXX: We could stop recursing if one if CHILDREN is NODE2, but in + ;; practice it's good enough. + (mlet* %store-monad ((children (node-edges node)) + (paths (foldm %store-monad + augment-paths + paths + children))) + (define sub-paths + (filter-map (lambda (child) + (match (vhash-assq child paths) + (#f #f) + ((_ . path) path))) + children)) + + (match sub-paths + (() + (return (vhash-consq node #f paths))) + (lst + (return (vhash-consq node + (vlist-cons node (find-shortest sub-paths)) + paths)))))))) + + (mlet %store-monad ((paths (find-path node1 + (vlist-cons node1 vlist-null) + vlist-null))) + (return (match (vhash-assq node1 paths) + ((_ . #f) #f) + ((_ . path) (vlist->list path)))))) + ;;; ;;; Graphviz export. diff --git a/tests/graph.scm b/tests/graph.scm index 983a6ed654..136260c7d1 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -398,4 +398,65 @@ edges." (return (list (node-reachable-count (list p2) edges) (node-reachable-count (list p0) back))))))) +(test-equal "shortest-path, packages + derivations" + '(("p5" "p4" "p1" "p0") + ("p3" "p2" "p1" "p0") + #f + ("p5-0.drv" "p4-0.drv" "p1-0.drv" "p0-0.drv")) + (run-with-store %store + (let* ((p0 (dummy-package "p0")) + (p1 (dummy-package "p1" (inputs `(("p0" ,p0))))) + (p2 (dummy-package "p2" (inputs `(("p1" ,p1))))) + (p3 (dummy-package "p3" (inputs `(("p2" ,p2))))) + (p4 (dummy-package "p4" (inputs `(("p1" ,p1))))) + (p5 (dummy-package "p5" (inputs `(("p4" ,p4) ("p3" ,p3)))))) + (mlet* %store-monad ((path1 (shortest-path p5 p0 %package-node-type)) + (path2 (shortest-path p3 p0 %package-node-type)) + (nope (shortest-path p3 p4 %package-node-type)) + (drv5 (package->derivation p5)) + (drv0 (package->derivation p0)) + (path3 (shortest-path drv5 drv0 + %derivation-node-type))) + (return (append (map (lambda (path) + (and path (map package-name path))) + (list path1 path2 nope)) + (list (map (node-type-label %derivation-node-type) + path3)))))))) + +(test-equal "shortest-path, reverse packages" + '("libffi" "guile" "guile-json") + (run-with-store %store + (mlet %store-monad ((path (shortest-path (specification->package "libffi") + guile-json + %reverse-package-node-type))) + (return (map package-name path))))) + +(test-equal "shortest-path, references" + `(("d2" "d1" ,(package-full-name %bootstrap-guile "-")) + (,(package-full-name %bootstrap-guile "-") "d1" "d2")) + (run-with-store %store + (mlet* %store-monad ((d0 (package->derivation %bootstrap-guile)) + (d1 (gexp->derivation "d1" + #~(begin + (mkdir #$output) + (symlink #$%bootstrap-guile + (string-append + #$output "/l"))))) + (d2 (gexp->derivation "d2" + #~(begin + (mkdir #$output) + (symlink #$d1 + (string-append + #$output "/l"))))) + (_ (built-derivations (list d2))) + (->node -> (node-type-convert %reference-node-type)) + (o2 (->node (derivation->output-path d2))) + (o0 (->node (derivation->output-path d0))) + (path (shortest-path (first o2) (first o0) + %reference-node-type)) + (rpath (shortest-path (first o0) (first o2) + %referrer-node-type))) + (return (list (map (node-type-label %reference-node-type) path) + (map (node-type-label %referrer-node-type) rpath)))))) + (test-end "graph") From patchwork Sat May 9 23:27:39 2020 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: 21963 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 1914027BBE3; Sun, 10 May 2020 00:28:11 +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,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 ESMTP id 296CB27BBE1 for ; Sun, 10 May 2020 00:28:10 +0100 (BST) Received: from localhost ([::1]:49870 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXYt7-00077W-Nc for patchwork@mira.cbaines.net; Sat, 09 May 2020 19:28:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:50736) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jXYt1-00075V-Js for guix-patches@gnu.org; Sat, 09 May 2020 19:28:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:37044) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jXYt1-00081k-BD for guix-patches@gnu.org; Sat, 09 May 2020 19:28:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jXYt1-00055f-8G for guix-patches@gnu.org; Sat, 09 May 2020 19:28:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41164] [PATCH 3/3] guix graph: Add '--path'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 09 May 2020 23:28:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41164 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41164@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 41164-submit@debbugs.gnu.org id=B41164.158906687819541 (code B ref 41164); Sat, 09 May 2020 23:28:03 +0000 Received: (at 41164) by debbugs.gnu.org; 9 May 2020 23:27:58 +0000 Received: from localhost ([127.0.0.1]:48588 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXYsv-000556-N2 for submit@debbugs.gnu.org; Sat, 09 May 2020 19:27:58 -0400 Received: from eggs.gnu.org ([209.51.188.92]:47718) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jXYss-00054T-4q for 41164@debbugs.gnu.org; Sat, 09 May 2020 19:27:54 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:34095) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jXYsm-0007EV-UI; Sat, 09 May 2020 19:27:48 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=40868 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jXYsl-00020y-U1; Sat, 09 May 2020 19:27:48 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 10 May 2020 01:27:39 +0200 Message-Id: <20200509232739.29016-3-ludo@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200509232739.29016-1-ludo@gnu.org> References: <20200509232739.29016-1-ludo@gnu.org> 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 * guix/scripts/graph.scm (display-path): New procedure. (%options, show-help): Add '--path'. (guix-graph): Handle it. * tests/guix-graph.sh: Add tests. * doc/guix.texi (Invoking guix graph): Document it. (Invoking guix size): Mention it. --- doc/guix.texi | 48 ++++++++++++++++++++++++++++++++++++++++-- guix/scripts/graph.scm | 46 +++++++++++++++++++++++++++++++++++----- tests/guix-graph.sh | 16 +++++++++++++- 3 files changed, 102 insertions(+), 8 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 2ed545847b..e174e13887 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10021,6 +10021,12 @@ In this example we see that the combination of the four packages takes 102.3@tie{}MiB in total, which is much less than the sum of each closure since they have a lot of dependencies in common. +When looking at the profile returned by @command{guix size}, you may +find yourself wondering why a given package shows up in the profile at +all. To understand it, you can use @command{guix graph --path -t +references} to display the shortest path between the two packages +(@pxref{Invoking guix graph}). + The available options are: @table @option @@ -10081,8 +10087,9 @@ directly to the @command{dot} command of Graphviz. It can also emit an HTML page with embedded JavaScript code to display a ``chord diagram'' in a Web browser, using the @uref{https://d3js.org/, d3.js} library, or emit Cypher queries to construct a graph in a graph database supporting -the @uref{https://www.opencypher.org/, openCypher} query language. -The general syntax is: +the @uref{https://www.opencypher.org/, openCypher} query language. With +@option{--path}, it simply displays the shortest path between two +packages. The general syntax is: @example guix graph @var{options} @var{package}@dots{} @@ -10228,6 +10235,29 @@ collected. @end table +@cindex shortest path, between packages +Often, the graph of the package you are interested in does not fit on +your screen, and anyway all you want to know is @emph{why} that package +actually depends on some seemingly unrelated package. The +@option{--path} option instructs @command{guix graph} to display the +shortest path between two packages (or derivations, or store items, +etc.): + +@example +$ guix graph --path emacs libunistring +emacs@@26.3 +mailutils@@3.9 +libunistring@@0.9.10 +$ guix graph --path -t derivation emacs libunistring +/gnu/store/@dots{}-emacs-26.3.drv +/gnu/store/@dots{}-mailutils-3.9.drv +/gnu/store/@dots{}-libunistring-0.9.10.drv +$ guix graph --path -t references emacs libunistring +/gnu/store/@dots{}-emacs-26.3 +/gnu/store/@dots{}-libidn2-2.2.0 +/gnu/store/@dots{}-libunistring-0.9.10 +@end example + The available options are the following: @table @option @@ -10248,6 +10278,20 @@ List the supported graph backends. Currently, the available backends are Graphviz and d3.js. +@item --path +Display the shortest path between two nodes of the type specified by +@option{--type}. The example below shows the shortest path between +@code{libreoffice} and @code{llvm} according to the references of +@code{libreoffice}: + +@example +$ guix graph --path -t references libreoffice llvm +/gnu/store/@dots{}-libreoffice-6.4.2.2 +/gnu/store/@dots{}-libepoxy-1.5.4 +/gnu/store/@dots{}-mesa-19.3.4 +/gnu/store/@dots{}-llvm-9.0.1 +@end example + @item --expression=@var{expr} @itemx -e @var{expr} Consider the package @var{expr} evaluates to. diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index d69dace14f..1d5db3b3cb 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -455,6 +455,29 @@ package modules, while attempting to retain user package modules." (graph-backend-description backend))) %graph-backends)) + +;;; +;;; Displaying a path. +;;; + +(define (display-path node1 node2 type) + "Display the shortest path from NODE1 to NODE2, of TYPE." + (mlet %store-monad ((path (shortest-path node1 node2 type))) + (define node-label + (let ((label (node-type-label type))) + ;; Special-case derivations and store items to print them in full, + ;; contrary to what their 'node-type-label' normally does. + (match-lambda + ((? derivation? drv) (derivation-file-name drv)) + ((? string? str) str) + (node (label node))))) + + (if path + (format #t "~{~a~%~}" (map node-label path)) + (leave (G_ "no path from '~a' to '~a'~%") + (node-label node1) (node-label node2))) + (return #t))) + ;;; ;;; Command-line options. @@ -465,6 +488,9 @@ package modules, while attempting to retain user package modules." (lambda (opt name arg result) (alist-cons 'node-type (lookup-node-type arg) result))) + (option '("path") #f #f + (lambda (opt name arg result) + (alist-cons 'path? #t result))) (option '("list-types") #f #f (lambda (opt name arg result) (list-node-types) @@ -510,6 +536,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_ " + --path display the shortest path between the given nodes")) (display (G_ " -e, --expression=EXPR consider the package EXPR evaluates to")) (display (G_ " @@ -566,11 +594,19 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (mlet %store-monad ((_ (set-grafting #f)) (nodes (mapm %store-monad (node-type-convert type) - items))) - (export-graph (concatenate nodes) - (current-output-port) - #:node-type type - #:backend backend)) + (reverse items)))) + (if (assoc-ref opts 'path?) + (match nodes + (((node1 _ ...) (node2 _ ...)) + (display-path node1 node2 type)) + (_ + (leave (G_ "'--path' option requires exactly two \ +nodes (given ~a)~%") + (length nodes)))) + (export-graph (concatenate nodes) + (current-output-port) + #:node-type type + #:backend backend))) #:system (assq-ref opts 'system))))) #t) diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index 4c37b61b38..ccb4933c88 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015, 2016, 2019 Ludovic Courtès +# Copyright © 2015, 2016, 2019, 2020 Ludovic Courtès # Copyright © 2019 Simon Tournier # # This file is part of GNU Guix. @@ -82,3 +82,17 @@ then false; else true; fi # Try --load-path guix graph -L $module_dir dummy | grep 'label = "dummy' + +# Displaying shortest paths (or lack thereof). +if guix graph --path emacs vim; then false; else true; fi + +path="\ +emacs +gnutls +guile +libffi" +test "`guix graph --path emacs libffi | cut -d '@' -f1`" = "$path" + +# At the derivation level, there's a direct path because libffi is propagated +# via gtk+. +test "`guix graph --path -t derivation emacs libffi | wc -l`" -ge 2