mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
516e3b6f7a
commit
7d193ec348
4 changed files with 156 additions and 30 deletions
|
@ -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
|
||||
|
|
|
@ -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 @@ (define-module (gnu packages)
|
|||
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 @@ (define (find-best-packages-by-name name 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))))
|
||||
|
|
|
@ -75,6 +75,7 @@ (define-module (guix packages)
|
|||
package-location
|
||||
package-field-location
|
||||
|
||||
package-direct-inputs
|
||||
package-transitive-inputs
|
||||
package-transitive-target-inputs
|
||||
package-transitive-native-inputs
|
||||
|
@ -484,12 +485,17 @@ (define (transitive-inputs 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
|
||||
|
|
|
@ -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 @@ (define-module (guix scripts refresh)
|
|||
#: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 @@ (define %options
|
|||
(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 @@ (define (show-help)
|
|||
(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 @@ (define core-package?
|
|||
;; 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 @@ (define core-package?
|
|||
(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))))))
|
||||
|
|
Loading…
Reference in a new issue