nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Eric Bavier 2014-07-20 11:29:48 -05:00
parent 516e3b6f7a
commit 7d193ec348
4 changed files with 156 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
doc/guix.texi
View File

@ -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

66
gnu/packages.scm
View File

@ -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))))

12
guix/packages.scm
View File

@ -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

83
guix/scripts/refresh.scm
View File

@ -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))))))