aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-26 19:03:56 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-27 00:01:20 +0100
commite49de93aa53eecb769c8e1522dc6352380121af3 (patch)
tree418aeebd1958315f54a0ac6817627aca81aadf7b
parent96856613249ccef0bfce16edd945a841d1b661f7 (diff)
downloadguix-e49de93aa53eecb769c8e1522dc6352380121af3.tar
guix-e49de93aa53eecb769c8e1522dc6352380121af3.tar.gz
ui: Add 'matching-generations'.
* guix/scripts/package.scm (matching-generations): Move to... * guix/ui.scm (matching-generations): ... here.
-rw-r--r--guix/scripts/package.scm66
-rw-r--r--guix/ui.scm67
2 files changed, 67 insertions, 66 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index e0fe1ddb27..804ca954f2 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -177,72 +177,6 @@ GENERATIONS is a list of generation numbers."
(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
diff --git a/guix/ui.scm b/guix/ui.scm
index 9cc1908e6e..59ff2a7fba 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -84,6 +84,7 @@
specification->file-system-mapping
string->generations
string->duration
+ matching-generations
run-guix-command
run-guix
program-name
@@ -948,6 +949,72 @@ following patterns: \"1d\", \"1w\", \"1m\"."
(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