From 2492fba29f1eefb0775b79efc012d5e040d55c09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 30 Oct 2011 00:00:11 +0000 Subject: [PATCH] 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 --- maintainers/scripts/gnu/gnupdate | 79 ++++++++++++++++++++++---------- 1 file 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 ~%") (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)