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.master
parent
1b7d5242c3
commit
c0c018f180
|
@ -34,7 +34,18 @@
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-26)
|
#: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?
|
||||||
manifest-entries
|
manifest-entries
|
||||||
|
|
||||||
|
@ -80,6 +91,22 @@
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; 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.
|
;;; Manifests.
|
||||||
|
|
|
@ -38,6 +38,8 @@
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu packages base)
|
#: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-number (previous-generation-number profile number))
|
||||||
(previous-generation (generation-file-name profile previous-number)))
|
(previous-generation (generation-file-name profile previous-number)))
|
||||||
(cond ((not (file-exists? profile)) ; invalid profile
|
(cond ((not (file-exists? profile)) ; invalid profile
|
||||||
(leave (_ "profile '~a' does not exist~%")
|
(raise (condition (&profile-not-found-error
|
||||||
profile))
|
(profile profile)))))
|
||||||
((zero? number) ; empty profile
|
((zero? number) ; empty profile
|
||||||
(format (current-error-port)
|
(format (current-error-port)
|
||||||
(_ "nothing to do: already at the empty profile~%")))
|
(_ "nothing to do: already at the empty profile~%")))
|
||||||
|
@ -723,8 +725,8 @@ more information.~%"))
|
||||||
(match-lambda
|
(match-lambda
|
||||||
(('delete-generations . pattern)
|
(('delete-generations . pattern)
|
||||||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||||
(leave (_ "profile '~a' does not exist~%")
|
(raise (condition (&profile-not-found-error
|
||||||
profile))
|
(profile profile)))))
|
||||||
((string-null? pattern)
|
((string-null? pattern)
|
||||||
(delete-generations
|
(delete-generations
|
||||||
(%store) profile
|
(%store) profile
|
||||||
|
@ -833,8 +835,8 @@ more information.~%"))
|
||||||
(newline)))
|
(newline)))
|
||||||
|
|
||||||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||||
(leave (_ "profile '~a' does not exist~%")
|
(raise (condition (&profile-not-found-error
|
||||||
profile))
|
(profile profile)))))
|
||||||
((string-null? pattern)
|
((string-null? pattern)
|
||||||
(for-each list-generation (profile-generations profile)))
|
(for-each list-generation (profile-generations profile)))
|
||||||
((matching-generations pattern profile)
|
((matching-generations pattern profile)
|
||||||
|
@ -915,8 +917,8 @@ more information.~%"))
|
||||||
(_ #f))))
|
(_ #f))))
|
||||||
|
|
||||||
(let ((opts (parse-options)))
|
(let ((opts (parse-options)))
|
||||||
(or (process-query opts)
|
(with-error-handling
|
||||||
(with-error-handling
|
(or (process-query opts)
|
||||||
(parameterize ((%store (open-connection)))
|
(parameterize ((%store (open-connection)))
|
||||||
(set-build-options-from-command-line (%store) opts)
|
(set-build-options-from-command-line (%store) opts)
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
|
||||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||||
|
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -231,6 +232,13 @@ interpreted."
|
||||||
(location->string loc)
|
(location->string loc)
|
||||||
(package-full-name package)
|
(package-full-name package)
|
||||||
(build-system-name system))))
|
(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)
|
((nix-connection-error? c)
|
||||||
(leave (_ "failed to connect to `~a': ~a~%")
|
(leave (_ "failed to connect to `~a': ~a~%")
|
||||||
(nix-connection-error-file c)
|
(nix-connection-error-file c)
|
||||||
|
|
Loading…
Reference in New Issue