{-# LANGUAGE ScopedTypeVariables,DeriveDataTypeable #-}

{-# LINE 2 "./System/Glib/GError.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) GError API
--
-- Author : Duncan Coutts
--
-- Created: 2 July 2004
--
-- Copyright (C) 2004 Duncan Coutts
-- parts derived from Structs.hsc Copyright (c) 1999..2002 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Error Reporting, glib's system for reporting errors.
--
-- 'GError's are used by glib to report recoverable runtime errors.
--
-- This module provides functions for checking glib\/gtk functions that report
-- 'GError's. It also provides functions for throwing and catching 'GError's as
-- Haskell exceptions.
--
module System.Glib.GError (

  -- * Data types
  --
  GError(..),
  GErrorDomain,
  GErrorCode,
  GErrorMessage,

  -- * Catching GError exceptions
  -- | To catch GError exceptions thrown by Gtk2Hs functions use the
  -- catchGError* or handleGError* functions. They work in a similar way to
  -- the standard 'Control.Exception.catch' and 'Control.Exception.handle'
  -- functions.
  --
  -- 'catchGError' \/ 'handleGError' catches all GError exceptions, you provide
  -- a handler function that gets given the GError if an exception was thrown.
  -- This is the most general but is probably not what you want most of the
  -- time. It just gives you the raw error code rather than a Haskell
  -- enumeration of the error codes. Most of the time you will only want to
  -- catch a specific error or any error from a specific error domain. To
  -- catch just a single specific error use
  -- 'catchGErrorJust' \/ 'handleGErrorJust'. To catch any error in a
  -- particular error domain use 'catchGErrorJustDomain' \/
  -- 'handleGErrorJustDomain'
  --
  catchGErrorJust,
  catchGErrorJustDomain,

  handleGErrorJust,
  handleGErrorJustDomain,

  -- ** Deprecated
  catchGError,
  handleGError,
  failOnGError,
  throwGError,

  -- * Checking for GErrors returned by glib\/gtk functions
  -- | * Note, these functions are only useful to implementors
  --
  -- If you are wrapping a new API that reports 'GError's you should probably
  -- use 'propagateGError' to convert the GError into an exception. You should
  -- also note in the documentation for the function that it throws GError
  -- exceptions and the Haskell enumeration for the expected glib GError
  -- domain(s), so that users know what exceptions they might want to catch.
  --
  -- If you think it is more appropriate to use an alternate return value (eg
  -- Either\/Maybe) then you should use 'checkGError'.

  GErrorClass(..),
  propagateGError,
  checkGError
  ) where

import Foreign
import Foreign.C
import System.Glib.UTFString
import Control.Exception
import Data.Typeable
import Data.Text (Text)
import qualified Data.Text as T (unpack)
import Prelude hiding (catch)

-- | A GError consists of a domain, code and a human readable message.
data GError = GError !GErrorDomain !GErrorCode !GErrorMessage
  deriving Typeable

instance Show GError where
  show :: GError -> String
show (GError GErrorDomain
_ Int
_ GErrorMessage
msg) = GErrorMessage -> String
T.unpack GErrorMessage
msg

instance Exception GError


type GQuark = (CUInt)
{-# LINE 110 "./System/Glib/GError.chs" #-}

-- | A code used to identify the \'namespace\' of the error. Within each error
-- domain all the error codes are defined in an enumeration. Each gtk\/gnome
-- module that uses GErrors has its own error domain. The rationale behind
-- using error domains is so that each module can organise its own error codes
-- without having to coordinate on a global error code list.
type GErrorDomain = GQuark

-- | A code to identify a specific error within a given 'GErrorDomain'. Most of
-- time you will not need to deal with this raw code since there is an
-- enumeration type for each error domain. Of course which enumeraton to use
-- depends on the error domain, but if you use 'catchGErrorJustDomain' or
-- 'handleGErrorJustDomain', this is worked out for you automatically.
type GErrorCode = Int

-- | A human readable error message.
type GErrorMessage = Text

instance Storable GError where
  sizeOf :: GError -> Int
sizeOf GError
_ = Int
16
{-# LINE 130 "./System/Glib/GError.chs" #-}
  alignment _ = alignment (undefined:: GQuark)
  peek :: Ptr GError -> IO GError
peek Ptr GError
ptr = do
    (GErrorDomain
domain :: GQuark) <- (\Ptr GError
ptr -> do {Ptr GError -> Int -> IO GErrorDomain
forall b. Ptr b -> Int -> IO GErrorDomain
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GError
ptr Int
0 ::IO CUInt}) Ptr GError
ptr
    (CInt
code :: (CInt)) <- (\Ptr GError
ptr -> do {Ptr GError -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GError
ptr Int
4 ::IO CInt}) Ptr GError
ptr
    (Ptr CChar
msgPtr :: CString) <- (\Ptr GError
ptr -> do {Ptr GError -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GError
ptr Int
8 ::IO (Ptr CChar)}) Ptr GError
ptr
    GErrorMessage
msg <- Ptr CChar -> IO GErrorMessage
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
msgPtr
    GError -> IO GError
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GError -> IO GError) -> GError -> IO GError
forall a b. (a -> b) -> a -> b
$ GErrorDomain -> Int -> GErrorMessage -> GError
GError (GErrorDomain -> GErrorDomain
forall a b. (Integral a, Num b) => a -> b
fromIntegral GErrorDomain
domain) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code) GErrorMessage
msg
  poke :: Ptr GError -> GError -> IO ()
poke Ptr GError
_ = String -> GError -> IO ()
forall a. HasCallStack => String -> a
error String
"GError::poke: not implemented"

-- | Each error domain's error enumeration type should be an instance of this
-- class. This class helps to hide the raw error and domain codes from the
-- user. This interface should be implemented by calling the approrpiate
-- @{error_domain}_error_quark@. It is safe to use a pure FFI call for this.
--
-- Example for 'Graphics.UI.Gtk.Gdk.Pixbuf.PixbufError':
--
-- > instance GErrorClass PixbufError where
-- > gerrorDomain _ = {#call pure unsafe pixbuf_error_quark#}
--
class Enum err => GErrorClass err where
  gerrorDomain :: err -> GErrorDomain -- ^ This must not use the value of its
                                      -- parameter so that it is safe to pass
                                      -- 'undefined'.

-- | Glib functions which report 'GError's take as a parameter a @GError
-- **error@. Use this function to supply such a parameter. It checks if an
-- error was reported and if so throws it as a Haskell exception.
--
-- Example of use:
--
-- > propagateGError $ \gerrorPtr ->
-- > {# call g_some_function_that_might_return_an_error #} a b gerrorPtr
--
propagateGError :: (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError :: forall a. (Ptr (Ptr ()) -> IO a) -> IO a
propagateGError Ptr (Ptr ()) -> IO a
action = (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
forall a. (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError Ptr (Ptr ()) -> IO a
action GError -> IO a
forall a. GError -> IO a
throwGError

-- | Like 'propagateGError' but instead of throwing the GError as an exception
-- handles the error immediately using the supplied error handler.
--
-- Example of use:
--
-- > checkGError
-- > (\gerrorPtr -> {# call g_some_function_that_might_return_an_error #} a b gerrorPtr)
-- > (\(GError domain code msg) -> ...)
--
checkGError :: (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError :: forall a. (Ptr (Ptr ()) -> IO a) -> (GError -> IO a) -> IO a
checkGError Ptr (Ptr ()) -> IO a
action GError -> IO a
handler =
  (Ptr (Ptr GError) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr GError) -> IO a) -> IO a)
-> (Ptr (Ptr GError) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr (Ptr GError)
errPtrPtr :: Ptr (Ptr GError)) -> do
  Ptr (Ptr GError) -> Ptr GError -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr GError)
errPtrPtr Ptr GError
forall a. Ptr a
nullPtr
  a
result <- Ptr (Ptr ()) -> IO a
action (Ptr (Ptr GError) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr GError)
errPtrPtr)
  Ptr GError
errPtr <- Ptr (Ptr GError) -> IO (Ptr GError)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
errPtrPtr
  if Ptr GError
errPtr Ptr GError -> Ptr GError -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GError
forall a. Ptr a
nullPtr
    then a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
    else do GError
gerror <- Ptr GError -> IO GError
forall a. Storable a => Ptr a -> IO a
peek Ptr GError
errPtr
            Ptr () -> IO ()
g_error_free (Ptr GError -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GError
errPtr)
            GError -> IO a
handler GError
gerror

-- | 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 :: forall a. GError -> IO a
throwGError = GError -> IO a
forall a e. Exception e => e -> a
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
-- that does not depend on which GError exception has occurred, otherwise it
-- would be better to use either 'catchGErrorJust' or 'catchGErrorJustDomain'.
-- For example:
--
-- > catchGError
-- > (do ...
-- > ...)
-- > (\(GError dom code msg) -> fail msg)
--
catchGError :: IO a -- ^ The computation to run
            -> (GError -> IO a) -- ^ Handler to invoke if an exception is raised
            -> IO a
catchGError :: forall a. IO a -> (GError -> IO a) -> IO a
catchGError = IO a -> (GError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
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
-- appropriate. Example:
--
-- > do image <- catchGErrorJust PixbufErrorCorruptImage
-- > loadImage
-- > (\errorMessage -> do log errorMessage
-- > return missingImagePlaceholder)
--
catchGErrorJust :: GErrorClass err => err -- ^ The error to catch
                -> IO a -- ^ The computation to run
                -> (GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                -> IO a
catchGErrorJust :: forall err a.
GErrorClass err =>
err -> IO a -> (GErrorMessage -> IO a) -> IO a
catchGErrorJust err
code IO a
action GErrorMessage -> IO a
handler = IO a -> (GError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
action GError -> IO a
handler'
  where handler' :: GError -> IO a
handler' gerror :: GError
gerror@(GError GErrorDomain
domain Int
code' GErrorMessage
msg)
          | GErrorDomain -> GErrorDomain
forall a b. (Integral a, Num b) => a -> b
fromIntegral GErrorDomain
domain GErrorDomain -> GErrorDomain -> Bool
forall a. Eq a => a -> a -> Bool
== err -> GErrorDomain
forall err. GErrorClass err => err -> GErrorDomain
gerrorDomain err
code
           Bool -> Bool -> Bool
&& Int
code' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== err -> Int
forall a. Enum a => a -> Int
fromEnum err
code   = GErrorMessage -> IO a
handler GErrorMessage
msg
          | Bool
otherwise = GError -> IO a
forall a e. Exception e => e -> a
throw GError
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
-- errors from more than one error domain, use this function twice with an
-- appropriate handler functions for each.
--
-- > catchGErrorJustDomain
-- > loadImage
-- > (\err message -> case err of
-- > PixbufErrorCorruptImage -> ...
-- > PixbufErrorInsufficientMemory -> ...
-- > PixbufErrorUnknownType -> ...
-- > _ -> ...)
--
catchGErrorJustDomain :: GErrorClass err => IO a -- ^ The computation to run
                      -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                      -> IO a
catchGErrorJustDomain :: forall err a.
GErrorClass err =>
IO a -> (err -> GErrorMessage -> IO a) -> IO a
catchGErrorJustDomain IO a
action (err -> GErrorMessage -> IO a
handler :: err -> GErrorMessage -> IO a) =
    IO a -> (GError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
action GError -> IO a
handler'
  where handler' :: GError -> IO a
handler' gerror :: GError
gerror@(GError GErrorDomain
domain Int
code GErrorMessage
msg)
          | GErrorDomain -> GErrorDomain
forall a b. (Integral a, Num b) => a -> b
fromIntegral GErrorDomain
domain GErrorDomain -> GErrorDomain -> Bool
forall a. Eq a => a -> a -> Bool
== err -> GErrorDomain
forall err. GErrorClass err => err -> GErrorDomain
gerrorDomain (err
forall a. HasCallStack => a
undefined::err) = err -> GErrorMessage -> IO a
handler (Int -> err
forall a. Enum a => Int -> a
toEnum Int
code) GErrorMessage
msg
          | Bool
otherwise = GError -> IO a
forall a. GError -> IO a
throwGError GError
gerror

-- | A version of 'catchGError' with the arguments swapped around.
--
-- > handleGError (\(GError dom code msg) -> ...) $
-- > ...
--
handleGError :: (GError -> IO a) -> IO a -> IO a
handleGError :: forall a. (GError -> IO a) -> IO a -> IO a
handleGError = (GError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
{-# DEPRECATED handleGError "Use ordinary Control.Exception.handle" #-}

-- | A version of 'handleGErrorJust' with the arguments swapped around.
handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJust :: forall err a.
GErrorClass err =>
err -> (GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJust err
code = (IO a -> (GErrorMessage -> IO a) -> IO a)
-> (GErrorMessage -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (err -> IO a -> (GErrorMessage -> IO a) -> IO a
forall err a.
GErrorClass err =>
err -> IO a -> (GErrorMessage -> IO a) -> IO a
catchGErrorJust err
code)

-- | A version of 'catchGErrorJustDomain' with the arguments swapped around.
handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJustDomain :: forall err a.
GErrorClass err =>
(err -> GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJustDomain = (IO a -> (err -> GErrorMessage -> IO a) -> IO a)
-> (err -> GErrorMessage -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> (err -> GErrorMessage -> IO a) -> IO a
forall err a.
GErrorClass err =>
IO a -> (err -> GErrorMessage -> IO a) -> IO a
catchGErrorJustDomain

-- | Catch all GError exceptions and convert them into a general failure.
failOnGError :: IO a -> IO a
failOnGError :: forall a. IO a -> IO a
failOnGError IO a
action = IO a -> (GError -> IO a) -> IO a
forall a. IO a -> (GError -> IO a) -> IO a
catchGError IO a
action (\(GError GErrorDomain
dom Int
code GErrorMessage
msg) -> String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (GErrorMessage -> String
T.unpack GErrorMessage
msg))

foreign import ccall unsafe "g_error_free"
  g_error_free :: ((Ptr ()) -> (IO ()))