TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

refresh: Rewrite '--list-dependent' in terms of (guix graph). 

* guix/scripts/refresh.scm (all-packages, list-dependents): New
procedures.
(guix-refresh): Use it.
This commit is contained in:
Ludovic Courtès 2015-11-21 16:14:34 +01:00
parent 923d846c4d
commit a51cbecb44
1 changed files with 48 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
guix/scripts/refresh.scm
View File

@ -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)
@ -228,6 +231,50 @@ values: 'interactive' (default), 'always', and 'never'."
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 @@ 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