mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
ui: Add 'matching-generations'.
* guix/scripts/package.scm (matching-generations): Move to... * guix/ui.scm (matching-generations): ... here.
This commit is contained in:
parent
9685661324
commit
e49de93aa5
2 changed files with 67 additions and 66 deletions
|
@ -177,72 +177,6 @@ (define (delete-generations store profile generations)
|
|||
(for-each (cut delete-generation store profile <>)
|
||||
generations))
|
||||
|
||||
(define* (matching-generations str #:optional (profile %current-profile)
|
||||
#:key (duration-relation <=))
|
||||
"Return the list of available generations matching a pattern in STR. See
|
||||
'string->generations' and 'string->duration' for the list of valid patterns.
|
||||
When STR is a duration pattern, return all the generations whose ctime has
|
||||
DURATION-RELATION with the current time."
|
||||
(define (valid-generations lst)
|
||||
(define (valid-generation? n)
|
||||
(any (cut = n <>) (generation-numbers profile)))
|
||||
|
||||
(fold-right (lambda (x acc)
|
||||
(if (valid-generation? x)
|
||||
(cons x acc)
|
||||
acc))
|
||||
'()
|
||||
lst))
|
||||
|
||||
(define (filter-generations generations)
|
||||
(match generations
|
||||
(() '())
|
||||
(('>= n)
|
||||
(drop-while (cut > n <>)
|
||||
(generation-numbers profile)))
|
||||
(('<= n)
|
||||
(valid-generations (iota n 1)))
|
||||
((lst ..1)
|
||||
(valid-generations lst))
|
||||
(_ #f)))
|
||||
|
||||
(define (filter-by-duration duration)
|
||||
(define (time-at-midnight time)
|
||||
;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and
|
||||
;; hours to zeros.
|
||||
(let ((d (time-utc->date time)))
|
||||
(date->time-utc
|
||||
(make-date 0 0 0 0
|
||||
(date-day d) (date-month d)
|
||||
(date-year d) (date-zone-offset d)))))
|
||||
|
||||
(define generation-ctime-alist
|
||||
(map (lambda (number)
|
||||
(cons number
|
||||
(time-second
|
||||
(time-at-midnight
|
||||
(generation-time profile number)))))
|
||||
(generation-numbers profile)))
|
||||
|
||||
(match duration
|
||||
(#f #f)
|
||||
(res
|
||||
(let ((s (time-second
|
||||
(subtract-duration (time-at-midnight (current-time))
|
||||
duration))))
|
||||
(delete #f (map (lambda (x)
|
||||
(and (duration-relation s (cdr x))
|
||||
(first x)))
|
||||
generation-ctime-alist))))))
|
||||
|
||||
(cond ((string->generations str)
|
||||
=>
|
||||
filter-generations)
|
||||
((string->duration str)
|
||||
=>
|
||||
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
|
||||
|
|
67
guix/ui.scm
67
guix/ui.scm
|
@ -84,6 +84,7 @@ (define-module (guix ui)
|
|||
specification->file-system-mapping
|
||||
string->generations
|
||||
string->duration
|
||||
matching-generations
|
||||
run-guix-command
|
||||
run-guix
|
||||
program-name
|
||||
|
@ -948,6 +949,72 @@ (define (hours->duration hours match)
|
|||
(hours->duration (* 24 30) match)))
|
||||
(else #f)))
|
||||
|
||||
(define* (matching-generations str profile
|
||||
#:key (duration-relation <=))
|
||||
"Return the list of available generations matching a pattern in STR. See
|
||||
'string->generations' and 'string->duration' for the list of valid patterns.
|
||||
When STR is a duration pattern, return all the generations whose ctime has
|
||||
DURATION-RELATION with the current time."
|
||||
(define (valid-generations lst)
|
||||
(define (valid-generation? n)
|
||||
(any (cut = n <>) (generation-numbers profile)))
|
||||
|
||||
(fold-right (lambda (x acc)
|
||||
(if (valid-generation? x)
|
||||
(cons x acc)
|
||||
acc))
|
||||
'()
|
||||
lst))
|
||||
|
||||
(define (filter-generations generations)
|
||||
(match generations
|
||||
(() '())
|
||||
(('>= n)
|
||||
(drop-while (cut > n <>)
|
||||
(generation-numbers profile)))
|
||||
(('<= n)
|
||||
(valid-generations (iota n 1)))
|
||||
((lst ..1)
|
||||
(valid-generations lst))
|
||||
(_ #f)))
|
||||
|
||||
(define (filter-by-duration duration)
|
||||
(define (time-at-midnight time)
|
||||
;; Return TIME at midnight by setting nanoseconds, seconds, minutes, and
|
||||
;; hours to zeros.
|
||||
(let ((d (time-utc->date time)))
|
||||
(date->time-utc
|
||||
(make-date 0 0 0 0
|
||||
(date-day d) (date-month d)
|
||||
(date-year d) (date-zone-offset d)))))
|
||||
|
||||
(define generation-ctime-alist
|
||||
(map (lambda (number)
|
||||
(cons number
|
||||
(time-second
|
||||
(time-at-midnight
|
||||
(generation-time profile number)))))
|
||||
(generation-numbers profile)))
|
||||
|
||||
(match duration
|
||||
(#f #f)
|
||||
(res
|
||||
(let ((s (time-second
|
||||
(subtract-duration (time-at-midnight (current-time))
|
||||
duration))))
|
||||
(delete #f (map (lambda (x)
|
||||
(and (duration-relation s (cdr x))
|
||||
(first x)))
|
||||
generation-ctime-alist))))))
|
||||
|
||||
(cond ((string->generations str)
|
||||
=>
|
||||
filter-generations)
|
||||
((string->duration str)
|
||||
=>
|
||||
filter-by-duration)
|
||||
(else #f)))
|
||||
|
||||
(define* (package-specification->name+version+output spec
|
||||
#:optional (output "out"))
|
||||
"Parse package specification SPEC and return three value: the specified
|
||||
|
|
Loading…
Reference in a new issue