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.
This commit is contained in:
Ludovic Courtès 2016-05-23 22:24:02 +02:00
parent 88ac650c7b
commit 9a6beb3b7f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 60 additions and 57 deletions

View File

@ -258,8 +258,6 @@ downloaded and authenticated; not updating~%")
(define (list-dependents packages) (define (list-dependents packages)
"List all the things that would need to be rebuilt if PACKAGES are changed." "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 ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE
;; because it includes implicit dependencies. ;; because it includes implicit dependencies.
(mlet %store-monad ((edges (node-back-edges %bag-node-type (mlet %store-monad ((edges (node-back-edges %bag-node-type
@ -289,7 +287,7 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
(length covering)) (length covering))
(length covering) (length dependents) (length covering) (length dependents)
(map package-full-name covering)))) (map package-full-name covering))))
(return #t)))))) (return #t))))
;;; ;;;
@ -381,11 +379,12 @@ update would trigger a complete rebuild."
(some ; user-specified packages (some ; user-specified packages
some)))) some))))
(with-error-handling (with-error-handling
(with-store store
(run-with-store store
(cond (cond
(list-dependent? (list-dependent?
(list-dependents packages)) (list-dependents packages))
(update? (update?
(let ((store (open-connection)))
(parameterize ((%openpgp-key-server (parameterize ((%openpgp-key-server
(or (assoc-ref opts 'key-server) (or (assoc-ref opts 'key-server)
(%openpgp-key-server))) (%openpgp-key-server)))
@ -395,7 +394,9 @@ update would trigger a complete rebuild."
(for-each (for-each
(cut update-package store <> updaters (cut update-package store <> updaters
#:key-download key-download) #:key-download key-download)
packages)))) packages)
(with-monad %store-monad
(return #t))))
(else (else
(for-each (lambda (package) (for-each (lambda (package)
(match (package-update-path package updaters) (match (package-update-path package updaters)
@ -408,4 +409,6 @@ update would trigger a complete rebuild."
(package-name package) (package-version package) (package-name package) (package-version package)
(upstream-source-version source)))) (upstream-source-version source))))
(#f #f))) (#f #f)))
packages)))))) packages)
(with-monad %store-monad
(return #t)))))))))