--- 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 +;;; Copyright (C) 2012 Nikita Karetnikov ;;; ;;; 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)) + (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))) + ;;; ;;; Command-line options.