summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2014-10-08 17:29:01 +0400
committerAlex Kost <alezost@gmail.com>2014-10-12 08:45:37 +0400
commitc0c018f1805d8410ffb1bc2abb1295ebbe55c38b (patch)
treefdc2cb3abd7b61eaf3b93b39552a71adc288430c
parent1b7d5242c36d82242f1148cc583ea362d3e83577 (diff)
profiles: Add condition types for profiles and generations.
Suggested by Ludovic Courtès. * guix/profiles.scm (&profile-error, &profile-not-found-error, &missing-generation-error): New condition types. * guix/ui.scm (call-with-error-handling): Handle new types. * guix/scripts/package.scm (roll-back, guix-package): Raise '&profile-not-found-error' where needed.
-rw-r--r--guix/profiles.scm29
-rw-r--r--guix/scripts/package.scm18
-rw-r--r--guix/ui.scm8
3 files changed, 46 insertions, 9 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index f2eb754bca..793af2463f 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -34,7 +34,18 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
- #:export (manifest make-manifest
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:export (&profile-error
+ profile-error?
+ profile-error-profile
+ &profile-not-found-error
+ profile-not-found-error?
+ &missing-generation-error
+ missing-generation-error?
+ missing-generation-error-generation
+
+ manifest make-manifest
manifest?
manifest-entries
@@ -82,6 +93,22 @@
;;;
+;;; Condition types.
+;;;
+
+(define-condition-type &profile-error &error
+ profile-error?
+ (profile profile-error-profile))
+
+(define-condition-type &profile-not-found-error &profile-error
+ profile-not-found-error?)
+
+(define-condition-type &missing-generation-error &profile-error
+ missing-generation-error?
+ (generation missing-generation-error-generation))
+
+
+;;;
;;; Manifests.
;;;
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 031f71a441..ab9d303127 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -38,6 +38,8 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (gnu packages)
#:use-module (gnu packages base)
@@ -109,8 +111,8 @@ return PROFILE unchanged. The goal is to treat '-p ~/.guix-profile' as if
(previous-number (previous-generation-number profile number))
(previous-generation (generation-file-name profile previous-number)))
(cond ((not (file-exists? profile)) ; invalid profile
- (leave (_ "profile '~a' does not exist~%")
- profile))
+ (raise (condition (&profile-not-found-error
+ (profile profile)))))
((zero? number) ; empty profile
(format (current-error-port)
(_ "nothing to do: already at the empty profile~%")))
@@ -723,8 +725,8 @@ more information.~%"))
(match-lambda
(('delete-generations . pattern)
(cond ((not (file-exists? profile)) ; XXX: race condition
- (leave (_ "profile '~a' does not exist~%")
- profile))
+ (raise (condition (&profile-not-found-error
+ (profile profile)))))
((string-null? pattern)
(delete-generations
(%store) profile
@@ -833,8 +835,8 @@ more information.~%"))
(newline)))
(cond ((not (file-exists? profile)) ; XXX: race condition
- (leave (_ "profile '~a' does not exist~%")
- profile))
+ (raise (condition (&profile-not-found-error
+ (profile profile)))))
((string-null? pattern)
(for-each list-generation (profile-generations profile)))
((matching-generations pattern profile)
@@ -915,8 +917,8 @@ more information.~%"))
(_ #f))))
(let ((opts (parse-options)))
- (or (process-query opts)
- (with-error-handling
+ (with-error-handling
+ (or (process-query opts)
(parameterize ((%store (open-connection)))
(set-build-options-from-command-line (%store) opts)
diff --git a/guix/ui.scm b/guix/ui.scm
index 8c4a9d2d22..69b073da50 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -231,6 +232,13 @@ interpreted."
(location->string loc)
(package-full-name package)
(build-system-name system))))
+ ((profile-not-found-error? c)
+ (leave (_ "profile '~a' does not exist~%")
+ (profile-error-profile c)))
+ ((missing-generation-error? c)
+ (leave (_ "generation ~a of profile '~a' does not exist~%")
+ (missing-generation-error-generation c)
+ (profile-error-profile c)))
((nix-connection-error? c)
(leave (_ "failed to connect to `~a': ~a~%")
(nix-connection-error-file c)