guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

guix package: Export generation procedures. 

* guix/scripts/package.scm: Export 'roll-back', 'delete-generation',
  'delete-generations'.
  (link-to-empty-profile, roll-back): Add 'store' argument.
  (delete-generations): New procedure.
  (guix-package): Adjust accordingly.
  [delete-generation]: Move to the top level.  Add 'store' and 'profile'
  arguments.
  [display-and-delete]: Move to 'delete-generation'.
version-0.8.3
Alex Kost 8 years ago
parent
881c3f0163
commit
b72a312c30
1 changed files with 43 additions and 32 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 75
      guix/scripts/package.scm

75
guix/scripts/package.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -43,6 +44,9 @@
#:use-module (gnu packages guile)
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
#:export (specification->package+output
roll-back
delete-generation
delete-generations
guix-package))
(define %store
@ -80,12 +84,12 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
%current-profile
profile))
(define (link-to-empty-profile generation)
(define (link-to-empty-profile store generation)
"Link GENERATION, a string, to the empty profile."
(let* ((drv (run-with-store (%store)
(let* ((drv (run-with-store store
(profile-derivation (manifest '()))))
(prof (derivation->output-path drv "out")))
(when (not (build-derivations (%store) (list drv)))
(when (not (build-derivations store (list drv)))
(leave (_ "failed to build the empty profile~%")))
(switch-symlinks generation prof)))
@ -99,7 +103,7 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
number previous-number)
(switch-symlinks profile previous-generation)))
(define (roll-back profile)
(define (roll-back store profile)
"Roll back to the previous generation of PROFILE."
(let* ((number (generation-number profile))
(previous-number (previous-generation-number profile number))
@ -112,11 +116,39 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
(_ "nothing to do: already at the empty profile~%")))
((or (zero? previous-number) ; going to emptiness
(not (file-exists? previous-generation)))
(link-to-empty-profile previous-generation)
(link-to-empty-profile store previous-generation)
(switch-to-previous-generation profile))
(else
(switch-to-previous-generation profile))))) ; anything else
(define (delete-generation store profile number)
"Delete generation with NUMBER from PROFILE."
(define (display-and-delete)
(let ((generation (generation-file-name profile number)))
(format #t (_ "deleting ~a~%") generation)
(delete-file generation)))
(let* ((current-number (generation-number profile))
(previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)))
(cond ((zero? number)) ; do not delete generation 0
((and (= number current-number)
(not (file-exists? previous-generation)))
(link-to-empty-profile store previous-generation)
(switch-to-previous-generation profile)
(display-and-delete))
((= number current-number)
(roll-back store profile)
(display-and-delete))
(else
(display-and-delete)))))
(define (delete-generations store profile generations)
"Delete GENERATIONS from PROFILE.
GENERATIONS is a list of generation numbers."
(for-each (cut delete-generation store profile <>)
generations))
(define* (matching-generations str #:optional (profile %current-profile)
#:key (duration-relation <=))
"Return the list of available generations matching a pattern in STR. See
@ -680,32 +712,10 @@ more information.~%"))
(define current-generation-number
(generation-number profile))
(define (display-and-delete number)
(let ((generation (generation-file-name profile number)))
(unless (zero? number)
(format #t (_ "deleting ~a~%") generation)
(delete-file generation))))
(define (delete-generation number)
(let* ((previous-number (previous-generation-number profile number))
(previous-generation
(generation-file-name profile previous-number)))
(cond ((zero? number)) ; do not delete generation 0
((and (= number current-generation-number)
(not (file-exists? previous-generation)))
(link-to-empty-profile previous-generation)
(switch-to-previous-generation profile)
(display-and-delete number))
((= number current-generation-number)
(roll-back profile)
(display-and-delete number))
(else
(display-and-delete number)))))
;; First roll back if asked to.
(cond ((and (assoc-ref opts 'roll-back?) (not dry-run?))
(begin
(roll-back profile)
(roll-back (%store) profile)
(process-actions (alist-delete 'roll-back? opts))))
((and (assoc-ref opts 'delete-generations)
(not dry-run?))
@ -716,9 +726,10 @@ more information.~%"))
(leave (_ "profile '~a' does not exist~%")
profile))
((string-null? pattern)
(for-each display-and-delete
(delete current-generation-number
(profile-generations profile))))
(delete-generations
(%store) profile
(delete current-generation-number
(profile-generations profile))))
;; Do not delete the zeroth generation.
((equal? 0 (string->number pattern))
(exit 0))
@ -731,7 +742,7 @@ more information.~%"))
(lambda (numbers)
(if (null-list? numbers)
(exit 1)
(for-each delete-generation numbers))))
(delete-generations (%store) profile numbers))))
(else
(leave (_ "invalid syntax: ~a~%")
pattern)))

Write Preview
Loading…
Cancel
Save