04/13: ui: Add 'matching-generations'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit e49de93aa53eecb769c8e1522dc6352380121af3
Author: Ludovic Courtès <address@hidden>
Date:   Mon Oct 26 19:03:56 2015 +0100

    ui: Add 'matching-generations'.
    
    * guix/scripts/package.scm (matching-generations): Move to...
    * guix/ui.scm (matching-generations): ... here.
---
 guix/scripts/package.scm |   66 ---------------------------------------------
 guix/ui.scm              |   67 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 67 insertions(+), 66 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index e0fe1dd..804ca95 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 9cc1908..59ff2a7 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