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.
#: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
;;; Code:
\f
+;;;
+;;; 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))
+
+\f
;;;
;;; Manifests.
;;;
#: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)
(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~%")))
(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
(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)
(_ #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)
;;; 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.
;;;
(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)