summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-05-23 22:24:02 +0200
committerLudovic Courtès <ludo@gnu.org>2016-05-24 00:06:01 +0200
commit9a6beb3b7ff3dad280b27a263869e233f3ac8336 (patch)
tree2d208d0ed4d36431944b535eb526c433597f5e86 /guix
parent88ac650c7b00109299db8805d5606cb20b1ed6fa (diff)
refresh: Make 'list-dependents' a monadic procedure.
* guix/scripts/refresh.scm (list-dependents): Remove use of 'with-store' and 'run-with-store'. (guix-refresh): Wrap body in with-store/run-with-store.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/refresh.scm117
1 files changed, 60 insertions, 57 deletions
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 0efc190b22..209f0d8be9 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -258,38 +258,36 @@ downloaded and authenticated; not updating~%")
(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)))
+ ;; 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 \
+ ((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 \
+ "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))))))
+ (length covering))
+ (length covering) (length dependents)
+ (map package-full-name covering))))
+ (return #t))))
;;;
@@ -381,31 +379,36 @@ update would trigger a complete rebuild."
(some ; user-specified packages
some))))
(with-error-handling
- (cond
- (list-dependent?
- (list-dependents packages))
- (update?
- (let ((store (open-connection)))
- (parameterize ((%openpgp-key-server
- (or (assoc-ref opts 'key-server)
- (%openpgp-key-server)))
- (%gpg-command
- (or (assoc-ref opts 'gpg-command)
- (%gpg-command))))
- (for-each
- (cut update-package store <> updaters
- #:key-download key-download)
- packages))))
- (else
- (for-each (lambda (package)
- (match (package-update-path package updaters)
- ((? upstream-source? source)
- (let ((loc (or (package-field-location package 'version)
- (package-location package))))
- (format (current-error-port)
- (_ "~a: ~a would be upgraded from ~a to ~a~%")
- (location->string loc)
- (package-name package) (package-version package)
- (upstream-source-version source))))
- (#f #f)))
- packages))))))
+ (with-store store
+ (run-with-store store
+ (cond
+ (list-dependent?
+ (list-dependents packages))
+ (update?
+ (parameterize ((%openpgp-key-server
+ (or (assoc-ref opts 'key-server)
+ (%openpgp-key-server)))
+ (%gpg-command
+ (or (assoc-ref opts 'gpg-command)
+ (%gpg-command))))
+ (for-each
+ (cut update-package store <> updaters
+ #:key-download key-download)
+ packages)
+ (with-monad %store-monad
+ (return #t))))
+ (else
+ (for-each (lambda (package)
+ (match (package-update-path package updaters)
+ ((? upstream-source? source)
+ (let ((loc (or (package-field-location package 'version)
+ (package-location package))))
+ (format (current-error-port)
+ (_ "~a: ~a would be upgraded from ~a to ~a~%")
+ (location->string loc)
+ (package-name package) (package-version package)
+ (upstream-source-version source))))
+ (#f #f)))
+ packages)
+ (with-monad %store-monad
+ (return #t)))))))))