[bug#74542] [PATCH v2 06/16] guix build: Add ‘--dependents’.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/scripts/build.scm (show-help, %options): Add ‘--dependents’.
(dependents): New procedure.
(options->things-to-build): Add ‘store’ parameter; honor ‘dependents’
option.
[for-type]: Handle ‘dependents’ type.
(options->derivations): Update call to ‘options->things-to-build’.
* tests/guix-build.sh: Add test.
* doc/guix.texi (Additional Build Options): Document ‘--dependents’.
(Invoking guix refresh): Cross-reference it.
* doc/contributing.texi (Submitting Patches): Mention it.

Change-Id: I00b6d5831e1f1d35dc8b84a82605391d5a8f417c
---
 doc/contributing.texi  |  4 ++-
 doc/guix.texi          | 27 ++++++++++++++++++++
 guix/scripts/build.scm | 56 ++++++++++++++++++++++++++++++++++++++++--
 tests/guix-build.sh    |  6 +++++
 4 files changed, 90 insertions(+), 3 deletions(-)

diff --git a/doc/contributing.texi b/doc/contributing.texi
index b063169189..5a778466d7 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -1914,7 +1914,9 @@ Submitting Patches
 
 @item
 Make sure the package builds on your platform, using @command{guix build
-@var{package}}.
+@var{package}}.  Also build at least its direct dependents with
+@command{guix build --dependents=1 @var{package}}
+(@pxref{build-dependents, @command{guix build}}).
 
 @item
 We recommend you also try building the package on other supported
diff --git a/doc/guix.texi b/doc/guix.texi
index a9d0d044ae..219f19f2d6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13639,6 +13639,31 @@ Additional Build Options
 natively.
 @end quotation
 
+@cindex dependents of a package, building them
+@cindex building the dependents of a package
+@anchor{build-dependents}
+@item --dependents[=@var{depth}]
+@itemx -P [@var{depth}]
+Build the dependents of the following package.  By default, build all
+the direct and indirect dependents; when @var{depth} is provided, limit
+to dependents at that distance: 1 for direct dependents, 2 for
+dependents of dependents, and so on.
+
+For example, the command below builds @emph{all} the dependents of libgit2:
+
+@example
+guix build --dependents libgit2
+@end example
+
+To build all the packages that directly depend on NumPy, run:
+
+@example
+guix build -P1 python-numpy
+@end example
+
+The list of dependents is computed in the same way as with @command{guix
+refresh --list-dependent} (@pxref{Invoking guix refresh}).
+
 @item --source
 @itemx -S
 Build the source derivations of the packages, rather than the packages
@@ -15142,6 +15167,8 @@ Invoking guix refresh
 @command{guix graph}}, for information on how to visualize the list of
 dependents of a package.
 
+@xref{build-dependents, @command{guix build --dependents}}, for a
+convenient way to build all the dependents of a package.
 @end table
 
 Be aware that the @option{--list-dependent} option only
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index e8384c8d2d..5c93dc78f8 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -33,6 +33,9 @@ (define-module (guix scripts build)
   #:use-module (guix profiles)
   #:use-module (guix diagnostics)
   #:autoload   (guix http-client) (http-fetch http-get-error?)
+  #:autoload   (guix scripts graph) (%bag-node-type)
+  #:autoload   (guix graph) (node-back-edges)
+  #:autoload   (guix sets) (setq set-contains? set-insert)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -440,6 +443,9 @@ (define (show-help)
   (display (G_ "
   -D, --development      build the inputs of the following package"))
   (display (G_ "
+  -P, --dependents[=N]   build dependents of the following package, up to
+                         depth N"))
+  (display (G_ "
   -S, --source           build the packages' source derivations"))
   (display (G_ "
       --sources[=TYPE]   build source derivations; TYPE may optionally be one
@@ -527,6 +533,11 @@ (define %options
          (option '(#\D "development") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'development? #t result)))
+         (option '(#\P "dependents") #f #t
+                 (lambda (opt name arg result)
+                   (alist-cons 'dependents
+                               (or (and=> arg string->number*) +inf.0)
+                               result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
@@ -551,7 +562,39 @@ (define %options
                  %standard-cross-build-options
                  %standard-native-build-options)))
 
-(define (options->things-to-build opts)
+(define (dependents store packages max-depth)
+  "List all the things that would need to be rebuilt if PACKAGES are changed."
+  ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
+  ;; because it includes implicit dependencies.
+  (define (get-dependents packages edges)
+    (let loop ((packages packages)
+               (result '())
+               (depth 0)
+               (visited (setq)))
+      (if (> depth max-depth)
+          (values result visited)
+          (match packages
+            (()
+             (values result visited))
+            ((head . tail)
+             (if (set-contains? visited head)
+                 (loop tail result depth visited)
+                 (let ((next (edges head)))
+                   (call-with-values
+                       (lambda ()
+                         (loop next
+                               (cons head result)
+                               (+ depth 1)
+                               (set-insert head visited)))
+                     (lambda (result visited)
+                       (loop tail result depth visited))))))))))
+
+  (with-store store
+    (run-with-store store
+      (mlet %store-monad ((edges (node-back-edges %bag-node-type (all-packages))))
+        (return (get-dependents packages edges))))))
+
+(define (options->things-to-build store opts)
   "Read the arguments from OPTS and return a list of high-level objects to
 build---packages, gexps, derivations, and so on."
   (define (validate-type x)
@@ -600,6 +643,13 @@ (define-public my-package
       (match type
         ('regular
          (list obj))
+        (('dependents . depth)
+         (if (package? obj)
+             (begin
+               (info (G_ "computing dependents of package ~a...~%")
+                     (package-full-name obj))
+               (dependents store (list obj) depth))
+             (list obj)))
         ('development
          (if (package? obj)
              (map manifest-entry-item
@@ -661,6 +711,8 @@ (define-public my-package
                         result)))
          (('development? . #t)
           (loop tail 'development result))
+         (('dependents . depth)
+          (loop tail `(dependents . ,depth) result))
          (_
           (loop tail type result)))))))
 
@@ -687,7 +739,7 @@ (define (options->derivations store opts)
       (systems systems)))
 
   (define things-to-build
-    (map transform (options->things-to-build opts)))
+    (map transform (options->things-to-build store opts)))
 
   (define warn-if-unsupported
     (let ((target (assoc-ref opts 'target)))
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 3637bcdeb3..8707ed32c0 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -196,6 +196,12 @@ test `guix build -D hello -d \
       | grep -e 'glibc.*\.drv$' -e 'gcc.*\.drv$' -e 'binutils.*\.drv$' \
       | wc -l` -ge 3
 
+# Building the dependents.
+test `guix build -P1 libgit2 -P1 libssh -d \
+      | grep -e 'guile-git.*\.drv$' -e 'guile-ssh.*\.drv$' \
+             -e 'libgit2.*\.drv$' -e 'libssh.*\.drv$' \
+      | wc -l` -eq 4
+
 # Unbound variable in thunked field.
 cat > "$module_dir/foo.scm" <<EOF
 (define-module (foo)
-- 
2.46.0