diff options
| -rw-r--r-- | doc/guix.texi | 25 | ||||
| -rw-r--r-- | gnu/packages.scm | 66 | ||||
| -rw-r--r-- | guix/packages.scm | 12 | ||||
| -rw-r--r-- | guix/scripts/refresh.scm | 83 |
4 files changed, 156 insertions, 30 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 5bee540460..8431cbd907 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2545,6 +2545,31 @@ The command above specifically updates the @code{emacs} and @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 diff --git a/gnu/packages.scm b/gnu/packages.scm index 8365a00051..77d9d3ee82 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,6 +1,7 @@ ;;; 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. ;;; @@ -31,10 +32,16 @@ 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: ;;; @@ -182,3 +189,60 @@ VERSION." (match (vhash-assoc name (find-newest-available-packages)) ((_ version pkgs ...) pkgs) (#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)))) 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)))))) |