unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
* guix-package --roll-back
@ 2012-12-21 22:49 Nikita Karetnikov
  2012-12-29 23:09 ` Nikita Karetnikov
  0 siblings, 1 reply; 21+ messages in thread
From: Nikita Karetnikov @ 2012-12-21 22:49 UTC (permalink / raw)
  To: bug-guix


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

Hi,

What do you think?

(I'll send the output of 'git format-patch' when I implement the
command-line part.)

By the way, could you explain how the following works?

  (match (scandir (dirname profile)
                  (cut regexp-exec %profile-rx <>)) ...)

How does 'regexp-exec' get its second argument? (I know how 'cut' works,
but I don't understand this particular snippet.)

Nikita


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

--- guix-package-orig	2012-12-16 17:38:40.000000000 +0000
+++ guix-package	2012-12-21 22:28:08.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.
 ;;;
@@ -47,7 +48,8 @@
   #:use-module (srfi srfi-37)
   #:use-module (distro)
   #:use-module (distro packages guile)
-  #:export (guix-package))
+  #:export (guix-package)
+  #:export (roll-back))
 
 (define %store
   (open-connection))
@@ -87,13 +89,13 @@
     (_
      (error "unsupported manifest format" manifest))))
 
+(define (profile-rx profile)
+  (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,25 @@
                                      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
+          (string-append %current-profile "-"
+                         (number->string (- current-profile-number 1))
+                         "-link")))
+    (if (= current-profile-number 1)
+        (error "there are no other profiles.")
+        (delete-file %current-profile))
+
+    (symlink previous-profile %current-profile)))
+
 \f
 ;;;
 ;;; Command-line options.

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

^ permalink raw reply	[flat|nested] 21+ messages in thread

end of thread, other threads:[~2013-01-22 21:37 UTC | newest]

Thread overview: 21+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-12-21 22:49 guix-package --roll-back Nikita Karetnikov
2012-12-29 23:09 ` Nikita Karetnikov
2012-12-29 23:13   ` Andreas Enge
2012-12-30 15:30   ` Ludovic Courtès
2013-01-01 13:57     ` Nikita Karetnikov
2013-01-01 22:58       ` Ludovic Courtès
2013-01-03  5:42     ` Nikita Karetnikov
2013-01-03 14:41       ` Ludovic Courtès
2013-01-04 18:18         ` Nikita Karetnikov
2013-01-05 19:20           ` Ludovic Courtès
2013-01-09 19:04             ` Nikita Karetnikov
2013-01-10 15:01               ` Nikita Karetnikov
2013-01-10 22:26               ` Ludovic Courtès
2013-01-11  5:48                 ` Nikita Karetnikov
2013-01-11 13:39                   ` Ludovic Courtès
2013-01-12 21:03                     ` Nikita Karetnikov
2013-01-13 20:40                       ` Ludovic Courtès
2013-01-16 21:34                 ` Nikita Karetnikov
2013-01-17 21:47                   ` Ludovic Courtès
2013-01-21  5:50                     ` Nikita Karetnikov
2013-01-22 21:37                       ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).