01/05: graph: Add the 'reverse-bag' graph.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 2b81eac01e5828c6fce61b3cafc0f78e7a0ab891
Author: Ludovic Courtès <address@hidden>
Date:   Sat Mar 23 15:04:44 2019 +0100

    graph: Add the 'reverse-bag' graph.
    
    Suggested by Julien Lepiller.
    
    * guix/scripts/graph.scm (%reverse-bag-node-type): New variable.
    (%node-types): Add it.
    * tests/graph.scm ("reverse bag DAG"): New test.
    * doc/guix.texi (Invoking guix graph): Document it.
---
 doc/guix.texi          | 18 +++++++++++++++++-
 guix/scripts/graph.scm | 19 ++++++++++++++++++-
 tests/graph.scm        | 28 +++++++++++++++++++++++++++-
 3 files changed, 62 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 94d7a29..8fa714e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9290,7 +9290,9 @@ This shows the @emph{reverse} DAG of packages.  For 
example:
 guix graph --type=reverse-package ocaml
 @end example
 
-...@: yields the graph of packages that depend on OCaml.
+...@: yields the graph of packages that @emph{explicitly} depend on OCaml (if
+you are also interested in cases where OCaml is an implicit dependency, see
address@hidden below.)
 
 Note that for core packages this can yield huge graphs.  If all you want
 is to know the number of packages that depend on a given package, use
@@ -9324,6 +9326,20 @@ dependencies.
 @item bag-with-origins
 Similar to @code{bag}, but also showing origins and their dependencies.
 
address@hidden reverse-bag
+This shows the @emph{reverse} DAG of packages.  Unlike @code{reverse-package},
+it also takes implicit dependencies into account.  For example:
+
address@hidden
+guix graph -t reverse-bag dune
address@hidden example
+
address@hidden
+...@: yields the graph of all packages that depend on Dune, directly or
+indirectly.  Since Dune is an @emph{implicit} dependency of many packages
address@hidden @code{dune-build-system}, this shows a large number of packages,
+whereas @code{reverse-package} would show very few if any.
+
 @item derivation
 This is the most detailed representation: It shows the DAG of
 derivations (@pxref{Derivations}) and plain store items.  Compared to
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 8efeef3..d0d353f 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,6 +43,7 @@
             %bag-node-type
             %bag-with-origins-node-type
             %bag-emerged-node-type
+            %reverse-bag-node-type
             %derivation-node-type
             %reference-node-type
             %referrer-node-type
@@ -219,6 +220,21 @@ GNU-BUILD-SYSTEM have zero dependencies."
                           bag-node-edges-sans-bootstrap)
                  %store-monad))))
 
+(define %reverse-bag-node-type
+  ;; Type for the reverse traversal of package nodes via the "bag"
+  ;; representation, which includes implicit inputs.
+  (let* ((packages   (delay (package-closure (fold-packages cons '()))))
+         (back-edges (delay (run-with-store #f    ;store not actually needed
+                              (node-back-edges %bag-node-type
+                                               (force packages))))))
+    (node-type
+     (name "reverse-bag")
+     (description "the reverse DAG of packages, including implicit inputs")
+     (convert nodes-from-package)
+     (identifier bag-node-identifier)
+     (label node-full-name)
+     (edges (lift1 (force back-edges) %store-monad)))))
+
 
 ;;;
 ;;; Derivation DAG.
@@ -375,6 +391,7 @@ package modules, while attempting to retain user package 
modules."
         %bag-node-type
         %bag-with-origins-node-type
         %bag-emerged-node-type
+        %reverse-bag-node-type
         %derivation-node-type
         %reference-node-type
         %referrer-node-type
diff --git a/tests/graph.scm b/tests/graph.scm
index 4799d3b..c4c5096 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 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -191,6 +191,32 @@ edges."
                                 (string=? target (derivation-file-name g)))))
                         edges)))))))))
 
+(test-assert "reverse bag DAG"
+  (let-values (((dune bap ocaml-base)
+                (values (specification->package "dune")
+                        (specification->package "bap")
+                        (specification->package "ocaml-base")))
+               ((backend nodes+edges) (make-recording-backend)))
+    (run-with-store %store
+      (export-graph (list dune) 'port
+                    #:node-type %reverse-bag-node-type
+                    #:backend backend))
+
+    (run-with-store %store
+      (mlet %store-monad ((dune-drv       (package->derivation dune))
+                          (bap-drv        (package->derivation bap))
+                          (ocaml-base-drv (package->derivation ocaml-base)))
+        ;; OCAML-BASE uses 'dune-build-system' so DUNE is a direct dependency.
+        ;; BAP is much higher in the stack but it should be there.
+        (let-values (((nodes edges) (nodes+edges)))
+          (return
+           (and (member `(,(derivation-file-name bap-drv)
+                          ,(package-full-name bap))
+                        nodes)
+                (->bool (member (map derivation-file-name
+                                     (list dune-drv ocaml-base-drv))
+                                edges)))))))))
+
 (test-assert "derivation DAG"
   (let-values (((backend nodes+edges) (make-recording-backend)))
     (run-with-store %store