{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Bindings.HDF5.Error
    ( ErrorClassID, hdfError
    , HDF5Exception, errorStack, HDF5Error(..)
    , HDFResultType(..)
    , withErrorWhen, withErrorWhen_
    , withErrorCheck, withErrorCheck_
    , htriToBool
    , registerErrorClass, unregisterErrorClass
    , createMajorErrCode, releaseMajorErrCode
    , createMinorErrCode, releaseMinorErrCode
    , ErrorStack
    , createErrorStack, closeErrorStack
    , getCurrentErrorStack, setCurrentErrorStack,
    ) where

import Control.Monad
import Control.Exception (throwIO, finally, Exception)
import qualified Data.ByteString as BS
import Data.IORef
import Data.Typeable (Typeable)
import Foreign.C
import Foreign.Ptr
import Foreign.Storable

import Bindings.HDF5.Core
import Bindings.HDF5.ErrorCodes
import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5E
import Bindings.HDF5.Raw.H5I
import Foreign.Ptr.Conventions

newtype ErrorClassID = ErrorClassID HId_t
    deriving (ErrorClassID -> ErrorClassID -> Bool
(ErrorClassID -> ErrorClassID -> Bool)
-> (ErrorClassID -> ErrorClassID -> Bool) -> Eq ErrorClassID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorClassID -> ErrorClassID -> Bool
== :: ErrorClassID -> ErrorClassID -> Bool
$c/= :: ErrorClassID -> ErrorClassID -> Bool
/= :: ErrorClassID -> ErrorClassID -> Bool
Eq, Eq ErrorClassID
Eq ErrorClassID =>
(ErrorClassID -> ErrorClassID -> Ordering)
-> (ErrorClassID -> ErrorClassID -> Bool)
-> (ErrorClassID -> ErrorClassID -> Bool)
-> (ErrorClassID -> ErrorClassID -> Bool)
-> (ErrorClassID -> ErrorClassID -> Bool)
-> (ErrorClassID -> ErrorClassID -> ErrorClassID)
-> (ErrorClassID -> ErrorClassID -> ErrorClassID)
-> Ord ErrorClassID
ErrorClassID -> ErrorClassID -> Bool
ErrorClassID -> ErrorClassID -> Ordering
ErrorClassID -> ErrorClassID -> ErrorClassID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorClassID -> ErrorClassID -> Ordering
compare :: ErrorClassID -> ErrorClassID -> Ordering
$c< :: ErrorClassID -> ErrorClassID -> Bool
< :: ErrorClassID -> ErrorClassID -> Bool
$c<= :: ErrorClassID -> ErrorClassID -> Bool
<= :: ErrorClassID -> ErrorClassID -> Bool
$c> :: ErrorClassID -> ErrorClassID -> Bool
> :: ErrorClassID -> ErrorClassID -> Bool
$c>= :: ErrorClassID -> ErrorClassID -> Bool
>= :: ErrorClassID -> ErrorClassID -> Bool
$cmax :: ErrorClassID -> ErrorClassID -> ErrorClassID
max :: ErrorClassID -> ErrorClassID -> ErrorClassID
$cmin :: ErrorClassID -> ErrorClassID -> ErrorClassID
min :: ErrorClassID -> ErrorClassID -> ErrorClassID
Ord, Typeable, ErrorClassID -> HId_t
(ErrorClassID -> HId_t) -> HId ErrorClassID
forall t. (t -> HId_t) -> HId t
$chid :: ErrorClassID -> HId_t
hid :: ErrorClassID -> HId_t
HId, HId_t -> ErrorClassID
(HId_t -> ErrorClassID) -> FromHId ErrorClassID
forall t. (HId_t -> t) -> FromHId t
$cuncheckedFromHId :: HId_t -> ErrorClassID
uncheckedFromHId :: HId_t -> ErrorClassID
FromHId, ErrorClassID -> Bool
(ErrorClassID -> Bool) -> HDFResultType ErrorClassID
forall t. (t -> Bool) -> HDFResultType t
$cisError :: ErrorClassID -> Bool
isError :: ErrorClassID -> Bool
HDFResultType)

instance Show ErrorClassID where
    showsPrec :: Int -> ErrorClassID -> ShowS
showsPrec Int
p cls :: ErrorClassID
cls@(ErrorClassID (HId_t Int64
h))
        | ErrorClassID
cls ErrorClassID -> ErrorClassID -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorClassID
hdfError
            = String -> ShowS
showString String
"hdfError"
        | Bool
otherwise = Int -> Int64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Int64
h

hdfError :: ErrorClassID
hdfError :: ErrorClassID
hdfError = HId_t -> ErrorClassID
ErrorClassID HId_t
h5e_ERR_CLS

data HDF5Error = HDF5Error
    { HDF5Error -> ErrorClassID
classId       :: !ErrorClassID
    , HDF5Error -> Maybe MajorErrCode
majorNum      :: !(Maybe MajorErrCode)
    , HDF5Error -> Maybe MinorErrCode
minorNum      :: !(Maybe MinorErrCode)
    , HDF5Error -> Integer
line          :: !Integer
    , HDF5Error -> ByteString
funcName      :: !BS.ByteString
    , HDF5Error -> ByteString
fileName      :: !BS.ByteString
    , HDF5Error -> ByteString
description   :: !BS.ByteString
    } deriving (HDF5Error -> HDF5Error -> Bool
(HDF5Error -> HDF5Error -> Bool)
-> (HDF5Error -> HDF5Error -> Bool) -> Eq HDF5Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HDF5Error -> HDF5Error -> Bool
== :: HDF5Error -> HDF5Error -> Bool
$c/= :: HDF5Error -> HDF5Error -> Bool
/= :: HDF5Error -> HDF5Error -> Bool
Eq, Eq HDF5Error
Eq HDF5Error =>
(HDF5Error -> HDF5Error -> Ordering)
-> (HDF5Error -> HDF5Error -> Bool)
-> (HDF5Error -> HDF5Error -> Bool)
-> (HDF5Error -> HDF5Error -> Bool)
-> (HDF5Error -> HDF5Error -> Bool)
-> (HDF5Error -> HDF5Error -> HDF5Error)
-> (HDF5Error -> HDF5Error -> HDF5Error)
-> Ord HDF5Error
HDF5Error -> HDF5Error -> Bool
HDF5Error -> HDF5Error -> Ordering
HDF5Error -> HDF5Error -> HDF5Error
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HDF5Error -> HDF5Error -> Ordering
compare :: HDF5Error -> HDF5Error -> Ordering
$c< :: HDF5Error -> HDF5Error -> Bool
< :: HDF5Error -> HDF5Error -> Bool
$c<= :: HDF5Error -> HDF5Error -> Bool
<= :: HDF5Error -> HDF5Error -> Bool
$c> :: HDF5Error -> HDF5Error -> Bool
> :: HDF5Error -> HDF5Error -> Bool
$c>= :: HDF5Error -> HDF5Error -> Bool
>= :: HDF5Error -> HDF5Error -> Bool
$cmax :: HDF5Error -> HDF5Error -> HDF5Error
max :: HDF5Error -> HDF5Error -> HDF5Error
$cmin :: HDF5Error -> HDF5Error -> HDF5Error
min :: HDF5Error -> HDF5Error -> HDF5Error
Ord, Int -> HDF5Error -> ShowS
[HDF5Error] -> ShowS
HDF5Error -> String
(Int -> HDF5Error -> ShowS)
-> (HDF5Error -> String)
-> ([HDF5Error] -> ShowS)
-> Show HDF5Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HDF5Error -> ShowS
showsPrec :: Int -> HDF5Error -> ShowS
$cshow :: HDF5Error -> String
show :: HDF5Error -> String
$cshowList :: [HDF5Error] -> ShowS
showList :: [HDF5Error] -> ShowS
Show, Typeable)

readHDF5Error :: H5E_error2_t -> IO HDF5Error
readHDF5Error :: H5E_error2_t -> IO HDF5Error
readHDF5Error H5E_error2_t
err = do
    ByteString
func <- CString -> IO ByteString
BS.packCString (H5E_error2_t -> CString
h5e_error2_t'func_name H5E_error2_t
err)
    ByteString
file <- CString -> IO ByteString
BS.packCString (H5E_error2_t -> CString
h5e_error2_t'file_name H5E_error2_t
err)
    ByteString
desc <- CString -> IO ByteString
BS.packCString (H5E_error2_t -> CString
h5e_error2_t'desc H5E_error2_t
err)

    HDF5Error -> IO HDF5Error
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HDF5Error
        { classId :: ErrorClassID
classId       = HId_t -> ErrorClassID
ErrorClassID (H5E_error2_t -> HId_t
h5e_error2_t'cls_id H5E_error2_t
err)
        , majorNum :: Maybe MajorErrCode
majorNum      = HId_t -> Maybe MajorErrCode
majorErrorFromCode (H5E_error2_t -> HId_t
h5e_error2_t'maj_num H5E_error2_t
err)
        , minorNum :: Maybe MinorErrCode
minorNum      = HId_t -> Maybe MinorErrCode
minorErrorFromCode (H5E_error2_t -> HId_t
h5e_error2_t'min_num H5E_error2_t
err)
        , line :: Integer
line          = CUInt -> Integer
forall a. Integral a => a -> Integer
toInteger (H5E_error2_t -> CUInt
h5e_error2_t'line H5E_error2_t
err)
        , funcName :: ByteString
funcName      = ByteString
func
        , fileName :: ByteString
fileName      = ByteString
file
        , description :: ByteString
description   = ByteString
desc
        }

newtype HDF5Exception = HDF5Exception [HDF5Error]
    deriving (HDF5Exception -> HDF5Exception -> Bool
(HDF5Exception -> HDF5Exception -> Bool)
-> (HDF5Exception -> HDF5Exception -> Bool) -> Eq HDF5Exception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HDF5Exception -> HDF5Exception -> Bool
== :: HDF5Exception -> HDF5Exception -> Bool
$c/= :: HDF5Exception -> HDF5Exception -> Bool
/= :: HDF5Exception -> HDF5Exception -> Bool
Eq, Eq HDF5Exception
Eq HDF5Exception =>
(HDF5Exception -> HDF5Exception -> Ordering)
-> (HDF5Exception -> HDF5Exception -> Bool)
-> (HDF5Exception -> HDF5Exception -> Bool)
-> (HDF5Exception -> HDF5Exception -> Bool)
-> (HDF5Exception -> HDF5Exception -> Bool)
-> (HDF5Exception -> HDF5Exception -> HDF5Exception)
-> (HDF5Exception -> HDF5Exception -> HDF5Exception)
-> Ord HDF5Exception
HDF5Exception -> HDF5Exception -> Bool
HDF5Exception -> HDF5Exception -> Ordering
HDF5Exception -> HDF5Exception -> HDF5Exception
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HDF5Exception -> HDF5Exception -> Ordering
compare :: HDF5Exception -> HDF5Exception -> Ordering
$c< :: HDF5Exception -> HDF5Exception -> Bool
< :: HDF5Exception -> HDF5Exception -> Bool
$c<= :: HDF5Exception -> HDF5Exception -> Bool
<= :: HDF5Exception -> HDF5Exception -> Bool
$c> :: HDF5Exception -> HDF5Exception -> Bool
> :: HDF5Exception -> HDF5Exception -> Bool
$c>= :: HDF5Exception -> HDF5Exception -> Bool
>= :: HDF5Exception -> HDF5Exception -> Bool
$cmax :: HDF5Exception -> HDF5Exception -> HDF5Exception
max :: HDF5Exception -> HDF5Exception -> HDF5Exception
$cmin :: HDF5Exception -> HDF5Exception -> HDF5Exception
min :: HDF5Exception -> HDF5Exception -> HDF5Exception
Ord, Int -> HDF5Exception -> ShowS
[HDF5Exception] -> ShowS
HDF5Exception -> String
(Int -> HDF5Exception -> ShowS)
-> (HDF5Exception -> String)
-> ([HDF5Exception] -> ShowS)
-> Show HDF5Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HDF5Exception -> ShowS
showsPrec :: Int -> HDF5Exception -> ShowS
$cshow :: HDF5Exception -> String
show :: HDF5Exception -> String
$cshowList :: [HDF5Exception] -> ShowS
showList :: [HDF5Exception] -> ShowS
Show, Typeable)
instance Exception HDF5Exception

errorStack :: HDF5Exception -> [HDF5Error]
errorStack :: HDF5Exception -> [HDF5Error]
errorStack (HDF5Exception [HDF5Error]
es) = [HDF5Error]
es

withErrorWhen :: (t -> Bool) -> IO t -> IO t
withErrorWhen :: forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen t -> Bool
isError_ IO t
action = do
    -- h5e_try does not alter the stack, just suspends the 'automatic' exception handler
    t
result <- IO t -> IO t
forall a. IO a -> IO a
h5e_try IO t
action

    if t -> Bool
isError_ t
result
        then do
            HId_t
stackId <- IO HId_t
h5e_get_current_stack
            IORef [HDF5Error]
errors  <- [HDF5Error] -> IO (IORef [HDF5Error])
forall a. a -> IO (IORef a)
newIORef []

            FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
walk <- (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
-> IO (FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t))
forall a.
(CUInt -> In H5E_error2_t -> InOut a -> IO HErr_t)
-> IO (FunPtr (CUInt -> In H5E_error2_t -> InOut a -> IO HErr_t))
wrapStackWalk ((CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
 -> IO
      (FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)))
-> (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
-> IO (FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t))
forall a b. (a -> b) -> a -> b
$ \CUInt
_ (In Ptr H5E_error2_t
err) InOut Any
_ -> do
                HDF5Error
err_desc <- H5E_error2_t -> IO HDF5Error
readHDF5Error (H5E_error2_t -> IO HDF5Error) -> IO H5E_error2_t -> IO HDF5Error
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr H5E_error2_t -> IO H5E_error2_t
forall a. Storable a => Ptr a -> IO a
peek Ptr H5E_error2_t
err
                IORef [HDF5Error] -> ([HDF5Error] -> [HDF5Error]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [HDF5Error]
errors (HDF5Error
err_desc HDF5Error -> [HDF5Error] -> [HDF5Error]
forall a. a -> [a] -> [a]
:)
                HErr_t -> IO HErr_t
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> HErr_t
HErr_t Int32
0)

            HErr_t
_ <- HId_t
-> H5E_direction_t
-> FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
-> InOut Any
-> IO HErr_t
forall a.
HId_t -> H5E_direction_t -> H5E_walk2_t a -> InOut a -> IO HErr_t
h5e_walk2 HId_t
stackId H5E_direction_t
h5e_WALK_DOWNWARD FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
walk (Ptr Any -> InOut Any
forall a. Ptr a -> InOut a
InOut Ptr Any
forall a. Ptr a
nullPtr)
                IO HErr_t -> IO HErr_t -> IO HErr_t
forall a b. IO a -> IO b -> IO a
`finally` do
                    FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
-> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr (CUInt -> In H5E_error2_t -> InOut Any -> IO HErr_t)
walk
                    HId_t -> IO HErr_t
h5e_close_stack HId_t
stackId

            [HDF5Error]
errs <- IORef [HDF5Error] -> IO [HDF5Error]
forall a. IORef a -> IO a
readIORef IORef [HDF5Error]
errors
            HDF5Exception -> IO t
forall e a. Exception e => e -> IO a
throwIO ([HDF5Error] -> HDF5Exception
HDF5Exception [HDF5Error]
errs)
        else t -> IO t
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return t
result

withErrorWhen_ :: (t -> Bool) -> IO t -> IO ()
withErrorWhen_ :: forall t. (t -> Bool) -> IO t -> IO ()
withErrorWhen_ t -> Bool
isErr IO t
action =
    IO t -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO t -> IO ()) -> IO t -> IO ()
forall a b. (a -> b) -> a -> b
$ (t -> Bool) -> IO t -> IO t
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen t -> Bool
isErr IO t
action

withErrorCheck :: HDFResultType t => IO t -> IO t
withErrorCheck :: forall t. HDFResultType t => IO t -> IO t
withErrorCheck = (t -> Bool) -> IO t -> IO t
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen t -> Bool
forall t. HDFResultType t => t -> Bool
isError

withErrorCheck_ :: HDFResultType t => IO t -> IO ()
withErrorCheck_ :: forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ = (t -> Bool) -> IO t -> IO ()
forall t. (t -> Bool) -> IO t -> IO ()
withErrorWhen_ t -> Bool
forall t. HDFResultType t => t -> Bool
isError

htriToBool :: IO HTri_t -> IO Bool
htriToBool :: IO HTri_t -> IO Bool
htriToBool = (HTri_t -> Bool) -> IO HTri_t -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HTri_t -> Bool
toBool (IO HTri_t -> IO Bool)
-> (IO HTri_t -> IO HTri_t) -> IO HTri_t -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO HTri_t -> IO HTri_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck
    where toBool :: HTri_t -> Bool
toBool (HTri_t Int32
x) = Int32
x Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0

registerErrorClass :: BS.ByteString -> BS.ByteString -> BS.ByteString -> IO ErrorClassID
registerErrorClass :: ByteString -> ByteString -> ByteString -> IO ErrorClassID
registerErrorClass ByteString
name ByteString
libName ByteString
version =
    (HId_t -> ErrorClassID) -> IO HId_t -> IO ErrorClassID
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> ErrorClassID
ErrorClassID (IO HId_t -> IO ErrorClassID) -> IO HId_t -> IO ErrorClassID
forall a b. (a -> b) -> a -> b
$
        IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HId_t -> IO HId_t) -> IO HId_t -> IO HId_t
forall a b. (a -> b) -> a -> b
$
            ByteString -> (CString -> IO HId_t) -> IO HId_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
                ByteString -> (CString -> IO HId_t) -> IO HId_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
libName ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
clibName ->
                    ByteString -> (CString -> IO HId_t) -> IO HId_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
version ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cversion ->
                        CString -> CString -> CString -> IO HId_t
h5e_register_class CString
cname CString
clibName CString
cversion

unregisterErrorClass :: ErrorClassID -> IO ()
unregisterErrorClass :: ErrorClassID -> IO ()
unregisterErrorClass (ErrorClassID HId_t
h) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (HId_t -> IO HErr_t
h5e_unregister_class HId_t
h)

createMajorErrCode :: ErrorClassID -> BS.ByteString -> IO MajorErrCode
createMajorErrCode :: ErrorClassID -> ByteString -> IO MajorErrCode
createMajorErrCode (ErrorClassID HId_t
cls) ByteString
msg =
    (HId_t -> MajorErrCode) -> IO HId_t -> IO MajorErrCode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> MajorErrCode
UnknownMajor (IO HId_t -> IO MajorErrCode) -> IO HId_t -> IO MajorErrCode
forall a b. (a -> b) -> a -> b
$
        IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HId_t -> IO HId_t) -> IO HId_t -> IO HId_t
forall a b. (a -> b) -> a -> b
$
            ByteString -> (CString -> IO HId_t) -> IO HId_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
msg ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cmsg ->
                HId_t -> H5E_type_t -> CString -> IO HId_t
h5e_create_msg HId_t
cls H5E_type_t
h5e_MAJOR CString
cmsg

releaseMajorErrCode :: MajorErrCode -> IO ()
releaseMajorErrCode :: MajorErrCode -> IO ()
releaseMajorErrCode (UnknownMajor HId_t
code) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (HId_t -> IO HErr_t
h5e_close_msg HId_t
code)

releaseMajorErrCode MajorErrCode
otherErr = String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"releaseMajorErrCode: "
    , MajorErrCode -> String
forall a. Show a => a -> String
show MajorErrCode
otherErr
    , String
" is a built-in error type, it's a bad idea to release it."
    ]

createMinorErrCode :: ErrorClassID -> BS.ByteString -> IO MinorErrCode
createMinorErrCode :: ErrorClassID -> ByteString -> IO MinorErrCode
createMinorErrCode (ErrorClassID HId_t
cls) ByteString
msg =
    (HId_t -> MinorErrCode) -> IO HId_t -> IO MinorErrCode
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> MinorErrCode
UnknownMinor (IO HId_t -> IO MinorErrCode) -> IO HId_t -> IO MinorErrCode
forall a b. (a -> b) -> a -> b
$
        IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HId_t -> IO HId_t) -> IO HId_t -> IO HId_t
forall a b. (a -> b) -> a -> b
$
            ByteString -> (CString -> IO HId_t) -> IO HId_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
msg ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cmsg ->
                HId_t -> H5E_type_t -> CString -> IO HId_t
h5e_create_msg HId_t
cls H5E_type_t
h5e_MINOR CString
cmsg

releaseMinorErrCode :: MinorErrCode -> IO ()
releaseMinorErrCode :: MinorErrCode -> IO ()
releaseMinorErrCode (UnknownMinor HId_t
code) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (HId_t -> IO HErr_t
h5e_close_msg HId_t
code)

releaseMinorErrCode MinorErrCode
otherErr = String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"releaseMinorErrCode: "
    , MinorErrCode -> String
forall a. Show a => a -> String
show MinorErrCode
otherErr
    , String
" is a built-in error type, it's a bad idea to release it."
    ]

newtype ErrorStack = ErrorStack HId_t
    deriving (ErrorStack -> ErrorStack -> Bool
(ErrorStack -> ErrorStack -> Bool)
-> (ErrorStack -> ErrorStack -> Bool) -> Eq ErrorStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorStack -> ErrorStack -> Bool
== :: ErrorStack -> ErrorStack -> Bool
$c/= :: ErrorStack -> ErrorStack -> Bool
/= :: ErrorStack -> ErrorStack -> Bool
Eq, Eq ErrorStack
Eq ErrorStack =>
(ErrorStack -> ErrorStack -> Ordering)
-> (ErrorStack -> ErrorStack -> Bool)
-> (ErrorStack -> ErrorStack -> Bool)
-> (ErrorStack -> ErrorStack -> Bool)
-> (ErrorStack -> ErrorStack -> Bool)
-> (ErrorStack -> ErrorStack -> ErrorStack)
-> (ErrorStack -> ErrorStack -> ErrorStack)
-> Ord ErrorStack
ErrorStack -> ErrorStack -> Bool
ErrorStack -> ErrorStack -> Ordering
ErrorStack -> ErrorStack -> ErrorStack
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ErrorStack -> ErrorStack -> Ordering
compare :: ErrorStack -> ErrorStack -> Ordering
$c< :: ErrorStack -> ErrorStack -> Bool
< :: ErrorStack -> ErrorStack -> Bool
$c<= :: ErrorStack -> ErrorStack -> Bool
<= :: ErrorStack -> ErrorStack -> Bool
$c> :: ErrorStack -> ErrorStack -> Bool
> :: ErrorStack -> ErrorStack -> Bool
$c>= :: ErrorStack -> ErrorStack -> Bool
>= :: ErrorStack -> ErrorStack -> Bool
$cmax :: ErrorStack -> ErrorStack -> ErrorStack
max :: ErrorStack -> ErrorStack -> ErrorStack
$cmin :: ErrorStack -> ErrorStack -> ErrorStack
min :: ErrorStack -> ErrorStack -> ErrorStack
Ord, Int -> ErrorStack -> ShowS
[ErrorStack] -> ShowS
ErrorStack -> String
(Int -> ErrorStack -> ShowS)
-> (ErrorStack -> String)
-> ([ErrorStack] -> ShowS)
-> Show ErrorStack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorStack -> ShowS
showsPrec :: Int -> ErrorStack -> ShowS
$cshow :: ErrorStack -> String
show :: ErrorStack -> String
$cshowList :: [ErrorStack] -> ShowS
showList :: [ErrorStack] -> ShowS
Show, ErrorStack -> HId_t
(ErrorStack -> HId_t) -> HId ErrorStack
forall t. (t -> HId_t) -> HId t
$chid :: ErrorStack -> HId_t
hid :: ErrorStack -> HId_t
HId, HId_t -> ErrorStack
(HId_t -> ErrorStack) -> FromHId ErrorStack
forall t. (HId_t -> t) -> FromHId t
$cuncheckedFromHId :: HId_t -> ErrorStack
uncheckedFromHId :: HId_t -> ErrorStack
FromHId, ErrorStack -> Bool
(ErrorStack -> Bool) -> HDFResultType ErrorStack
forall t. (t -> Bool) -> HDFResultType t
$cisError :: ErrorStack -> Bool
isError :: ErrorStack -> Bool
HDFResultType)

createErrorStack :: IO ErrorStack
createErrorStack :: IO ErrorStack
createErrorStack =
    (HId_t -> ErrorStack) -> IO HId_t -> IO ErrorStack
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> ErrorStack
ErrorStack
        (IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck IO HId_t
h5e_create_stack)

getCurrentErrorStack :: IO ErrorStack
getCurrentErrorStack :: IO ErrorStack
getCurrentErrorStack =
    (HId_t -> ErrorStack) -> IO HId_t -> IO ErrorStack
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> ErrorStack
ErrorStack
        (IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck IO HId_t
h5e_get_current_stack)

setCurrentErrorStack :: ErrorStack -> IO ()
setCurrentErrorStack :: ErrorStack -> IO ()
setCurrentErrorStack (ErrorStack HId_t
h) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (HId_t -> IO HErr_t
h5e_set_current_stack HId_t
h)

closeErrorStack :: ErrorStack -> IO ()
closeErrorStack :: ErrorStack -> IO ()
closeErrorStack (ErrorStack HId_t
h) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (HId_t -> IO HErr_t
h5e_close_stack HId_t
h)

foreign import ccall "wrapper" wrapStackWalk
    :: (CUInt -> In H5E_error2_t -> InOut a -> IO HErr_t)
    -> IO (FunPtr (CUInt -> In H5E_error2_t -> InOut a -> IO HErr_t))