From 560d4787f4943bc7d55b621ffaf415ca60895755 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 11 Jul 2013 19:56:30 +0200 Subject: [PATCH] guix refresh: Keep only the newest versions of packages as upgrade candidates. * guix/scripts/refresh.scm (guix-refresh)[keep-newest]: New procedure. Use it to keep only once copy of each package. --- guix/scripts/refresh.scm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index c75ec4f091..c65a7d0cfb 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -159,6 +159,20 @@ downloaded and authenticated; not updating") (alist-cons 'argument arg result)) %default-options)) + (define (keep-newest package lst) + ;; If a newer version of PACKAGE is already in LST, return LST; otherwise + ;; return LST minus the other version of PACKAGE in it, plus PACKAGE. + (let ((name (package-name package))) + (match (find (lambda (p) + (string=? (package-name p) name)) + lst) + ((? package? other) + (if (version>? (package-version other) (package-version package)) + lst + (cons package (delq other lst)))) + (_ + (cons package lst))))) + (define core-package? (let* ((input->package (match-lambda ((name (? package? package) _ ...) package) @@ -198,10 +212,9 @@ update would trigger a complete rebuild." ('core core-package?) ('non-core (negate core-package?)) (_ (const #t))))) - ;; TODO: Keep only the newest of each package. (fold-packages (lambda (package result) (if (select? package) - (cons package result) + (keep-newest package result) result)) '()))) (some ; user-specified packages