[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/06: guix package: Move generation deletion to its own procedure.
From: |
Ludovic Courtès |
Subject: |
01/06: guix package: Move generation deletion to its own procedure. |
Date: |
Mon, 06 Apr 2015 19:56:08 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit 65d428d8f4bd6bf05dde428ce51a3ce04bd3aad3
Author: Ludovic Courtès <address@hidden>
Date: Mon Apr 6 20:02:22 2015 +0200
guix package: Move generation deletion to its own procedure.
* guix/scripts/package.scm (delete-matching-generations): New procedure,
with code formerly found...
(guix-package)[process-actions]: ... here. Use it.
Remove 'current-generation-number'.
---
guix/scripts/package.scm | 56 +++++++++++++++++++++++----------------------
1 files changed, 29 insertions(+), 27 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 3cc7ae7..7074243 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -232,6 +232,34 @@ DURATION-RELATION with the current time."
filter-by-duration)
(else #f)))
+(define (delete-matching-generations store profile pattern)
+ "Delete from PROFILE all the generations matching PATTERN. PATTERN must be
+a string denoting a set of generations: the empty list means \"all generations
+but the current one\", a number designates a generation, and other patterns
+denote ranges as interpreted by 'matching-derivations'."
+ (let ((current (generation-number profile)))
+ (cond ((not (file-exists? profile)) ; XXX: race condition
+ (raise (condition (&profile-not-found-error
+ (profile profile)))))
+ ((string-null? pattern)
+ (delete-generations (%store) profile
+ (delv current (profile-generations profile))))
+ ;; Do not delete the zeroth generation.
+ ((equal? 0 (string->number pattern))
+ (exit 0))
+
+ ;; If PATTERN is a duration, match generations that are
+ ;; older than the specified duration.
+ ((matching-generations pattern profile
+ #:duration-relation >)
+ =>
+ (lambda (numbers)
+ (if (null-list? numbers)
+ (exit 1)
+ (delete-generations (%store) profile numbers))))
+ (else
+ (leave (_ "invalid syntax: ~a~%") pattern)))))
+
;;;
;;; Package specifications.
@@ -751,9 +779,6 @@ more information.~%"))
(define dry-run? (assoc-ref opts 'dry-run?))
(define profile (assoc-ref opts 'profile))
- (define current-generation-number
- (generation-number profile))
-
;; First roll back if asked to.
(cond ((and (assoc-ref opts 'roll-back?)
(not dry-run?))
@@ -782,30 +807,7 @@ more information.~%"))
(for-each
(match-lambda
(('delete-generations . pattern)
- (cond ((not (file-exists? profile)) ; XXX: race condition
- (raise (condition (&profile-not-found-error
- (profile profile)))))
- ((string-null? pattern)
- (delete-generations
- (%store) profile
- (delete current-generation-number
- (profile-generations profile))))
- ;; Do not delete the zeroth generation.
- ((equal? 0 (string->number pattern))
- (exit 0))
-
- ;; If PATTERN is a duration, match generations that are
- ;; older than the specified duration.
- ((matching-generations pattern profile
- #:duration-relation >)
- =>
- (lambda (numbers)
- (if (null-list? numbers)
- (exit 1)
- (delete-generations (%store) profile numbers))))
- (else
- (leave (_ "invalid syntax: ~a~%")
- pattern)))
+ (delete-matching-generations (%store) profile pattern)
(process-actions
(alist-delete 'delete-generations opts)))
- branch master updated (d507b27 -> 57b8623), Ludovic Courtès, 2015/04/06
- 01/06: guix package: Move generation deletion to its own procedure.,
Ludovic Courtès <=
- 02/06: gnu: lsof: Add mirrors., Ludovic Courtès, 2015/04/06
- 03/06: tests: Deal with 'mount-points' not returning "/"., Ludovic Courtès, 2015/04/06
- 04/06: guix package: Never remove the current generation and warn about it., Ludovic Courtès, 2015/04/06
- 05/06: guix package: Avoid 'exit' calls in 'delete-matching-generations'., Ludovic Courtès, 2015/04/06
- 06/06: tests: Move 'guix package' tests that require networking to a separate file., Ludovic Courtès, 2015/04/06