Re: guix-package --roll-back

[Nikita Karetnikov <nikita@karetnikov.org>]

[-- Attachment #1.1: Type: text/plain, Size: 495 bytes --]

Hi,

I've slightly changed the 'roll-back' function. Now it prints an
informative message. And it's also possible to call it from a
command-line.

  # ./pre-inst-env guix-package --roll-back
  guix-package: switching from generation 6 to 5

The only problem I see is the following line.

  (error "there are no other profiles.")

It will print an ugly backtrace if there are no other profiles. I'm
trying to understand how to handle it in a non-ugly way.

Any comments are appreciated.

Nikita


[-- Attachment #1.2: guix-package.diff --]
[-- Type: text/x-diff, Size: 4115 bytes --]

--- guix-package-orig	2012-12-29 22:19:46.000000000 +0000
+++ guix-package	2012-12-29 22:42:41.000000000 +0000
@@ -13,6 +13,7 @@
 !#
 ;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
 ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of Guix.
 ;;;
@@ -87,13 +88,14 @@
     (_
      (error "unsupported manifest format" manifest))))
 
+(define (profile-rx profile)
+  "Return a regular expression that matches PROFILE's name and number."
+  (make-regexp (string-append "^" (regexp-quote (basename profile))
+                              "-([0-9]+)")))
+
 (define (latest-profile-number profile)
   "Return the identifying number of the latest generation of PROFILE.
 PROFILE is the name of the symlink to the current generation."
-  (define %profile-rx
-    (make-regexp (string-append "^" (regexp-quote (basename profile))
-                                "-([0-9]+)")))
-
   (define* (scandir name #:optional (select? (const #t))
                     (entry<? (@ (ice-9 i18n) string-locale<?)))
     ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
@@ -129,7 +131,7 @@
              (sort files entry<?))))
 
   (match (scandir (dirname profile)
-                  (cut regexp-exec %profile-rx <>))
+                  (cut regexp-exec (profile-rx profile) <>))
     (#f                                         ; no profile directory
      0)
     (()                                         ; no profiles
@@ -137,7 +139,7 @@
     ((profiles ...)                             ; former profiles around
      (let ((numbers (map (compose string->number
                                   (cut match:substring <> 1)
-                                  (cut regexp-exec %profile-rx <>))
+                                  (cut regexp-exec (profile-rx profile) <>))
                          profiles)))
        (fold (lambda (number highest)
                (if (> number highest)
@@ -177,6 +179,31 @@
                                      packages)
                                 #:modules '((guix build union))))
 
+(define (profile-number profile)
+  "Return PROFILE's number. PROFILE should be an absolute filename."
+  (match:substring (regexp-exec (profile-rx profile)
+                                (basename (readlink profile))) 1))
+
+(define (roll-back)
+  "Roll back to the previous profile."
+  (let* ((current-profile-number
+          (string->number (profile-number %current-profile)))
+         (previous-profile-number (number->string (1- current-profile-number)))
+         (previous-profile
+          (string-append %current-profile "-"
+                         previous-profile-number "-link")))
+
+    (define (switch)
+      "Switch to the previous generation."
+      (simple-format #t "guix-package: switching from generation ~a to ~a~%"
+                     current-profile-number previous-profile-number)
+      (delete-file %current-profile)
+      (symlink previous-profile %current-profile))
+
+    (if (= current-profile-number 1)
+        (error "there are no other profiles.") ; XXX: handle this error
+        (switch))))
+
 \f
 ;;;
 ;;; Command-line options.
@@ -201,6 +228,8 @@
   (display (_ "
   -n, --dry-run          show what would be done without actually doing it"))
   (display (_ "
+      --roll-back        roll back to the previous generation"))
+  (display (_ "
   -b, --bootstrap        use the bootstrap Guile to build the profile"))
   (display (_ "
       --verbose          produce verbose output"))
@@ -236,6 +265,10 @@
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
+        (option '("roll-back") #f #f
+                (lambda args
+                  (roll-back)
+                  (exit 0)))
         (option '(#\p "profile") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'profile arg

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]