summaryrefslogtreecommitdiff
path: root/guix/scripts/refresh.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-21 16:14:34 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-21 16:27:34 +0100
commita51cbecb44d0bf87647576ec75d857138e14b0a8 (patch)
tree866b1fb611cb542dffa486073ed4b877f4b4c4ee /guix/scripts/refresh.scm
parent923d846c4dfe0f51357d3329697f54c779148dde (diff)
refresh: Rewrite '--list-dependent' in terms of (guix graph).
* guix/scripts/refresh.scm (all-packages, list-dependents): New procedures. (guix-refresh): Use it.
Diffstat (limited to 'guix/scripts/refresh.scm')
-rw-r--r--guix/scripts/refresh.scm71
1 files 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 @@
#: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)
@@ -230,6 +233,50 @@ downloaded and authenticated; not updating~%")
;;;
+;;; 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 @@ update would trigger a complete rebuild."
(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