summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorEric Bavier <bavier@member.fsf.org>2014-07-20 11:29:48 -0500
committerEric Bavier <bavier@member.fsf.org>2014-07-20 11:36:09 -0500
commit7d193ec34881843573a8013163347cfd8b1e9001 (patch)
tree5bbcc39c2ef9c23c096e289e1803f50977d793e5 /guix
parent516e3b6f7a57f6b6f378c9174f8c5ffc990df7db (diff)
guix: refresh: Add --list-dependent option.
* guix/packages.scm (package-direct-inputs): New procedure. * gnu/packages.scm (vhash-refq, package-direct-dependents) (package-transitive-dependents, package-covering-dependents): New procedures. * guix/scripts/refresh.scm (%options, show-help, guix-refresh): Add --list-dependent option. * doc/guix.texi (Invoking guix refresh): Document '--list-dependent' option.
Diffstat (limited to 'guix')
-rw-r--r--guix/packages.scm12
-rw-r--r--guix/scripts/refresh.scm83
2 files changed, 66 insertions, 29 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 985a573fd3..5c3da9f2ff 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -75,6 +75,7 @@
package-location
package-field-location
+ package-direct-inputs
package-transitive-inputs
package-transitive-target-inputs
package-transitive-native-inputs
@@ -484,12 +485,17 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
((input rest ...)
(loop rest (cons input result))))))
+(define (package-direct-inputs package)
+ "Return all the direct inputs of PACKAGE---i.e, its direct inputs along
+with their propagated inputs."
+ (append (package-native-inputs package)
+ (package-inputs package)
+ (package-propagated-inputs package)))
+
(define (package-transitive-inputs package)
"Return the transitive inputs of PACKAGE---i.e., its direct inputs along
with their propagated inputs, recursively."
- (transitive-inputs (append (package-native-inputs package)
- (package-inputs package)
- (package-propagated-inputs package))))
+ (transitive-inputs (package-direct-inputs package)))
(define (package-transitive-target-inputs package)
"Return the transitive target inputs of PACKAGE---i.e., its direct inputs
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index af7beb748b..17d75b33ca 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,6 +30,7 @@
#:use-module ((gnu packages base) #:select (%final-inputs))
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
+ #:use-module (ice-9 vlist)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -59,6 +61,9 @@
(x
(leave (_ "~a: invalid selection; expected `core' or `non-core'")
arg)))))
+ (option '(#\l "list-dependent") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'list-dependent? #t result)))
(option '("key-server") #t #f
(lambda (opt name arg result)
@@ -96,6 +101,9 @@ specified with `--select'.\n"))
(display (_ "
-s, --select=SUBSET select all the packages in SUBSET, one of
`core' or `non-core'"))
+ (display (_ "
+ -l, --list-dependent list top-level dependent packages that would need to
+ be rebuilt as a result of upgrading PACKAGE..."))
(newline)
(display (_ "
--key-server=HOST use HOST as the OpenPGP key server"))
@@ -193,9 +201,10 @@ update would trigger a complete rebuild."
;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input.
(member (package-name package) names))))
- (let* ((opts (parse-options))
- (update? (assoc-ref opts 'update?))
- (key-download (assoc-ref opts 'key-download))
+ (let* ((opts (parse-options))
+ (update? (assoc-ref opts 'update?))
+ (list-dependent? (assoc-ref opts 'list-dependent?))
+ (key-download (assoc-ref opts 'key-download))
(packages
(match (concatenate
(filter-map (match-lambda
@@ -220,26 +229,48 @@ update would trigger a complete rebuild."
(some ; user-specified packages
some))))
(with-error-handling
- (if 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 <> #:key-download key-download)
- packages)))
- (for-each (lambda (package)
- (match (false-if-exception (package-update-path package))
- ((new-version . directory)
- (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)
- new-version)))
- (_ #f)))
- packages)))))
+ (cond
+ (list-dependent?
+ (let* ((rebuilds (map package-full-name
+ (package-covering-dependents packages)))
+ (total-dependents
+ (length (package-transitive-dependents packages))))
+ (if (= 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))
+ (format (current-output-port)
+ (N_ (N_ "A single dependent package: ~2*~{~a~}~%"
+ "Building the following package would ensure ~d \
+dependent packages are rebuilt; ~*~{~a~^ ~}~%"
+ total-dependents)
+ "Building the following ~d packages would ensure ~d \
+dependent packages are rebuilt: ~{~a~^ ~}~%"
+ (length rebuilds))
+ (length rebuilds) total-dependents rebuilds))))
+ (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 <> #:key-download key-download)
+ packages))))
+ (else
+ (for-each (lambda (package)
+ (match (false-if-exception (package-update-path package))
+ ((new-version . directory)
+ (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)
+ new-version)))
+ (_ #f)))
+ packages))))))