[PATCH] gnu: refresh: Add --list-upstream-closure option.

[PATCH] gnu: refresh: Add --list-upstream-closure option.

[Eric Bavier]

[-- Attachment #1: Type: text/plain, Size: 791 bytes --]

When upgrading packages, I found it would be useful, in order to avoid
breaking builds for hydra and everyone else, to know which packages to
test building locally before pushing the upgrades.

The attached patch provides this information in the form of a new option
to the "guix refresh" command.  I thought that would be a nice for the
functionality because it is already a "developer" command, and the
use-case I had in mind revolved around upgrading packages.

For the sake of brevity and human consumption, the option doesn't print
*all* upstream packages, just the "top-level" upstream packages,
i.e. those whose inputs encompass all other upstream packages.

I'm not sure that the option name or all the terminology I used is
appropriate, so any comments or suggestions are welcome.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-guix-refresh-Add-list-upstream-closure-option.patch --]
[-- Type: text/x-diff, Size: 8264 bytes --]

From 330c1c38cb1bf57b631aa1311eb89d8e0fad4bf4 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Mon, 14 Jul 2014 23:42:57 -0500
Subject: [PATCH] guix: refresh: Add --list-upstream-closure option.

* guix/utils.scm (fold-forest, fold-forest-leaves): New functions.
* guix/scripts/refresh.scm (upstream-packages): New functions.
  (%options, show-help, guix-refresh): Add --list-upstream-closure option.
---
 guix/scripts/refresh.scm |   96 +++++++++++++++++++++++++++++++++-------------
 guix/utils.scm           |   30 +++++++++++++++
 2 files changed, 100 insertions(+), 26 deletions(-)

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index c65a7d0..d34bbb3 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -59,6 +59,9 @@
                     (x
                      (leave (_ "~a: invalid selection; expected `core' or `non-core'")
                             arg)))))
+        (option '(#\l "list-upstream-closure") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'list-upstream? #t result)))
 
         (option '("key-server") #t #f
                 (lambda (opt name arg result)
@@ -96,6 +99,10 @@ specified with `--select'.\n"))
   (display (_ "
   -s, --select=SUBSET    select all the packages in SUBSET, one of
                          `core' or `non-core'"))
+  (display (_ "
+  -l, --list-upstream-closure
+                         List top-level upstream 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"))
@@ -143,6 +150,36 @@ values: 'interactive' (default), 'always', and 'never'."
 downloaded and authenticated; not updating")
                    (package-name package) version)))))
 
+(define (upstream-packages packages)
+  "Return a minimal list of top-level package specifications for packages that
+should be built in order to test changes made to the packages in
+PACKAGE-SPECS.  Building the returned packages will ensure that *all* packages
+that depend, directly or indirectly, on those packages in PACKAGE-SPECS are
+tested."
+  (define (package-direct-inputs package)
+    (append (package-native-inputs package)
+            (package-inputs package)
+            (package-propagated-inputs package)))
+
+  (let ((inverse-package-dependency-graph
+         (fold-packages
+          (lambda (package forest)
+            (for-each
+             (lambda (d)
+               ;; Insert a tree edge from each of package's inputs to package.
+               (hash-set! forest d
+                          (cons package
+                                (hash-ref forest d '()))))
+             (map cadr (package-direct-inputs package)))
+            forest)
+          (make-hash-table))))
+    (map package-full-name
+         (fold-forest-leaves
+          cons '()
+          (lambda (node)
+            (hash-ref inverse-package-dependency-graph node '()))
+          packages))))
+
 
 \f
 ;;;
@@ -193,9 +230,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-upstream? (assoc-ref opts 'list-upstream?))
+         (key-download   (assoc-ref opts 'key-download))
          (packages
           (match (concatenate
                   (filter-map (match-lambda
@@ -220,26 +258,32 @@ 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-upstream?
+        (format (current-output-port)
+                (_ "The following packages would need rebuilding: ~{~a~^ ~}~%")
+                (upstream-packages 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..bdc5c1e 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -72,6 +72,8 @@
             call-with-temporary-output-file
             with-atomic-file-output
             fold2
+            fold-forest
+            fold-forest-leaves
 
             filtered-port
             compressed-port
@@ -649,6 +651,34 @@ output port, and PROC's result is returned."
              (lambda (result1 result2)
                (fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
 
+(define (fold-forest proc init next roots)
+  "Call (PROC NODE RESULT) for each node in the forest 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 (NEXT NODE), the result of which should be a list of nodes that are
+connected to NODE in the forest, or '() 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)
+                 (append tail (next head)))
+           (loop result seen tail))))))
+
+(define (fold-forest-leaves proc init next roots)
+  "Like fold-forest, but call (PROC NODE RESULT) only for leaf nodes."
+  (fold-forest
+   (lambda (node result)
+     (match (next node)
+       (() (proc node result))
+       (else result)))
+   init next roots))
+
 \f
 ;;;
 ;;; Source location.
-- 
1.7.9.5


[-- Attachment #3: Type: text/plain, Size: 17 bytes --]


-- 
Eric Bavier

Re: [PATCH] gnu: refresh: Add --list-upstream-closure option.

[Ludovic Courtès]

Eric Bavier <ericbavier@gmail.com> skribis:

> When upgrading packages, I found it would be useful, in order to avoid
> breaking builds for hydra and everyone else, to know which packages to
> test building locally before pushing the upgrades.
>
> The attached patch provides this information in the form of a new option
> to the "guix refresh" command.  I thought that would be a nice for the
> functionality because it is already a "developer" command, and the
> use-case I had in mind revolved around upgrading packages.
>
> For the sake of brevity and human consumption, the option doesn't print
> *all* upstream packages, just the "top-level" upstream packages,
> i.e. those whose inputs encompass all other upstream packages.

This looks very useful!

> I'm not sure that the option name or all the terminology I used is
> appropriate, so any comments or suggestions are welcome.

The term “upstream” in the context of this command makes me think of
package maintainers which are considered “upstream” compared to the
distro.

What about “dependent” instead?

> +        (option '(#\l "list-upstream-closure") #f #f
> +                (lambda (opt name arg result)
> +                  (alist-cons 'list-upstream? #t result)))

“list-dependent”?

>    -s, --select=SUBSET    select all the packages in SUBSET, one of
>                           `core' or `non-core'"))
> +  (display (_ "
> +  -l, --list-upstream-closure
> +                         List top-level upstream packages that would need to
                            ^
lowercase

> +(define (upstream-packages packages)
> +  "Return a minimal list of top-level package specifications for packages that
> +should be built in order to test changes made to the packages in
> +PACKAGE-SPECS.  Building the returned packages will ensure that *all* packages
> +that depend, directly or indirectly, on those packages in PACKAGE-SPECS are
> +tested."
> +  (define (package-direct-inputs package)
> +    (append (package-native-inputs package)
> +            (package-inputs package)
> +            (package-propagated-inputs package)))
> +
> +  (let ((inverse-package-dependency-graph

‘inverse-dag’ or ‘dag’ is enough for a local var.  If needed a comment
can clarify what it is.

> +         (fold-packages
> +          (lambda (package forest)
> +            (for-each
> +             (lambda (d)
> +               ;; Insert a tree edge from each of package's inputs to package.
> +               (hash-set! forest d
> +                          (cons package
> +                                (hash-ref forest d '()))))
> +             (map cadr (package-direct-inputs package)))
> +            forest)
> +          (make-hash-table))))

Could you use a vhash here instead of the hash table?

> +    (map package-full-name
> +         (fold-forest-leaves
> +          cons '()
> +          (lambda (node)
> +            (hash-ref inverse-package-dependency-graph node '()))
> +          packages))))

The function is documented as returning “package specifications” so I’d
remove ‘map’ from here and move it to the call site.

> +(define (fold-forest proc init next roots)
> +  "Call (PROC NODE RESULT) for each node in the forest 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 (NEXT NODE), the result of which should be a list of nodes that are
> +connected to NODE in the forest, or '() 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)
> +                 (append tail (next head)))
> +           (loop result seen tail))))))

What about ‘fold-tree’ instead, and change ‘next’ to ‘children’?

> +(define (fold-forest-leaves proc init next roots)
> +  "Like fold-forest, but call (PROC NODE RESULT) only for leaf nodes."

‘fold-tree-leaves’.

Also could you write a few tests for these two?

I believe ‘upstream-packages’ (renamed to ‘dependent-packages’?) could
be moved to (guix packages) and have a few tests as well.  That’d be
great.

WDYT?

Thanks!

Ludo’.

Re: [PATCH] gnu: refresh: Add --list-upstream-closure option.

[Eric Bavier]

Ludovic Courtès writes:

>> For the sake of brevity and human consumption, the option doesn't print
>> *all* upstream packages, just the "top-level" upstream packages,
>> i.e. those whose inputs encompass all other upstream packages.
>
> This looks very useful!

I'm glad.

>
>> I'm not sure that the option name or all the terminology I used is
>> appropriate, so any comments or suggestions are welcome.
>
> The term “upstream” in the context of this command makes me think of
> package maintainers which are considered “upstream” compared to the
> distro.
>
> What about “dependent” instead?

Yes, I like "dependent" better.

>> +  (define (package-direct-inputs package)
>> +    (append (package-native-inputs package)
>> +            (package-inputs package)
>> +            (package-propagated-inputs package)))
>> +
>> +  (let ((inverse-package-dependency-graph
>
> ‘inverse-dag’ or ‘dag’ is enough for a local var.  If needed a comment
> can clarify what it is.

OK

>> +         (fold-packages
>> +          (lambda (package forest)
>> +            (for-each
>> +             (lambda (d)
>> +               ;; Insert a tree edge from each of package's inputs to package.
>> +               (hash-set! forest d
>> +                          (cons package
>> +                                (hash-ref forest d '()))))
>> +             (map cadr (package-direct-inputs package)))
>> +            forest)
>> +          (make-hash-table))))
>
> Could you use a vhash here instead of the hash table?

Yes, that shouldn't be a problem.  Could I ask why the request?

>> +    (map package-full-name
>> +         (fold-forest-leaves
>> +          cons '()
>> +          (lambda (node)
>> +            (hash-ref inverse-package-dependency-graph node '()))
>> +          packages))))
>
> The function is documented as returning “package specifications” so I’d
> remove ‘map’ from here and move it to the call site.

I'm fine with moving the mapping to the call site.  I used "package
specification" here because that term is used elsewhere when talking
about a string like "zlib-1.2.7".  I'll change the documentation to be
more clear.

> What about ‘fold-tree’ instead, and change ‘next’ to ‘children’?
>
>> +(define (fold-forest-leaves proc init next roots)
>> +  "Like fold-forest, but call (PROC NODE RESULT) only for leaf nodes."
>
> ‘fold-tree-leaves’.

I realize now that the structure isn't necessarily a forest, so yes,
"fold-tree" would be more appropriate.

> Also could you write a few tests for these two?

Sure thing.

> I believe ‘upstream-packages’ (renamed to ‘dependent-packages’?) could
> be moved to (guix packages) and have a few tests as well.  That’d be
> great.
>
> WDYT?

Because of the use of 'fold-packages' from (gnu packages), putting
dependent-packages into (guix packages) would cause a circular
dependency.  I think I'd also want to make the interface more general if
it were to go somewhere more widely available.

I'll post an updated patch soon.

-- 
Eric Bavier

Please avoid sending me Word or PowerPoint attachments.
See http://www.gnu.org/philosophy/no-word-attachments.html

Re: [PATCH] gnu: refresh: Add --list-upstream-closure option.

[Ludovic Courtès]

Eric Bavier <ericbavier@gmail.com> skribis:

> Ludovic Courtès writes:

[...]

>> Could you use a vhash here instead of the hash table?
>
> Yes, that shouldn't be a problem.  Could I ask why the request?

I prefer functional style (except for build-side code), for clarity
among other things.

[...]

>> I believe ‘upstream-packages’ (renamed to ‘dependent-packages’?) could
>> be moved to (guix packages) and have a few tests as well.  That’d be
>> great.
>>
>> WDYT?
>
> Because of the use of 'fold-packages' from (gnu packages), putting
> dependent-packages into (guix packages) would cause a circular
> dependency.

Oh, right.

> I think I'd also want to make the interface more general if it were to
> go somewhere more widely available.

OK.

Ludo’.