From a51cbecb44d0bf87647576ec75d857138e14b0a8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 21 Nov 2015 16:14:34 +0100
Subject: refresh: Rewrite '--list-dependent' in terms of (guix graph).

* guix/scripts/refresh.scm (all-packages, list-dependents): New
procedures.
(guix-refresh): Use it.
---
 guix/scripts/refresh.scm | 71 ++++++++++++++++++++++++++++++++----------------
 1 file changed, 48 insertions(+), 23 deletions(-)

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 3161aacfe2..c9eff7ba67 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -27,6 +27,9 @@ (define-module (guix scripts refresh)
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix upstream)
+  #:use-module (guix graph)
+  #:use-module (guix scripts graph)
+  #:use-module (guix monads)
   #:use-module ((guix gnu-maintenance) #:select (%gnu-updater))
   #:use-module (guix import elpa)
   #:use-module (guix import cran)
@@ -228,6 +231,50 @@ (define* (update-package store package updaters
 downloaded and authenticated; not updating~%")
                    (package-name package) version)))))
 
+
+;;;
+;;; Dependents.
+;;;
+
+(define (all-packages)
+  "Return the list of all the distro's packages."
+  (fold-packages cons '()))
+
+(define (list-dependents packages)
+  "List all the things that would need to be rebuilt if PACKAGES are changed."
+  (with-store store
+    (run-with-store store
+      ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
+      ;; because it includes implicit dependencies.
+      (mlet %store-monad ((edges (node-back-edges %bag-node-type
+                                                  (all-packages))))
+        (let* ((dependents (node-transitive-edges packages edges))
+               (covering   (filter (lambda (node)
+                                     (null? (edges node)))
+                                   dependents)))
+          (match dependents
+            (()
+             (format (current-output-port)
+                     (N_ "No dependents other than itself: ~{~a~}~%"
+                         "No dependents other than themselves: ~{~a~^ ~}~%"
+                         (length packages))
+                     (map package-full-name packages)))
+
+            ((x)
+             (format (current-output-port)
+                     (_ "A single dependent package: ~a~%")
+                     (package-full-name x)))
+            (lst
+             (format (current-output-port)
+                     (N_ "Building the following package would ensure ~d \
+dependent packages are rebuilt: ~*~{~a~^ ~}~%"
+                         "Building the following ~d packages would ensure ~d \
+dependent packages are rebuilt: ~{~a~^ ~}~%"
+                         (length covering))
+                     (length covering) (length dependents)
+                     (map package-full-name covering))))
+          (return #t))))))
+
 
 ;;;
 ;;; Entry point.
@@ -318,29 +365,7 @@ (define core-package?
     (with-error-handling
       (cond
        (list-dependent?
-        (let* ((rebuilds (map package-full-name
-                              (package-covering-dependents packages)))
-               (total-dependents
-                (length (package-transitive-dependents packages))))
-          (cond ((= total-dependents 0)
-                 (format (current-output-port)
-                         (N_ "No dependents other than itself: ~{~a~}~%"
-                             "No dependents other than themselves: ~{~a~^ ~}~%"
-                             (length packages))
-                         (map package-full-name packages)))
-
-                ((= total-dependents 1)
-                 (format (current-output-port)
-                         (_ "A single dependent package: ~{~a~}~%")
-                         rebuilds))
-                (else
-                 (format (current-output-port)
-                         (N_ "Building the following package would ensure ~d \
-dependent packages are rebuilt: ~*~{~a~^ ~}~%"
-                             "Building the following ~d packages would ensure ~d \
-dependent packages are rebuilt: ~{~a~^ ~}~%"
-                          (length rebuilds))
-                         (length rebuilds) total-dependents rebuilds)))))
+        (list-dependents packages))
        (update?
         (let ((store (open-connection)))
           (parameterize ((%openpgp-key-server
-- 
cgit v1.2.3