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:
parent
1b7d5242c3
commit
c0c018f180
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue