From c0c018f1805d8410ffb1bc2abb1295ebbe55c38b Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 17:29:01 +0400
Subject: profiles: Add condition types for profiles and generations.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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.
---
 guix/profiles.scm        | 29 ++++++++++++++++++++++++++++-
 guix/scripts/package.scm | 18 ++++++++++--------
 guix/ui.scm              |  8 ++++++++
 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
 
@@ -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.
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)
-- 
cgit 1.4.1