{-# LINE 1 "Data/GI/Base/GError.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}

-- | To catch GError exceptions use the
-- catchGError* or handleGError* functions. They work in a similar
-- way to the standard 'Control.Exception.catch' and
-- 'Control.Exception.handle' functions.
--
-- To catch just a single specific error use 'catchGErrorJust' \/
-- 'handleGErrorJust'. To catch any error in a particular error domain
-- use 'catchGErrorJustDomain' \/ 'handleGErrorJustDomain'
--
-- For convenience, generated code also includes specialized variants
-- of 'catchGErrorJust' \/ 'handleGErrorJust' for each error type. For
-- example, for errors of type <https://hackage.haskell.org/package/gi-gdkpixbuf/docs/GI-GdkPixbuf-Enums.html#t:PixbufError PixbufError> one could
-- invoke <https://hackage.haskell.org/package/gi-gdkpixbuf/docs/GI-GdkPixbuf-Enums.html#v:catchPixbufError catchPixbufError> \/
-- <https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.14/docs/GI-GdkPixbuf-Enums.html#v:handlePixbufError handlePixbufError>. The definition is simply
--
-- > catchPixbufError :: IO a -> (PixbufError -> GErrorMessage -> IO a) -> IO a
-- > catchPixbufError = catchGErrorJustDomain
--
-- Notice that the type is suitably specialized, so only
-- errors of type <https://hackage.haskell.org/package/gi-gdkpixbuf/docs/GI-GdkPixbuf-Enums.html#t:PixbufError PixbufError> will be caught.
module Data.GI.Base.GError
    (
    -- * Unpacking GError
    --
      GError(..)
    , gerrorDomain
    , gerrorCode
    , gerrorMessage

    , GErrorDomain
    , GErrorCode
    , GErrorMessage

    -- * Catching GError exceptions
    , catchGErrorJust
    , catchGErrorJustDomain

    , handleGErrorJust
    , handleGErrorJustDomain

    -- * Creating new 'GError's
    , gerrorNew

    -- * Implementation specific details
    -- | The following are used in the implementation
    -- of the bindings, and are in general not necessary for using the
    -- API.
    , GErrorClass(..)

    , propagateGError
    , checkGError
    , maybePokeGError
    ) where


{-# LINE 60 "Data/GI/Base/GError.hsc" #-}

import Foreign (poke, peek)
import Foreign.Ptr (Ptr, plusPtr, nullPtr)
import Foreign.C
import Control.Exception
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Int
import Data.Word

import System.IO.Unsafe (unsafePerformIO)

import Data.GI.Base.BasicTypes (BoxedObject(..), GType(..), ManagedPtr)
import Data.GI.Base.BasicConversions (withTextCString, cstringToText)
import Data.GI.Base.ManagedPtr (wrapBoxed, withManagedPtr, copyBoxed)
import Data.GI.Base.Utils (allocMem, freeMem)



-- | A GError, consisting of a domain, code and a human readable
-- message. These can be accessed by 'gerrorDomain', 'gerrorCode' and
-- 'gerrorMessage' below.
newtype GError = GError (ManagedPtr GError)
    deriving (Typeable)

instance Show GError where
    show :: GError -> String
show gerror :: GError
gerror = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
                       GErrorCode
code <- GError -> IO GErrorCode
gerrorCode GError
gerror
                       GErrorMessage
message <- GError -> IO GErrorMessage
gerrorMessage GError
gerror
                       String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ GErrorMessage -> String
T.unpack GErrorMessage
message String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ GErrorCode -> String
forall a. Show a => a -> String
show GErrorCode
code String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"

instance Exception GError

foreign import ccall "g_error_get_type" g_error_get_type :: IO GType

instance BoxedObject GError where
    boxedType :: GError -> IO GType
boxedType _ = IO GType
g_error_get_type

-- | A GQuark.
type GQuark = Word32
{-# LINE 101 "Data/GI/Base/GError.hsc" #-}

-- | 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 enumeration to use
--   depends on the error domain, but if you use 'catchGErrorJustDomain' or
--   'handleGErrorJustDomain', this is worked out for you automatically.
type GErrorCode = Int32
{-# LINE 115 "Data/GI/Base/GError.hsc" #-}

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

foreign import ccall "g_error_new_literal" g_error_new_literal ::
    GQuark -> GErrorCode -> CString -> IO (Ptr GError)

-- | Create a new 'GError'.
gerrorNew :: GErrorDomain -> GErrorCode -> GErrorMessage -> IO GError
gerrorNew :: GErrorDomain -> GErrorCode -> GErrorMessage -> IO GError
gerrorNew domain :: GErrorDomain
domain code :: GErrorCode
code message :: GErrorMessage
message =
    GErrorMessage -> (CString -> IO GError) -> IO GError
forall a. GErrorMessage -> (CString -> IO a) -> IO a
withTextCString GErrorMessage
message ((CString -> IO GError) -> IO GError)
-> (CString -> IO GError) -> IO GError
forall a b. (a -> b) -> a -> b
$ \cstring :: CString
cstring ->
        GErrorDomain -> GErrorCode -> CString -> IO (Ptr GError)
g_error_new_literal GErrorDomain
domain GErrorCode
code CString
cstring IO (Ptr GError) -> (Ptr GError -> IO GError) -> IO GError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GError -> GError
GError

-- | Return the domain for the given `GError`. This is a GQuark, a
-- textual representation can be obtained with
-- `GI.GLib.quarkToString`.
gerrorDomain :: GError -> IO GQuark
gerrorDomain :: GError -> IO GErrorDomain
gerrorDomain gerror :: GError
gerror =
    GError -> (Ptr GError -> IO GErrorDomain) -> IO GErrorDomain
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GError
gerror ((Ptr GError -> IO GErrorDomain) -> IO GErrorDomain)
-> (Ptr GError -> IO GErrorDomain) -> IO GErrorDomain
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr GError
ptr ->
      Ptr GErrorDomain -> IO GErrorDomain
forall a. Storable a => Ptr a -> IO a
peek (Ptr GErrorDomain -> IO GErrorDomain)
-> Ptr GErrorDomain -> IO GErrorDomain
forall a b. (a -> b) -> a -> b
$ Ptr GError
ptr Ptr GError -> Int -> Ptr GErrorDomain
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (0)
{-# LINE 135 "Data/GI/Base/GError.hsc" #-}

-- | The numeric code for the given `GError`.
gerrorCode :: GError -> IO GErrorCode
gerrorCode :: GError -> IO GErrorCode
gerrorCode gerror :: GError
gerror =
    GError -> (Ptr GError -> IO GErrorCode) -> IO GErrorCode
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GError
gerror ((Ptr GError -> IO GErrorCode) -> IO GErrorCode)
-> (Ptr GError -> IO GErrorCode) -> IO GErrorCode
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr GError
ptr ->
        Ptr GErrorCode -> IO GErrorCode
forall a. Storable a => Ptr a -> IO a
peek (Ptr GErrorCode -> IO GErrorCode)
-> Ptr GErrorCode -> IO GErrorCode
forall a b. (a -> b) -> a -> b
$ Ptr GError
ptr Ptr GError -> Int -> Ptr GErrorCode
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (4)
{-# LINE 141 "Data/GI/Base/GError.hsc" #-}

-- | A text message describing the `GError`.
gerrorMessage :: GError -> IO GErrorMessage
gerrorMessage :: GError -> IO GErrorMessage
gerrorMessage gerror :: GError
gerror =
    GError -> (Ptr GError -> IO GErrorMessage) -> IO GErrorMessage
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GError
gerror ((Ptr GError -> IO GErrorMessage) -> IO GErrorMessage)
-> (Ptr GError -> IO GErrorMessage) -> IO GErrorMessage
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr GError
ptr ->
      (Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr CString -> IO CString) -> Ptr CString -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr GError
ptr Ptr GError -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8)) IO CString -> (CString -> IO GErrorMessage) -> IO GErrorMessage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => CString -> IO GErrorMessage
CString -> IO GErrorMessage
cstringToText
{-# LINE 147 "Data/GI/Base/GError.hsc" #-}

-- | 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.
--
-- Example for <https://hackage.haskell.org/package/gi-gdkpixbuf/docs/GI-GdkPixbuf-Enums.html#t:PixbufError PixbufError>:
--
-- > instance GErrorClass PixbufError where
-- >   gerrorClassDomain _ = "gdk-pixbuf-error-quark"
--
class Enum err => GErrorClass err where
  gerrorClassDomain :: err -> Text   -- ^ This must not use the value of its
                                     -- parameter so that it is safe to pass
                                     -- 'undefined'.

foreign import ccall unsafe "g_quark_try_string" g_quark_try_string ::
    CString -> IO GQuark

-- | Given the string representation of an error domain returns the
--   corresponding error quark.
gErrorQuarkFromDomain :: Text -> IO GQuark
gErrorQuarkFromDomain :: GErrorMessage -> IO GErrorDomain
gErrorQuarkFromDomain domain :: GErrorMessage
domain = GErrorMessage -> (CString -> IO GErrorDomain) -> IO GErrorDomain
forall a. GErrorMessage -> (CString -> IO a) -> IO a
withTextCString GErrorMessage
domain CString -> IO GErrorDomain
g_quark_try_string

-- | 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 mssingImagePlaceholder)
--
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 :: err -> IO a -> (GErrorMessage -> IO a) -> IO a
catchGErrorJust code :: err
code action :: IO a
action handler :: 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 = do
          GErrorDomain
quark <- GErrorMessage -> IO GErrorDomain
gErrorQuarkFromDomain (err -> GErrorMessage
forall err. GErrorClass err => err -> GErrorMessage
gerrorClassDomain err
code)
          GErrorDomain
domain <- GError -> IO GErrorDomain
gerrorDomain GError
gerror
          GErrorCode
code' <- GError -> IO GErrorCode
gerrorCode GError
gerror
          if GErrorDomain
domain GErrorDomain -> GErrorDomain -> Bool
forall a. Eq a => a -> a -> Bool
== GErrorDomain
quark Bool -> Bool -> Bool
&& GErrorCode
code' GErrorCode -> GErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> GErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> GErrorCode) -> (err -> Int) -> err -> GErrorCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Int
forall a. Enum a => a -> Int
fromEnum) err
code
          then GError -> IO GErrorMessage
gerrorMessage GError
gerror IO GErrorMessage -> (GErrorMessage -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GErrorMessage -> IO a
handler
          else GError -> IO a
forall a e. Exception e => e -> a
throw GError
gerror -- Pass it on

-- | 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 :: forall err a. GErrorClass err =>
                         IO a        -- ^ The computation to run
                      -> (err -> GErrorMessage -> IO a) -- ^ Handler to invoke if an exception is raised
                      -> IO a
catchGErrorJustDomain :: IO a -> (err -> GErrorMessage -> IO a) -> IO a
catchGErrorJustDomain action :: IO a
action handler :: err -> 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 = do
          GErrorDomain
quark <- GErrorMessage -> IO GErrorDomain
gErrorQuarkFromDomain (err -> GErrorMessage
forall err. GErrorClass err => err -> GErrorMessage
gerrorClassDomain (err
forall a. HasCallStack => a
undefined :: err))
          GErrorDomain
domain <- GError -> IO GErrorDomain
gerrorDomain GError
gerror
          if GErrorDomain
domain GErrorDomain -> GErrorDomain -> Bool
forall a. Eq a => a -> a -> Bool
== GErrorDomain
quark
          then do
            err
code <- (Int -> err
forall a. Enum a => Int -> a
toEnum (Int -> err) -> (GErrorCode -> Int) -> GErrorCode -> err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (GErrorCode -> err) -> IO GErrorCode -> IO err
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GError -> IO GErrorCode
gerrorCode GError
gerror
            GErrorMessage
msg <- GError -> IO GErrorMessage
gerrorMessage GError
gerror
            err -> GErrorMessage -> IO a
handler err
code GErrorMessage
msg
          else GError -> IO a
forall a e. Exception e => e -> a
throw GError
gerror

-- | A verson of 'handleGErrorJust' with the arguments swapped around.
handleGErrorJust :: GErrorClass err => err -> (GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJust :: err -> (GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJust code :: 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 verson of 'catchGErrorJustDomain' with the arguments swapped around.
handleGErrorJustDomain :: GErrorClass err => (err -> GErrorMessage -> IO a) -> IO a -> IO a
handleGErrorJustDomain :: (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

-- | Run the given function catching possible 'GError's in its
-- execution. If a 'GError' is emitted this throws the corresponding
-- exception.
propagateGError :: (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError :: (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError f :: Ptr (Ptr GError) -> IO a
f = (Ptr (Ptr GError) -> IO a) -> (GError -> IO a) -> IO a
forall a. (Ptr (Ptr GError) -> IO a) -> (GError -> IO a) -> IO a
checkGError Ptr (Ptr GError) -> IO a
f GError -> IO a
forall a e. Exception e => e -> a
throw

-- | Like 'propagateGError', but allows to specify a custom handler
-- instead of just throwing the exception.
checkGError :: (Ptr (Ptr GError) -> IO a) -> (GError -> IO a) -> IO a
checkGError :: (Ptr (Ptr GError) -> IO a) -> (GError -> IO a) -> IO a
checkGError f :: Ptr (Ptr GError) -> IO a
f handler :: GError -> IO a
handler = do
  Ptr (Ptr GError)
gerrorPtr <- IO (Ptr (Ptr GError))
forall a. Storable a => IO (Ptr a)
allocMem
  Ptr (Ptr GError) -> Ptr GError -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr GError)
gerrorPtr Ptr GError
forall a. Ptr a
nullPtr
  a
result <- Ptr (Ptr GError) -> IO a
f Ptr (Ptr GError)
gerrorPtr
  Ptr GError
gerror <- Ptr (Ptr GError) -> IO (Ptr GError)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
gerrorPtr
  Ptr (Ptr GError) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GError)
gerrorPtr
  if Ptr GError
gerror Ptr GError -> Ptr GError -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr GError
forall a. Ptr a
nullPtr
  then (ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GError -> GError
GError Ptr GError
gerror IO GError -> (GError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GError -> IO a
handler
  else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | If the passed in @`Maybe` `GError`@ is not `Nothing`, store a
-- copy in the passed in pointer, unless the pointer is `nullPtr`.
maybePokeGError :: Ptr (Ptr GError) -> Maybe GError -> IO ()
maybePokeGError :: Ptr (Ptr GError) -> Maybe GError -> IO ()
maybePokeGError _ Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybePokeGError ptrPtr :: Ptr (Ptr GError)
ptrPtr (Just gerror :: GError
gerror)
  | Ptr (Ptr GError)
ptrPtr Ptr (Ptr GError) -> Ptr (Ptr GError) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr GError)
forall a. Ptr a
nullPtr = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = GError -> IO (Ptr GError)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
copyBoxed GError
gerror IO (Ptr GError) -> (Ptr GError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr GError) -> Ptr GError -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr GError)
ptrPtr