Skip to content
Snippets Groups Projects
Commit 65d428d8 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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'.
parent d507b277
No related branches found
No related tags found
No related merge requests found
...@@ -232,6 +232,34 @@ (define generation-ctime-alist ...@@ -232,6 +232,34 @@ (define generation-ctime-alist
filter-by-duration) filter-by-duration)
(else #f))) (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. ;;; Package specifications.
...@@ -751,9 +779,6 @@ (define (process-actions opts) ...@@ -751,9 +779,6 @@ (define (process-actions opts)
(define dry-run? (assoc-ref opts 'dry-run?)) (define dry-run? (assoc-ref opts 'dry-run?))
(define profile (assoc-ref opts 'profile)) (define profile (assoc-ref opts 'profile))
(define current-generation-number
(generation-number profile))
;; First roll back if asked to. ;; First roll back if asked to.
(cond ((and (assoc-ref opts 'roll-back?) (cond ((and (assoc-ref opts 'roll-back?)
(not dry-run?)) (not dry-run?))
...@@ -782,30 +807,7 @@ (define current-generation-number ...@@ -782,30 +807,7 @@ (define current-generation-number
(for-each (for-each
(match-lambda (match-lambda
(('delete-generations . pattern) (('delete-generations . pattern)
(cond ((not (file-exists? profile)) ; XXX: race condition (delete-matching-generations (%store) profile pattern)
(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)))
(process-actions (process-actions
(alist-delete 'delete-generations opts))) (alist-delete 'delete-generations opts)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment