>From 9493421a4e094be6686ff6f28749946d491f81cd Mon Sep 17 00:00:00 2001
From: Alex Kost <address@hidden>
Date: Tue, 7 Oct 2014 11:50:44 +0400
Subject: [PATCH 1/2] 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        | 53 ++++++++++++++++++++++++++++++++++++++++--------
 guix/scripts/package.scm |  9 --------
 2 files changed, 45 insertions(+), 17 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 18733a6..9920881 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -71,9 +71,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:
 ;;;
@@ -569,16 +572,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."
@@ -589,4 +604,26 @@ 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))
+        (file    (generation-file-name profile number)))
+    (cond ((not (file-exists? profile))
+           (format (current-error-port)
+                   (_ "profile '~a' does not exist~%")
+                   profile))
+          ((not (file-exists? file))
+           (format (current-error-port)
+                   (_ "generation ~a does not exist~%")
+                   number))
+          (else
+           (format #t (_ "switching from generation ~a to ~a~%")
+                   current number)
+           (switch-symlinks profile file)))))
+
+(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 fc9c37b..d0f1458 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -94,15 +94,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