* [PATCH] guix: refresh: Add --list-dependent option.
@ 2014-07-17 17:51 Eric Bavier
2014-07-18 12:41 ` Ludovic Courtès
0 siblings, 1 reply; 4+ messages in thread
From: Eric Bavier @ 2014-07-17 17:51 UTC (permalink / raw)
To: guix-devel
[-- Attachment #1: Type: text/plain, Size: 85 bytes --]
Comments or suggestions welcome, in particular regarding the format of
the output.
[-- Attachment #2: 0001-guix-refresh-Add-list-dependent-option.patch --]
[-- Type: text/x-diff, Size: 15775 bytes --]
From 57aa3ac9bf0a58c0981fbf729dd12756dedd5831 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Thu, 17 Jul 2014 12:42:01 -0500
Subject: [PATCH] guix: refresh: Add --list-dependent option.
* guix/utils.scm (fold-tree, fold-tree-leaves): New functions.
* tests/utils.scm: Add tests for fold-tree and fold-tree-leaves.
* guix/packages.scm (package-direct-inputs): New procedure.
* gnu/packages.scm (vhash-refq, package-dependencies, package-direct-dependents)
(package-transitive-dependents, package-covering-dependents): New procedures.
* guix/scripts/refresh.scm (%options, show-help, guix-refresh): Add
--list-dependent option.
---
gnu/packages.scm | 65 ++++++++++++++++++++++++++++++++++-
guix/packages.scm | 12 +++++--
guix/scripts/refresh.scm | 85 ++++++++++++++++++++++++++++++++--------------
guix/utils.scm | 33 ++++++++++++++++++
tests/utils.scm | 35 ++++++++++++++++++-
5 files changed, 199 insertions(+), 31 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 8365a00..01710f0 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,17 @@
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-dependencies
+ package-direct-dependents
+ package-transitive-dependents
+ package-covering-dependents))
;;; Commentary:
;;;
@@ -182,3 +190,58 @@ VERSION."
(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
+ (map cadr (package-direct-inputs package))))
+ vlist-null))))
+
+(define (package-direct-dependents . packages)
+ "Return a list of packages 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 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.
+ (apply package-direct-dependents packages))))
+
+(define (package-covering-dependents . packages)
+ "Return a minimal list of packages 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.
+ (apply package-direct-dependents packages))))
diff --git a/guix/packages.scm b/guix/packages.scm
index b413e58..fa2d1e6 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
@@ -473,12 +474,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 c65a7d0..91da70c 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,50 @@ 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
+ (apply package-covering-dependents
+ packages)))
+ ;; Wasteful to build a list merely to get its length, so
+ ;; calculate the length directly.
+ (total-rebuilt
+ (fold-tree
+ (lambda (_ r) (1+ r)) 0
+ (lambda (node)
+ (and=> (vhash-assq node (package-dependencies)) cdr))
+ packages)))
+ (format (current-output-port)
+ (N_ "No dependents other than itself: ~3*~{~a~}~%"
+ (N_ "Building the following package ensures ~*~d \
+dependent packages are rebuilt: ~{~a~^ ~}~%"
+ "Building the following ~d packages would ensure ~d \
+dependent packages are rebuilt: ~{~a~^ ~}~%"
+ (length rebuilds))
+ total-rebuilt)
+ (length rebuilds) total-rebuilt rebuilds
+ (map package-full-name packages))))
+ (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))))))
diff --git a/guix/utils.scm b/guix/utils.scm
index 700a191..b61ff24 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 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.
;;;
@@ -72,6 +73,8 @@
call-with-temporary-output-file
with-atomic-file-output
fold2
+ fold-tree
+ fold-tree-leaves
filtered-port
compressed-port
@@ -649,6 +652,36 @@ output port, and PROC's result is returned."
(lambda (result1 result2)
(fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
+(define (fold-tree proc init children roots)
+ "Call (PROC NODE RESULT) for each node in the tree that is reachable from
+ROOTS, using INIT as the initial value of RESULT. The order in which nodes
+are traversed is not specified, however, each node is visited only once, based
+on an eq? check. Children of a node to be visited are generated by
+calling (CHILDREN NODE), the result of which should be a list of nodes that
+are connected to NODE in the tree, or '() or #f if NODE is a leaf node."
+ (let loop ((result init)
+ (seen vlist-null)
+ (lst roots))
+ (match lst
+ (() result)
+ ((head . tail)
+ (if (not (vhash-assq head seen))
+ (loop (proc head result)
+ (vhash-consq head #t seen)
+ (match (children head)
+ ((or () #f) tail)
+ (children (append tail children))))
+ (loop result seen tail))))))
+
+(define (fold-tree-leaves proc init children roots)
+ "Like fold-tree, but call (PROC NODE RESULT) only for leaf nodes."
+ (fold-tree
+ (lambda (node result)
+ (match (children node)
+ ((or () #f) (proc node result))
+ (else result)))
+ init children roots))
+
\f
;;;
;;; Source location.
diff --git a/tests/utils.scm b/tests/utils.scm
index 8ad399f..611867c 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,7 +26,8 @@
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
- #:use-module (ice-9 match))
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 vlist))
(define temp-file
(string-append "t-utils-" (number->string (getpid))))
@@ -118,6 +120,37 @@
'(0 1 2 3)))
list))
+(let* ((tree (alist->vhash
+ '((0 2 3) (1 3 4) (2) (3 5 6) (4 6) (5) (6))
+ hashq))
+ (add-one (lambda (_ r) (1+ r)))
+ (tree-lookup (lambda (n) (cdr (vhash-assq n tree)))))
+ (test-equal "fold-tree, single root"
+ 5 (fold-tree add-one 0 tree-lookup '(0)))
+ (test-equal "fold-tree, two roots"
+ 7 (fold-tree add-one 0 tree-lookup '(0 1)))
+ (test-equal "fold-tree, sum"
+ 16 (fold-tree + 0 tree-lookup '(0)))
+ (test-equal "fold-tree, internal"
+ 18 (fold-tree + 0 tree-lookup '(3 4)))
+ (test-equal "fold-tree, cons"
+ '(1 3 4 5 6)
+ (sort (fold-tree cons '() tree-lookup '(1)) <))
+ (test-equal "fold-tree, overlapping paths"
+ '(1 3 4 5 6)
+ (sort (fold-tree cons '() tree-lookup '(1 4)) <))
+ (test-equal "fold-tree, cons, two roots"
+ '(0 2 3 4 5 6)
+ (sort (fold-tree cons '() tree-lookup '(0 4)) <))
+ (test-equal "fold-tree-leaves, single root"
+ 2 (fold-tree-leaves add-one 0 tree-lookup '(1)))
+ (test-equal "fold-tree-leaves, single root, sum"
+ 11 (fold-tree-leaves + 0 tree-lookup '(1)))
+ (test-equal "fold-tree-leaves, two roots"
+ 3 (fold-tree-leaves add-one 0 tree-lookup '(0 1)))
+ (test-equal "fold-tree-leaves, two roots, sum"
+ 13 (fold-tree-leaves + 0 tree-lookup '(0 1))))
+
(test-assert "filtered-port, file"
(let* ((file (search-path %load-path "guix.scm"))
(input (open-file file "r0b")))
--
1.7.9.5
[-- Attachment #3: Type: text/plain, Size: 17 bytes --]
--
Eric Bavier
^ permalink raw reply related [flat|nested] 4+ messages in thread
* Re: [PATCH] guix: refresh: Add --list-dependent option.
2014-07-17 17:51 [PATCH] guix: refresh: Add --list-dependent option Eric Bavier
@ 2014-07-18 12:41 ` Ludovic Courtès
2014-07-20 16:39 ` Eric Bavier
0 siblings, 1 reply; 4+ messages in thread
From: Ludovic Courtès @ 2014-07-18 12:41 UTC (permalink / raw)
To: Eric Bavier; +Cc: guix-devel
Eric Bavier <ericbavier@gmail.com> skribis:
> From 57aa3ac9bf0a58c0981fbf729dd12756dedd5831 Mon Sep 17 00:00:00 2001
> From: Eric Bavier <bavier@member.fsf.org>
> Date: Thu, 17 Jul 2014 12:42:01 -0500
> Subject: [PATCH] guix: refresh: Add --list-dependent option.
>
> * guix/utils.scm (fold-tree, fold-tree-leaves): New functions.
> * tests/utils.scm: Add tests for fold-tree and fold-tree-leaves.
> * guix/packages.scm (package-direct-inputs): New procedure.
> * gnu/packages.scm (vhash-refq, package-dependencies, package-direct-dependents)
> (package-transitive-dependents, package-covering-dependents): New procedures.
> * guix/scripts/refresh.scm (%options, show-help, guix-refresh): Add
> --list-dependent option.
Overall looks good to me.
[...]
> + package-dependencies
I would keep this one private.
> + (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
> + (map cadr (package-direct-inputs package))))
> + vlist-null))))
Please replace ‘map cadr’ with:
(match (package-direct-inputs package)
(((labels packages . _) ...)
packages))
> +(define (package-direct-dependents . packages)
> + "Return a list of packages that directly depend on the packages in
“Return a list of packages of the distribution” (to make it clear that
it doesn’t work with any package.)
Also make ‘packages’ a normal parameter rather than a rest parameter.
> +(define (package-transitive-dependents . packages)
Likewise.
> +(define (package-covering-dependents . packages)
Likewise.
> + (display (_ "
> + -l, --list-dependent list top-level dependent packages that would need to
> + be rebuilt as a result of upgrading PACKAGE...."))
^
Extra period here.
Please add it to guix.texi as well.
> + (format (current-output-port)
> + (N_ "No dependents other than itself: ~3*~{~a~}~%"
> + (N_ "Building the following package ensures ~*~d \
> +dependent packages are rebuilt: ~{~a~^ ~}~%"
> + "Building the following ~d packages would ensure ~d \
> +dependent packages are rebuilt: ~{~a~^ ~}~%"
> + (length rebuilds))
> + total-rebuilt)
> + (length rebuilds) total-rebuilt rebuilds
> + (map package-full-name packages))))
Add “would” in the first message.
The message look good to me.
Be aware though that there can be subtle situations that trigger
rebuilds, and are not addressed here (which is a fine approximation
IMO.) For instance, implicit inputs are not taken into account. And
there are things like reuse of sources, as in base.scm where gcc uses
(package-source gmp) and the likes.
Perhaps there should be a sentence of warning in the manual.
Lastly, could you make the util.scm changes a separate patch?
Then I think we’ll be all set.
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH] guix: refresh: Add --list-dependent option.
2014-07-18 12:41 ` Ludovic Courtès
@ 2014-07-20 16:39 ` Eric Bavier
2014-07-20 20:35 ` Ludovic Courtès
0 siblings, 1 reply; 4+ messages in thread
From: Eric Bavier @ 2014-07-20 16:39 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
Ludovic Courtès writes:
> Be aware though that there can be subtle situations that trigger
> rebuilds, and are not addressed here (which is a fine approximation
> IMO.) For instance, implicit inputs are not taken into account. And
> there are things like reuse of sources, as in base.scm where gcc uses
> (package-source gmp) and the likes.
>
> Perhaps there should be a sentence of warning in the manual.
Done.
> Lastly, could you make the util.scm changes a separate patch?
>
> Then I think we’ll be all set.
Commits 7d193ec and 7d193ec.
--
Eric Bavier
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH] guix: refresh: Add --list-dependent option.
2014-07-20 16:39 ` Eric Bavier
@ 2014-07-20 20:35 ` Ludovic Courtès
0 siblings, 0 replies; 4+ messages in thread
From: Ludovic Courtès @ 2014-07-20 20:35 UTC (permalink / raw)
To: Eric Bavier; +Cc: guix-devel
Great, thanks!
Ludo’.
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2014-07-20 20:36 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2014-07-17 17:51 [PATCH] guix: refresh: Add --list-dependent option Eric Bavier
2014-07-18 12:41 ` Ludovic Courtès
2014-07-20 16:39 ` Eric Bavier
2014-07-20 20:35 ` Ludovic Courtès
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.