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.
This commit is contained in:
Alex Kost 2014-10-08 17:29:01 +04:00
parent 1b7d5242c3
commit c0c018f180
3 changed files with 46 additions and 9 deletions

View File

@ -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
@ -80,6 +91,22 @@
;;;
;;; Code:
;;;
;;; 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.

View File

@ -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)

View File

@ -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)