gnupdate: Add `--attribute' option.

* maintainers/scripts/gnu/gnupdate (open-nixpkgs): Add optional
  ATTRIBUTE parameter; honor it.
  (%options)["-A"]: New option.
  (gnupdate)[nixpkgs->snix]: Add ATTRIBUTE parameter and pass it down to
  `open-nixpkgs'.
  [selected-gnu-packages]: New procedure.
  Adjust callers accordingly.

svn path=/nixpkgs/trunk/; revision=30107

1 files changed, 54 insertions, 25 deletions

diff --git a/maintainers/scripts/gnu/gnupdate b/maintainers/scripts/gnu/gnupdate
index 96517f86cb8..4fbf5b6d43a 100755
--- a/maintainers/scripts/gnu/gnupdate
+++ b/maintainers/scripts/gnu/gnupdate
@@ -308,12 +308,17 @@ replaced by the result of their application to DERIVATIONS, a vhash."
   ;; DERIVATION lacks an "src" attribute.
   (and=> (derivation-source derivation) source-output-path))
 
-(define (open-nixpkgs nixpkgs)
+(define* (open-nixpkgs nixpkgs #:optional attribute)
+  ;; Return an input pipe to the XML representation of Nixpkgs.  When
+  ;; ATTRIBUTE is true, only that attribute is considered.
   (let ((script  (string-append nixpkgs
                                 "/maintainers/scripts/eval-release.nix")))
-    (open-pipe* OPEN_READ "nix-instantiate"
-                "--strict" "--eval-only" "--xml"
-                script)))
+    (apply open-pipe* OPEN_READ
+           "nix-instantiate" "--strict" "--eval-only" "--xml"
+           `(,@(if attribute
+                   `("-A" ,attribute)
+                   '())
+             ,script))))
 
 (define (pipe-failed? pipe)
   "Close pipe and return its status if it failed."
@@ -963,12 +968,18 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                   (format #t "~%")
                   (format #t "  -x, --xml=FILE      Read XML output of `nix-instantiate'~%")
                   (format #t "                      from FILE.~%")
+                  (format #t "  -A, --attribute=ATTR~%")
+                  (format #t "                      Update only the package pointed to by attribute~%")
+                  (format #t "                      ATTR.~%")
                   (format #t "  -s, --select=SET    Update only packages from SET, which may~%")
                   (format #t "                      be either `all', `stdenv', or `non-stdenv'.~%")
                   (format #t "  -d, --dry-run       Don't actually update Nix expressions~%")
                   (format #t "  -h, --help          Give this help list.~%~%")
                   (format #t "Report bugs to <ludo@gnu.org>~%")
                   (exit 0)))
+        (option '(#\A "attribute") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'attribute arg result)))
         (option '(#\s "select") #t #f
                 (lambda (opt name arg result)
                   (cond ((string-ci=? arg "stdenv")
@@ -994,13 +1005,14 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
 (define (gnupdate . args)
   ;; Assume Nixpkgs is under $NIXPKGS or ~/src/nixpkgs.
 
-  (define (nixpkgs->snix xml-file)
+  (define (nixpkgs->snix xml-file attribute)
     (format (current-error-port) "evaluating Nixpkgs...~%")
     (let* ((home (getenv "HOME"))
            (xml  (if xml-file
                      (open-input-file xml-file)
                      (open-nixpkgs (or (getenv "NIXPKGS")
-                                       (string-append home "/src/nixpkgs")))))
+                                       (string-append home "/src/nixpkgs"))
+                                   attribute)))
            (snix (xml->snix xml)))
       (if (not xml-file)
           (let ((status (pipe-failed? xml)))
@@ -1009,7 +1021,34 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                   (format (current-error-port) "`nix-instantiate' failed: ~A~%"
                           status)
                   (exit 1)))))
-      snix))
+
+      ;; If we asked for a specific attribute, rewrap the thing in an
+      ;; attribute set to match the expectations of `packages-to-update' & co.
+      (if attribute
+          (match snix
+            (('snix loc ('derivation args ...))
+             `(snix ,loc
+                    (attribute-set
+                     ((attribute #f ,attribute
+                                 (derivation ,@args)))))))
+          snix)))
+
+  (define (selected-gnu-packages packages stdenv selection)
+    ;; Return the subset of PACKAGES that are/aren't in STDENV, according to
+    ;; SELECTION.  To do that reliably, we check whether their "src"
+    ;; derivation is a requisite of STDENV.
+    (define gnu
+      (gnu-packages packages))
+
+    (case selection
+      ((stdenv)
+       gnu)
+      ((non-stdenv)
+       (filter (lambda (p)
+                 (not (member (package-source-output-path p)
+                              (force stdenv))))
+               gnu))
+      (else gnu)))
 
   (let* ((opts      (args-fold (cdr args) %options
                                (lambda (opt name arg result)
@@ -1017,7 +1056,8 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                                (lambda (operand result)
                                  (error "extraneous argument `~A'" operand))
                                '()))
-         (snix      (nixpkgs->snix (assoc-ref opts 'xml-file)))
+         (snix      (nixpkgs->snix (assq-ref opts 'xml-file)
+                                   (assq-ref opts 'attribute)))
          (packages  (match snix
                       (('snix _ ('attribute-set attributes))
                        attributes)
@@ -1026,23 +1066,12 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                       ;; The source tarballs that make up stdenv.
                       (filter-map derivation-source-output-path
                                   (package-requisites (stdenv-package packages)))))
-         (gnu       (gnu-packages packages))
-         (gnu*      (case (assoc-ref opts 'filter)
-                      ;; Filter out packages that are/aren't in `stdenv'.  To
-                      ;; do that reliably, we check whether their "src"
-                      ;; derivation is a requisite of stdenv.
-                      ((stdenv)
-                       (filter (lambda (p)
-                                 (member (package-source-output-path p)
-                                         (force stdenv)))
-                               gnu))
-                      ((non-stdenv)
-                       (filter (lambda (p)
-                                 (not (member (package-source-output-path p)
-                                              (force stdenv))))
-                               gnu))
-                      (else gnu)))
-         (updates   (packages-to-update gnu*)))
+         (attribute (assq-ref opts 'attribute))
+         (selection (assq-ref opts 'filter))
+         (to-update (if attribute
+                        packages                  ; already a subset
+                        (selected-gnu-packages packages stdenv selection)))
+         (updates   (packages-to-update to-update)))
 
     (format #t "~%~A packages to update...~%" (length updates))
     (for-each (lambda (update)