From da49a2b7af5295c3c72b7e4590219cbac827877b Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 00:39:42 +0400
Subject: [PATCH 2/3] profiles: Add procedures for switching generations.

* guix/scripts/package.scm (switch-to-previous-generation): Move to...
* guix/profiles.scm: ... here. Use 'switch-to-generation'.
  (relative-generation): New procedure.
  (previous-generation-number): Use it.
  (switch-to-generation): New procedure.
---
 guix/profiles.scm        | 51 ++++++++++++++++++++++++++++++++++++++++--------
 guix/scripts/package.scm |  9 ---------
 2 files changed, 43 insertions(+), 17 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 793af24..f56e407 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -80,9 +80,12 @@
             generation-number
             generation-numbers
             profile-generations
+            relative-generation
             previous-generation-number
             generation-time
-            generation-file-name))
+            generation-file-name
+            switch-to-generation
+            switch-to-previous-generation))
 
 ;;; Commentary:
 ;;;
@@ -503,16 +506,28 @@ former profiles were found."
         '()
         generations)))
 
-(define (previous-generation-number profile number)
+(define* (relative-generation profile shift #:optional
+                              (current (generation-number profile)))
+  "Return PROFILE's generation shifted from the CURRENT generation by SHIFT.
+SHIFT is a positive or negative number.
+Return #f if there is no such generation."
+  (let* ((abs-shift (abs shift))
+         (numbers (profile-generations profile))
+         (from-current (memq current
+                             (if (negative? shift)
+                                 (reverse numbers)
+                                 numbers))))
+    (and from-current
+         (< abs-shift (length from-current))
+         (list-ref from-current abs-shift))))
+
+(define* (previous-generation-number profile #:optional
+                                     (number (generation-number profile)))
   "Return the number of the generation before generation NUMBER of
 PROFILE, or 0 if none exists.  It could be NUMBER - 1, but it's not the
 case when generations have been deleted (there are \"holes\")."
-  (fold (lambda (candidate highest)
-          (if (and (< candidate number) (> candidate highest))
-              candidate
-              highest))
-        0
-        (generation-numbers profile)))
+  (or (relative-generation profile -1 number)
+      0))
 
 (define (generation-file-name profile generation)
   "Return the file name for PROFILE's GENERATION."
@@ -523,4 +538,24 @@ case when generations have been deleted (there are \"holes\")."
   (make-time time-utc 0
              (stat:ctime (stat (generation-file-name profile number)))))
 
+(define (switch-to-generation profile number)
+  "Atomically switch PROFILE to the generation NUMBER."
+  (let ((current    (generation-number profile))
+        (generation (generation-file-name profile number)))
+    (cond ((not (file-exists? profile))
+           (raise (condition (&profile-not-found-error
+                              (profile profile)))))
+          ((not (file-exists? generation))
+           (raise (condition (&missing-generation-error
+                              (generation number)))))
+          (else
+           (format #t (_ "switching from generation ~a to ~a~%")
+                   current number)
+           (switch-symlinks profile generation)))))
+
+(define (switch-to-previous-generation profile)
+  "Atomically switch PROFILE to the previous generation."
+  (switch-to-generation profile
+                        (previous-generation-number profile)))
+
 ;;; profiles.scm ends here
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index ab9d303..460416f 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -96,15 +96,6 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
 
     (switch-symlinks generation prof)))
 
-(define (switch-to-previous-generation profile)
-  "Atomically switch PROFILE to the previous generation."
-  (let* ((number              (generation-number profile))
-         (previous-number     (previous-generation-number profile number))
-         (previous-generation (generation-file-name profile previous-number)))
-    (format #t (_ "switching from generation ~a to ~a~%")
-            number previous-number)
-    (switch-symlinks profile previous-generation)))
-
 (define (roll-back store profile)
   "Roll back to the previous generation of PROFILE."
   (let* ((number              (generation-number profile))
-- 
2.1.2