* 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.
@code{idutils} packages. The @code{--select} option would have no
effect in this case.
+When considering whether to upgrade a package, it is sometimes
+convenient to know which packages would be affected by the upgrade and
+should be checked for compatibility. For this the following option may
+be used when passing @command{guix refresh} one or more package names:
+
+@table @code
+
+@item --list-dependent
+@itemx -l
+List top-level dependent packages that would need to be rebuilt as a
+result of upgrading one or more packages.
+
+@end table
+
+Be aware that the @code{--list-dependent} option only
+@emph{approximates} the rebuilds that would be required as a result of
+an upgrade. More rebuilds might be required under some circumstances.
+
+@example
+guix refresh --list-dependent flex
+@end example
+
+The command above lists a set of packages that could be built to check
+for compatibility with an upgraded @code{flex} package.
+
The following options can be used to customize GnuPG operation:
@table @code
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
search-bootstrap-binary
%patch-directory
%bootstrap-binaries-path
+
fold-packages
+
find-packages-by-name
find-best-packages-by-name
- find-newest-available-packages))
+ find-newest-available-packages
+
+ package-direct-dependents
+ package-transitive-dependents
+ package-covering-dependents))
;;; Commentary:
;;;
(match (vhash-assoc name (find-newest-available-packages))
((_ version pkgs ...) pkgs)
(#f '()))))
+
+\f
+(define* (vhash-refq vhash key #:optional (dflt #f))
+ "Look up KEY in the vhash VHASH, and return the value (if any) associated
+with it. If KEY is not found, return DFLT (or `#f' if no DFLT argument is
+supplied). Uses `eq?' for equality testing."
+ (or (and=> (vhash-assq key vhash) cdr)
+ dflt))
+
+(define package-dependencies
+ (memoize
+ (lambda ()
+ "Return a vhash keyed by package, and with associated values that are a
+list of packages that depend on that package."
+ (fold-packages
+ (lambda (package dag)
+ (fold
+ (lambda (in d)
+ ;; Insert a graph edge from each of package's inputs to package.
+ (vhash-consq in
+ (cons package (vhash-refq d in '()))
+ (vhash-delq in d)))
+ dag
+ (match (package-direct-inputs package)
+ (((labels packages . _) ...)
+ packages) )))
+ vlist-null))))
+
+(define (package-direct-dependents packages)
+ "Return a list of packages from the distribution that directly depend on the
+packages in PACKAGES."
+ (delete-duplicates
+ (concatenate
+ (map (lambda (p)
+ (vhash-refq (package-dependencies) p '()))
+ packages))))
+
+(define (package-transitive-dependents packages)
+ "Return the transitive dependent packages of the distribution packages in
+PACKAGES---i.e. the dependents of those packages, plus their dependents,
+recursively."
+ (let ((dependency-dag (package-dependencies)))
+ (fold-tree
+ cons '()
+ (lambda (node) (vhash-refq dependency-dag node))
+ ;; Start with the dependents to avoid including PACKAGES in the result.
+ (package-direct-dependents packages))))
+
+(define (package-covering-dependents packages)
+ "Return a minimal list of packages from the distribution whose dependencies
+include all of PACKAGES and all packages that depend on PACKAGES."
+ (let ((dependency-dag (package-dependencies)))
+ (fold-tree-leaves
+ cons '()
+ (lambda (node) (vhash-refq dependency-dag node))
+ ;; Start with the dependents to avoid including PACKAGES in the result.
+ (package-direct-dependents packages))))
package-location
package-field-location
+ package-direct-inputs
package-transitive-inputs
package-transitive-target-inputs
package-transitive-native-inputs
((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
;;; 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.
;;;
#: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)
(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)
(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"))
;; 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
(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))))))
HCoop / jackhill / guix / guix.git / commitdiff