diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-10-30 22:08:35 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-10-30 22:09:33 +0100 |
commit | 477d30d0d8dddf1f92e4a2730cbc4434d8f81c0c (patch) | |
tree | aae4c3a5a471cf9ccd50152fb537badf632ca6cf | |
parent | 1fcc3ba3090a1369afd50c47dc50c17695672120 (diff) | |
download | guix-477d30d0d8dddf1f92e4a2730cbc4434d8f81c0c.tar.gz |
guix package: Factorize generation file name computation.
* guix/scripts/package.scm (generation-file-name): New procedure. Change all occurrences of (format #f "~a-~a-link" profile number) to use it.
-rw-r--r-- | guix/scripts/package.scm | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 339d1afd36..008ae53b47 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -299,6 +299,10 @@ the given MANIFEST." (compose string->number (cut match:substring <> 1))) 0)) +(define (generation-file-name profile generation) + "Return the file name for PROFILE's GENERATION." + (format #f "~a-~a-link" profile generation)) + (define (link-to-empty-profile generation) "Link GENERATION, a string, to the empty profile." (let* ((drv (profile-derivation (%store) (manifest '()))) @@ -312,8 +316,7 @@ the given MANIFEST." "Atomically switch PROFILE to the previous generation." (let* ((number (generation-number profile)) (previous-number (previous-generation-number profile number)) - (previous-generation (format #f "~a-~a-link" - profile previous-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))) @@ -322,8 +325,7 @@ the given MANIFEST." "Roll back to the previous generation of PROFILE." (let* ((number (generation-number profile)) (previous-number (previous-generation-number profile number)) - (previous-generation (format #f "~a-~a-link" - profile previous-number)) + (previous-generation (generation-file-name profile previous-number)) (manifest (string-append previous-generation "/manifest"))) (cond ((not (file-exists? profile)) ; invalid profile (leave (_ "profile '~a' does not exist~%") @@ -341,7 +343,7 @@ the given MANIFEST." (define (generation-time profile number) "Return the creation time of a generation in the UTC format." (make-time time-utc 0 - (stat:ctime (stat (format #f "~a-~a-link" profile number))))) + (stat:ctime (stat (generation-file-name profile number))))) (define* (matching-generations str #:optional (profile %current-profile) #:key (duration-relation <=)) @@ -1029,15 +1031,15 @@ more information.~%")) (generation-number profile)) (define (display-and-delete number) - (let ((generation (format #f "~a-~a-link" profile 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 (format #f "~a-~a-link" - profile previous-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))) @@ -1128,14 +1130,14 @@ more information.~%")) #:dry-run? dry-run?) (or dry-run? - (let* ((prof (derivation->output-path prof-drv)) - (number (generation-number profile)) + (let* ((prof (derivation->output-path prof-drv)) + (number (generation-number profile)) ;; Always use NUMBER + 1 for the new profile, ;; possibly overwriting a "previous future ;; generation". - (name (format #f "~a-~a-link" - profile (+ 1 number)))) + (name (generation-file-name profile + (+ 1 number)))) (and (build-derivations (%store) (list prof-drv)) (let ((count (length entries))) (switch-symlinks name prof) @@ -1173,7 +1175,7 @@ more information.~%")) (reverse (manifest-entries (profile-manifest - (format #f "~a-~a-link" profile number))))) + (generation-file-name profile number))))) (newline))) (cond ((not (file-exists? profile)) ; XXX: race condition |