Attached is a couple patches to update GError.

When I first implemented the GError stuff some years ago the only
mechanism we had available for custom exception types was this thing
called dynamic exceptions. It worked but was annoying since if you
didn't install any handler then the errors would be reported like:

progfoo: <<System.Glib.GError>>

with no details about what it was, just the type. To throw and catch
these things required using special throw/catchGError functions.

These days, with base 4 there is a new exception mechanism. It's
actually pretty similar to the old dynamic exceptions but it builds that
in as the core idea, rather than as an afterthought, and it's much
better thought out.

So both patches eliminate the use of Control.OldException and use the
new Control.Exception.

The first patch converts System.Glib.GError, in particular it means that
GErrors can be thrown and caught with the standard throw/catch/handle,
so I've deprecated the old throwGError/catchGError/handleGError.

The second patch converts a couple places in the gtk package.

So, this is an improvement because now by default you'll get the actual
error message printed if a GError is unhandled, so there is no need to
catch GErrors just to convert them into "ordinary" exceptions.

However for catching GErrors we can do better, and these patches are
just the first step. With the current GError API, if you want to catch
just some GErrors then you have to use:

catchGErrorJustDomain
   loadImage
   (\err message -> case err of
       PixbufErrorCorruptImage -> ...
       PixbufErrorInsufficientMemory -> ...
       PixbufErrorUnknownType -> ...
       _ -> ...)

It relies on the fact that a GError contains a code to identify the
"domain" of the error, e.g. pixbuf errors, glib file IO errors, gtk
builder errors etc. Then within each domain, there's an enumeration of
specific error codes.

The new Control.Exception API has a better way of doing all this, and
glib/gtk should really use it, as it'd better match the rest of the
standard Haskell libraries. 

http://www.haskell.org/ghc/docs/7.0.2/html/libraries/base-4.3.1.0/Control-Exception.html

The way the new Control.Exception works is to make specific types of
exception an instance of the Exception class, then the ordinary 'catch'
can be used to catch any exception of that type:

catch
   loadImage
   (\pixbuferr -> case \pixbuferr of
       PixbufErrorCorruptImage -> ...
       PixbufErrorInsufficientMemory -> ...
       PixbufErrorUnknownType -> ...
       _ -> ...)

The type of the handler determines which type of exceptions are caught.

So we would want to do is to have each glib Error enumeration correspond
to a new Haskell enum type which is an instance of the standard
Exception class. As it suggests in the Control.Exception docs above, it
would make sense to have at least one level of hierarchy so that you can
catch all glib/gtk related exceptions rather than having to catch each
one individually. This would be useful anyway since they have common
attributes (e.g. a message and an error quark).

The main difficulty is that the possible GError domains would need to be
known at the point at which the exception is thrown, rather than at the
point where it is caught (as the current GError module works now). The
propagateGError function would have to be given a list of GError quarks
and conversion functions so that it could check the GError domain and
throw the appropriate type of Haskell exception. If no matching one is
found then a fallback one would need to be used (this would at least
contain the error message, if not the enum value).

propagateGError [Glib.fileIOExceptions, Gdk.pixbufExceptions] $ ...

This means we would need to be more comprehensive in the binding of the
various glib/gtk modules' GTK_BLAH_ERROR quarks and GtkBlahError enums.

Duncan
2 patches for repository http://code.haskell.org/gtk2hs:

Wed Apr 20 09:33:58 BST 2011  Duncan Coutts <dun...@community.haskell.org>
  * Switch GError from old style dynamic exceptions to new extensible exceptions

Wed Apr 20 10:00:01 BST 2011  Duncan Coutts <dun...@community.haskell.org>
  * Convert gtk modules to use new exceptions API
  We depend on base 4 now anyway, so there's no compatability issue.

New patches:

[Switch GError from old style dynamic exceptions to new extensible exceptions
Duncan Coutts <dun...@community.haskell.org>**20110420083358
 Ignore-this: 4ee343b45cdb150af0320cff5d7d936
] hunk ./glib/System/Glib/GError.chs 61
   -- particular error domain use 'catchGErrorJustDomain' \/
   -- 'handleGErrorJustDomain'
   --
-  catchGError,
   catchGErrorJust,
   catchGErrorJustDomain,
   
hunk ./glib/System/Glib/GError.chs 64
-  handleGError,
   handleGErrorJust,
   handleGErrorJustDomain,
   
hunk ./glib/System/Glib/GError.chs 67
+  -- ** Deprecated
+  catchGError,
+  handleGError,
   failOnGError,
   throwGError,
 
hunk ./glib/System/Glib/GError.chs 93
 import Foreign
 import Foreign.C
 import System.Glib.UTFString
-#if HAVE_NEW_CONTROL_EXCEPTION
-import Control.OldException
-#else
 import Control.Exception
hunk ./glib/System/Glib/GError.chs 94
-#endif
-
-import Data.Dynamic
-
-{# context lib="gtk" prefix ="gtk" #}
+import Data.Typeable
+import Prelude hiding (catch)
 
 -- | A GError consists of a domain, code and a human readable message.
 data GError = GError !GErrorDomain !GErrorCode !GErrorMessage
hunk ./glib/System/Glib/GError.chs 101
   deriving Typeable
 
+instance Show GError where
+  show (GError _ _ msg) = msg
+
+instance Exception GError
+
+
 type GQuark = {#type GQuark #}
 
 -- | A code used to identify the \'namespace\' of the error. Within each error
hunk ./glib/System/Glib/GError.chs 188
 -- | Use this if you need to explicitly throw a GError or re-throw an existing
 --   GError that you do not wish to handle.
 throwGError :: GError -> IO a
-throwGError gerror = evaluate (throwDyn gerror)
+throwGError = throw
+{-# DEPRECATED throwGError "Use ordinary Control.Exception.throw" #-}
 
 -- | This will catch any GError exception. The handler function will receive 
the
 --   raw GError. This is probably only useful when you want to take some action
hunk ./glib/System/Glib/GError.chs 205
 catchGError :: IO a            -- ^ The computation to run
             -> (GError -> IO a) -- ^ Handler to invoke if an exception is 
raised
             -> IO a
-catchGError action handler = catchDyn action handler
+catchGError = catch
+{-# DEPRECATED catchGError "Use ordinary Control.Exception.catch" #-}
 
 -- | This will catch just a specific GError exception. If you need to catch a
 --   range of related errors, 'catchGErrorJustDomain' is probably more
hunk ./glib/System/Glib/GError.chs 221
                 -> IO a                    -- ^ The computation to run
                 -> (GErrorMessage -> IO a) -- ^ Handler to invoke if an 
exception is raised
                 -> IO a
-catchGErrorJust code action handler = catchGError action handler'
+catchGErrorJust code action handler = catch action handler'
   where handler' gerror@(GError domain code' msg)
           | fromIntegral domain == gerrorDomain code
            && code' == fromEnum code   = handler msg
hunk ./glib/System/Glib/GError.chs 225
-          | otherwise                  = throwGError gerror
+          | otherwise                  = throw gerror
 
 -- | Catch all GErrors from a particular error domain. The handler function
 --   should just deal with one error enumeration type. If you need to catch
hunk ./glib/System/Glib/GError.chs 244
                       -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke 
if an exception is raised
                       -> IO a
 catchGErrorJustDomain action (handler :: err -> GErrorMessage -> IO a) =
-    catchGError action handler'
+    catch action handler'
   where handler' gerror@(GError domain code msg)
           | fromIntegral domain == gerrorDomain (undefined::err) = handler 
(toEnum code) msg
           | otherwise                                            = throwGError 
gerror
hunk ./glib/System/Glib/GError.chs 255
 -- >   ...
 --   
 handleGError :: (GError -> IO a) -> IO a -> IO a
-handleGError = flip catchGError
+handleGError = handle
+{-# DEPRECATED handleGError "Use ordinary Control.Exception.handle" #-}
 
 -- | A verson of 'handleGErrorJust' with the arguments swapped around.
 handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a 
-> IO a
hunk ./glib/System/Glib/GError.chs 262
 handleGErrorJust code = flip (catchGErrorJust code)
 
--- | A verson of 'handleGErrorJustDomain' with the arguments swapped around.
+-- | A verson of 'catchGErrorJustDomain' with the arguments swapped around.
 handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> 
IO a -> IO a
 handleGErrorJustDomain = flip catchGErrorJustDomain
 
hunk ./glib/System/Glib/StoreValue.hsc 37
 
 import Control.Monad   (liftM)
 
-#if HAVE_NEW_CONTROL_EXCEPTION
-import Control.OldException
-#else
-import Control.Exception
-                          (throw, Exception(AssertionFailed))
-#endif
+import Control.Exception  (throw, AssertionFailed(..))
 
 #include<glib-object.h>
 
hunk ./glib/glib.cabal 38
         build-depends:  base >= 4 && < 5,
                         containers, haskell98
         build-tools:    gtk2hsC2hs
-        cpp-options:     -DHAVE_NEW_CONTROL_EXCEPTION
         if flag(closure_signals)
           cpp-options:  -DUSE_GCLOSURE_SIGNALS_IMPL
           c-sources: System/Glib/hsgclosure.c
[Convert gtk modules to use new exceptions API
Duncan Coutts <dun...@community.haskell.org>**20110420090001
 Ignore-this: 3f3114a03345d445300ebec4f7396d8
 We depend on base 4 now anyway, so there's no compatability issue.
] hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 81
 
 import Control.Monad   (when)
 import Data.Maybe      (fromJust, isJust)
-#ifdef HAVE_NEW_CONTROL_EXCEPTION
-import Control.OldException (handle)
-#else
-import Control.Exception (handle)
-#endif
+import Control.Exception (handle, ErrorCall(..))
 
 import System.Glib.FFI
 import System.Glib.GObject             (wrapNewGObject)
hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 109
   mask <- pokeGCValues vPtr gcv
   gc <- wrapNewGObject mkGC $ {#call unsafe gc_new_with_values#} 
     (toDrawable d) (castPtr vPtr) mask
-  handle (const $ return ()) $ when (isJust (tile gcv)) $ 
+  handle (\(ErrorCall _) -> return ()) $ when (isJust (tile gcv)) $
     touchForeignPtr ((unPixmap.fromJust.tile) gcv)
hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 111
-  handle (const $ return ()) $ when (isJust (stipple gcv)) $ 
+  handle (\(ErrorCall _) -> return ()) $ when (isJust (stipple gcv)) $
     touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 113
-  handle (const $ return ()) $ when (isJust (clipMask gcv)) $ 
+  handle (\(ErrorCall _) -> return ()) $ when (isJust (clipMask gcv)) $
     touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
   return gc
 
hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 123
 gcSetValues gc gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do
   mask <- pokeGCValues vPtr gcv
   gc <- {#call unsafe gc_set_values#} gc (castPtr vPtr) mask
-  handle (const $ return ()) $ when (isJust (tile gcv)) $ 
+  handle (\(ErrorCall _) -> return ()) $ when (isJust (tile gcv)) $
     touchForeignPtr ((unPixmap.fromJust.tile) gcv)
hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 125
-  handle (const $ return ()) $ when (isJust (stipple gcv)) $ 
+  handle (\(ErrorCall _) -> return ()) $ when (isJust (stipple gcv)) $
     touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
hunk ./gtk/Graphics/UI/Gtk/Gdk/GC.chs 127
-  handle (const $ return ()) $ when (isJust (clipMask gcv)) $ 
+  handle (\(ErrorCall _) -> return ()) $ when (isJust (clipMask gcv)) $
     touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
   return gc
 
hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 109
 
 import Control.Monad           (liftM)
 import Data.IORef
-#ifdef HAVE_NEW_CONTROL_EXCEPTION
-import Control.OldException
-#else
-import Control.Exception
-#endif
+import Control.Exception (handle, ErrorCall(..))
 
 import System.Glib.FFI
 import System.Glib.UTFString ( UTFCorrection, ofsToUTF )
hunk ./gtk/gtk.cabal 372
         -- needs to be imported from this module:
         x-Signals-Import: Graphics.UI.Gtk.General.Threading
         include-dirs:   .
-        cpp-options:    -DHAVE_NEW_CONTROL_EXCEPTION
         if !flag(deprecated)
           cpp-options:  -DDISABLE_DEPRECATED
         else

Context:

[Fix typo and add docs in INSTALL
Andy Stewart <lazycat.mana...@gmail.com>**20101222122119
 Ignore-this: bc363a0efc4f6c975f35a3c8ffdbca1
] 
[Add have-quartz-gtk flag to disable linking against gdk_x11_drawable_get_xid
Max Bolingbroke <batterseapo...@hotmail.com>**20101222113914
 Ignore-this: 3cf2009a8db78814ad5de1ed0b2173ba
] 
[Fix docs about 'imContextRetrieveSurrounding' signal.
Andy Stewart <lazycat.mana...@gmail.com>**20101217115003
 Ignore-this: 26e7b7d10a3e97f7a185a0afbe72a9b9
] 
[Don't emit an update signal with the incorrect stamp.
axel.si...@in.tum.de**20101216124643
 Ignore-this: 64b053e5495b4879923b802194b91111
] 
[Wrap version flag make gio can compile under gio-2.18.x
Andy Stewart <lazycat.mana...@gmail.com>**20101130130716
 Ignore-this: 84989139d42c5790828cadaaec6a73bf
] 
[Wrap 2.16.0 with EntryIconPosition to make gtk can compile in gtk+-2.14.x
Andy Stewart <lazycat.mana...@gmail.com>**20101130125652
 Ignore-this: 2853a6fc9749f123b67ddc0b10b53174
] 
[Add functions to query and show tooltips in TreeViews.
axel.si...@in.tum.de**20101123090253
 Ignore-this: fa122105338c3b22d0ebccb8e213ebd0
] 
[Add a note on broken binary Gtk+ installers on Windows.
axel.si...@in.tum.de**20101116154707
 Ignore-this: 30ab8f947870103cca14271237e5b423
] 
[Added basic GString support.
Andreas Baldeau <andr...@baldeau.net>**20101115103157
 Ignore-this: 4fc62813b652cc6e420c7b69006dfdae
] 
[TAG 0.12.0
axel.si...@in.tum.de**20101107135304
 Ignore-this: 14b3023f48c36eed2cb136a2b69d6dae
] 
Patch bundle hash:
a1a06175a7c5b09aebb5996fe943eff13566ae0c
------------------------------------------------------------------------------
Benefiting from Server Virtualization: Beyond Initial Workload 
Consolidation -- Increasing the use of server virtualization is a top
priority.Virtualization can reduce costs, simplify management, and improve 
application availability and disaster protection. Learn more about boosting 
the value of server virtualization. http://p.sf.net/sfu/vmware-sfdev2dev
_______________________________________________
Gtk2hs-devel mailing list
Gtk2hs-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/gtk2hs-devel

Reply via email to