{-# LINE 1 "src/Bindings/HDF5/Raw/H5I.hsc" #-}



module Bindings.HDF5.Raw.H5I where

import Data.Bits
import Data.Char
import Data.Int
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable

import Bindings.HDF5.Raw.H5
import Foreign.Ptr.Conventions

-- |Library type values
newtype H5I_type_t = H5I_type_t Int32 deriving (Ptr H5I_type_t -> IO H5I_type_t
Ptr H5I_type_t -> Int -> IO H5I_type_t
Ptr H5I_type_t -> Int -> H5I_type_t -> IO ()
Ptr H5I_type_t -> H5I_type_t -> IO ()
H5I_type_t -> Int
(H5I_type_t -> Int)
-> (H5I_type_t -> Int)
-> (Ptr H5I_type_t -> Int -> IO H5I_type_t)
-> (Ptr H5I_type_t -> Int -> H5I_type_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5I_type_t)
-> (forall b. Ptr b -> Int -> H5I_type_t -> IO ())
-> (Ptr H5I_type_t -> IO H5I_type_t)
-> (Ptr H5I_type_t -> H5I_type_t -> IO ())
-> Storable H5I_type_t
forall b. Ptr b -> Int -> IO H5I_type_t
forall b. Ptr b -> Int -> H5I_type_t -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: H5I_type_t -> Int
sizeOf :: H5I_type_t -> Int
$calignment :: H5I_type_t -> Int
alignment :: H5I_type_t -> Int
$cpeekElemOff :: Ptr H5I_type_t -> Int -> IO H5I_type_t
peekElemOff :: Ptr H5I_type_t -> Int -> IO H5I_type_t
$cpokeElemOff :: Ptr H5I_type_t -> Int -> H5I_type_t -> IO ()
pokeElemOff :: Ptr H5I_type_t -> Int -> H5I_type_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5I_type_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5I_type_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5I_type_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5I_type_t -> IO ()
$cpeek :: Ptr H5I_type_t -> IO H5I_type_t
peek :: Ptr H5I_type_t -> IO H5I_type_t
$cpoke :: Ptr H5I_type_t -> H5I_type_t -> IO ()
poke :: Ptr H5I_type_t -> H5I_type_t -> IO ()
Storable, Int -> H5I_type_t -> ShowS
[H5I_type_t] -> ShowS
H5I_type_t -> String
(Int -> H5I_type_t -> ShowS)
-> (H5I_type_t -> String)
-> ([H5I_type_t] -> ShowS)
-> Show H5I_type_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5I_type_t -> ShowS
showsPrec :: Int -> H5I_type_t -> ShowS
$cshow :: H5I_type_t -> String
show :: H5I_type_t -> String
$cshowList :: [H5I_type_t] -> ShowS
showList :: [H5I_type_t] -> ShowS
Show, H5I_type_t -> H5I_type_t -> Bool
(H5I_type_t -> H5I_type_t -> Bool)
-> (H5I_type_t -> H5I_type_t -> Bool) -> Eq H5I_type_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H5I_type_t -> H5I_type_t -> Bool
== :: H5I_type_t -> H5I_type_t -> Bool
$c/= :: H5I_type_t -> H5I_type_t -> Bool
/= :: H5I_type_t -> H5I_type_t -> Bool
Eq)

{-# LINE 18 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |uninitialized type
h5i_UNINIT :: H5I_type_t
h5i_UNINIT :: H5I_type_t
h5i_UNINIT = Int32 -> H5I_type_t
H5I_type_t (-Int32
2)

{-# LINE 21 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |invalid Type
h5i_BADID :: H5I_type_t
h5i_BADID :: H5I_type_t
h5i_BADID = Int32 -> H5I_type_t
H5I_type_t (-Int32
1)

{-# LINE 24 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for File objects
h5i_FILE :: H5I_type_t
h5i_FILE :: H5I_type_t
h5i_FILE = Int32 -> H5I_type_t
H5I_type_t (Int32
1)

{-# LINE 27 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for Group objects
h5i_GROUP :: H5I_type_t
h5i_GROUP :: H5I_type_t
h5i_GROUP = Int32 -> H5I_type_t
H5I_type_t (Int32
2)

{-# LINE 30 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for Datatype objects
h5i_DATATYPE :: H5I_type_t
h5i_DATATYPE :: H5I_type_t
h5i_DATATYPE = Int32 -> H5I_type_t
H5I_type_t (Int32
3)

{-# LINE 33 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for Dataspace objects
h5i_DATASPACE :: H5I_type_t
h5i_DATASPACE :: H5I_type_t
h5i_DATASPACE = Int32 -> H5I_type_t
H5I_type_t (Int32
4)

{-# LINE 36 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for Dataset objects
h5i_DATASET :: H5I_type_t
h5i_DATASET :: H5I_type_t
h5i_DATASET = Int32 -> H5I_type_t
H5I_type_t (Int32
5)

{-# LINE 39 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for Attribute objects
h5i_ATTR :: H5I_type_t
h5i_ATTR :: H5I_type_t
h5i_ATTR = Int32 -> H5I_type_t
H5I_type_t (Int32
7)

{-# LINE 42 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for virtual file layer
h5i_VFL :: H5I_type_t
h5i_VFL :: H5I_type_t
h5i_VFL = Int32 -> H5I_type_t
H5I_type_t (Int32
8)

{-# LINE 45 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for generic property list classes
h5i_GENPROP_CLS :: H5I_type_t
h5i_GENPROP_CLS :: H5I_type_t
h5i_GENPROP_CLS = Int32 -> H5I_type_t
H5I_type_t (Int32
10)

{-# LINE 48 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for generic property lists
h5i_GENPROP_LST :: H5I_type_t
h5i_GENPROP_LST :: H5I_type_t
h5i_GENPROP_LST = Int32 -> H5I_type_t
H5I_type_t (Int32
11)

{-# LINE 51 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for error classes
h5i_ERROR_CLASS :: H5I_type_t
h5i_ERROR_CLASS :: H5I_type_t
h5i_ERROR_CLASS = Int32 -> H5I_type_t
H5I_type_t (Int32
12)

{-# LINE 54 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for error messages
h5i_ERROR_MSG :: H5I_type_t
h5i_ERROR_MSG :: H5I_type_t
h5i_ERROR_MSG = Int32 -> H5I_type_t
H5I_type_t (Int32
13)

{-# LINE 57 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |type ID for error stacks
h5i_ERROR_STACK :: H5I_type_t
h5i_ERROR_STACK :: H5I_type_t
h5i_ERROR_STACK = Int32 -> H5I_type_t
H5I_type_t (Int32
14)

{-# LINE 60 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |number of library types
h5i_NTYPES = 17
h5i_NTYPES :: (Num a) => a

{-# LINE 63 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- TODO: I think HId_t should be parameterised over the element type and
-- possibly also dimensionality of the dataset
-- |Type of atoms to return to users
newtype HId_t = HId_t Int64 deriving (Ptr HId_t -> IO HId_t
Ptr HId_t -> Int -> IO HId_t
Ptr HId_t -> Int -> HId_t -> IO ()
Ptr HId_t -> HId_t -> IO ()
HId_t -> Int
(HId_t -> Int)
-> (HId_t -> Int)
-> (Ptr HId_t -> Int -> IO HId_t)
-> (Ptr HId_t -> Int -> HId_t -> IO ())
-> (forall b. Ptr b -> Int -> IO HId_t)
-> (forall b. Ptr b -> Int -> HId_t -> IO ())
-> (Ptr HId_t -> IO HId_t)
-> (Ptr HId_t -> HId_t -> IO ())
-> Storable HId_t
forall b. Ptr b -> Int -> IO HId_t
forall b. Ptr b -> Int -> HId_t -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: HId_t -> Int
sizeOf :: HId_t -> Int
$calignment :: HId_t -> Int
alignment :: HId_t -> Int
$cpeekElemOff :: Ptr HId_t -> Int -> IO HId_t
peekElemOff :: Ptr HId_t -> Int -> IO HId_t
$cpokeElemOff :: Ptr HId_t -> Int -> HId_t -> IO ()
pokeElemOff :: Ptr HId_t -> Int -> HId_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HId_t
peekByteOff :: forall b. Ptr b -> Int -> IO HId_t
$cpokeByteOff :: forall b. Ptr b -> Int -> HId_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> HId_t -> IO ()
$cpeek :: Ptr HId_t -> IO HId_t
peek :: Ptr HId_t -> IO HId_t
$cpoke :: Ptr HId_t -> HId_t -> IO ()
poke :: Ptr HId_t -> HId_t -> IO ()
Storable, HId_t -> HId_t -> Bool
(HId_t -> HId_t -> Bool) -> (HId_t -> HId_t -> Bool) -> Eq HId_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HId_t -> HId_t -> Bool
== :: HId_t -> HId_t -> Bool
$c/= :: HId_t -> HId_t -> Bool
/= :: HId_t -> HId_t -> Bool
Eq, Eq HId_t
Eq HId_t =>
(HId_t -> HId_t -> Ordering)
-> (HId_t -> HId_t -> Bool)
-> (HId_t -> HId_t -> Bool)
-> (HId_t -> HId_t -> Bool)
-> (HId_t -> HId_t -> Bool)
-> (HId_t -> HId_t -> HId_t)
-> (HId_t -> HId_t -> HId_t)
-> Ord HId_t
HId_t -> HId_t -> Bool
HId_t -> HId_t -> Ordering
HId_t -> HId_t -> HId_t
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 :: HId_t -> HId_t -> Ordering
compare :: HId_t -> HId_t -> Ordering
$c< :: HId_t -> HId_t -> Bool
< :: HId_t -> HId_t -> Bool
$c<= :: HId_t -> HId_t -> Bool
<= :: HId_t -> HId_t -> Bool
$c> :: HId_t -> HId_t -> Bool
> :: HId_t -> HId_t -> Bool
$c>= :: HId_t -> HId_t -> Bool
>= :: HId_t -> HId_t -> Bool
$cmax :: HId_t -> HId_t -> HId_t
max :: HId_t -> HId_t -> HId_t
$cmin :: HId_t -> HId_t -> HId_t
min :: HId_t -> HId_t -> HId_t
Ord)

instance Show HId_t where
    showsPrec :: Int -> HId_t -> ShowS
showsPrec Int
p (HId_t Int64
x) = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
10)
        ( String -> ShowS
showString String
"HId_t 0x"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString
            [ Int -> Char
intToDigit (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
digit)
            | Int
place <- [Int64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int64
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4, Int64 -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize Int64
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8 .. Int
0]
            , let mask :: Int64
mask = Int64
0xf Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int
place
            , let digit :: Int64
digit = ((Int64
x Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
mask) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
place) Int64 -> Int64 -> Int64
forall a. Bits a => a -> a -> a
.&. Int64
0xf
            ]
        )

{-# LINE 83 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

h5_SIZEOF_HID_T :: CSize
h5_SIZEOF_HID_T :: CSize
h5_SIZEOF_HID_T = CSize
8
{-# LINE 86 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |An invalid object ID. This is also negative for error return.
h5i_INVALID_HID :: HId_t
h5i_INVALID_HID :: HId_t
h5i_INVALID_HID = Int64 -> HId_t
HId_t (-Int64
1)

{-# LINE 89 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Function for freeing objects. This function will be called with an object
-- ID type number and a pointer to the object. The function should free the
-- object and return non-negative to indicate that the object
-- can be removed from the ID type. If the function returns negative
-- (failure) then the object will remain in the ID type.
type H5I_free_t        a = FunPtr (In a -> IO HErr_t)

-- |Type of the function to compare objects & keys
type H5I_search_func_t a = FunPtr (In a -> HId_t -> In a -> IO CInt)

-- |Registers an 'object' in a 'type' and returns an ID for it.
-- This routine does _not_ check for unique-ness of the objects,
-- if you register an object twice, you will get two different
-- IDs for it.  This routine does make certain that each ID in a
-- type is unique.  IDs are created by getting a unique number
-- for the type the ID is in and incorporating the type into
-- the ID which is returned to the user.
--
-- Return:	Success:	New object id.
--  	Failure:	Negative
--
-- > hid_t H5Iregister(H5I_type_t type, const void *object);
foreign import ccall "H5Iregister" h5i_register
  :: H5I_type_t -> In a -> IO HId_t
foreign import ccall "&H5Iregister" p_H5Iregister
  :: FunPtr (H5I_type_t -> In a -> IO HId_t)

{-# LINE 113 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Find an object pointer for the specified ID, verifying that
-- it is in a particular type.
--
-- On success, returns a non-null object pointer associated with the
-- specified ID.
-- On failure, returns NULL.
--
-- > void *H5Iobject_verify(hid_t id, H5I_type_t id_type);
foreign import ccall "H5Iobject_verify" h5i_object_verify
  :: HId_t -> H5I_type_t -> IO (Ptr a)
foreign import ccall "&H5Iobject_verify" p_H5Iobject_verify
  :: FunPtr (HId_t -> H5I_type_t -> IO (Ptr a))

{-# LINE 123 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Removes the specified ID from its type, first checking that the
-- type of the ID and the type type are the same.
--
-- On success, returns a pointer to the object that was removed, the
-- same pointer which would have been found by calling 'h5i_object'.
-- On failure, returns NULL.
--
-- > void *H5Iremove_verify(hid_t id, H5I_type_t id_type);
foreign import ccall "H5Iremove_verify" h5i_remove_verify
  :: HId_t -> H5I_type_t -> IO (Ptr a)
foreign import ccall "&H5Iremove_verify" p_H5Iremove_verify
  :: FunPtr (HId_t -> H5I_type_t -> IO (Ptr a))

{-# LINE 133 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Retrieves the number of references outstanding for a type.
-- Returns negative on failure.
--
-- > H5I_type_t H5Iget_type(hid_t id);
foreign import ccall "H5Iget_type" h5i_get_type
  :: HId_t -> IO H5I_type_t
foreign import ccall "&H5Iget_type" p_H5Iget_type
  :: FunPtr (HId_t -> IO H5I_type_t)

{-# LINE 139 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Obtains the file ID given an object ID.  User has to close this ID.
-- Returns a negative value on failure.
--
-- > hid_t H5Iget_file_id(hid_t id);
foreign import ccall "H5Iget_file_id" h5i_get_file_id
  :: HId_t -> IO HId_t
foreign import ccall "&H5Iget_file_id" p_H5Iget_file_id
  :: FunPtr (HId_t -> IO HId_t)

{-# LINE 145 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Gets a name of an object from its ID.
--
-- If 'name' is non-NULL then write up to 'size' bytes into that
-- buffer and always return the length of the entry name.
-- Otherwise 'size' is ignored and the function does not store the name,
-- just returning the number of characters required to store the name.
-- If an error occurs then the buffer pointed to by 'name' (NULL or non-NULL)
-- is unchanged and the function returns a negative value.
-- If a zero is returned for the name's length, then there is no name
-- associated with the ID.
--
-- > ssize_t H5Iget_name(hid_t id, char *name/*out*/, size_t size);
foreign import ccall "H5Iget_name" h5i_get_name
  :: HId_t -> OutArray CChar -> CSize -> IO CSSize
foreign import ccall "&H5Iget_name" p_H5Iget_name
  :: FunPtr (HId_t -> OutArray CChar -> CSize -> IO CSSize)

{-# LINE 159 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Increments the number of references outstanding for an ID.
--
-- On success, returns the new reference count.  On failure, returns
-- a negative value.
--
-- > int H5Iinc_ref(hid_t id);
foreign import ccall "H5Iinc_ref" h5i_inc_ref
  :: HId_t -> IO CInt
foreign import ccall "&H5Iinc_ref" p_H5Iinc_ref
  :: FunPtr (HId_t -> IO CInt)

{-# LINE 167 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Decrements the number of references outstanding for an ID.
-- If the reference count for an ID reaches zero, the object
-- will be closed.
--
-- On success, returns the new reference count.  On failure, returns
-- a negative value.
--
-- > int H5Idec_ref(hid_t id);
foreign import ccall "H5Idec_ref" h5i_dec_ref
  :: HId_t -> IO CInt
foreign import ccall "&H5Idec_ref" p_H5Idec_ref
  :: FunPtr (HId_t -> IO CInt)

{-# LINE 177 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Retrieves the number of references outstanding for an ID.
-- Returns a negative value on failure.
--
-- > int H5Iget_ref(hid_t id);
foreign import ccall "H5Iget_ref" h5i_get_ref
  :: HId_t -> IO CInt
foreign import ccall "&H5Iget_ref" p_H5Iget_ref
  :: FunPtr (HId_t -> IO CInt)

{-# LINE 183 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Creates a new type of ID's to give out.  A specific number
-- ('reserved') of type entries may be reserved to enable \"constant\"
-- values to be handed out which are valid IDs in the type, but which
-- do not map to any data structures and are not allocated dynamically
-- later.  'hash_size' is the minimum hash table size to use for the
-- type.  'free_func' is called with an object pointer when the object
-- is removed from the type.
--
-- On success, returns the type ID of the new type.
-- On failure, returns 'h5i_BADID'.
--
-- > H5I_type_t H5Iregister_type(size_t hash_size, unsigned reserved, H5I_free_t free_func);
foreign import ccall "H5Iregister_type" h5i_register_type
  :: CSize -> CUInt -> H5I_free_t a -> IO H5I_type_t
foreign import ccall "&H5Iregister_type" p_H5Iregister_type
  :: FunPtr (CSize -> CUInt -> H5I_free_t a -> IO H5I_type_t)

{-# LINE 197 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Removes all objects from the type, calling the free
-- function for each object regardless of the reference count.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Iclear_type(H5I_type_t type, hbool_t force);
foreign import ccall "H5Iclear_type" h5i_clear_type
  :: H5I_type_t -> HBool_t -> IO HErr_t
foreign import ccall "&H5Iclear_type" p_H5Iclear_type
  :: FunPtr (H5I_type_t -> HBool_t -> IO HErr_t)

{-# LINE 205 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Destroys a type along with all atoms in that type
-- regardless of their reference counts. Destroying IDs
-- involves calling the free-func for each ID's object and
-- then adding the ID struct to the ID free list.
--
-- Returns zero on success, negative on failure.
--
-- herr_t H5Idestroy_type(H5I_type_t type);
foreign import ccall "H5Idestroy_type" h5i_destroy_type
  :: H5I_type_t -> IO HErr_t
foreign import ccall "&H5Idestroy_type" p_H5Idestroy_type
  :: FunPtr (H5I_type_t -> IO HErr_t)

{-# LINE 215 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Increments the number of references outstanding for an ID type.
--
-- On success, returns the new reference count.  On failure, returns
-- a negative value.
--
-- > int H5Iinc_type_ref(H5I_type_t type);
foreign import ccall "H5Iinc_type_ref" h5i_inc_type_ref
  :: H5I_type_t -> IO CInt
foreign import ccall "&H5Iinc_type_ref" p_H5Iinc_type_ref
  :: FunPtr (H5I_type_t -> IO CInt)

{-# LINE 223 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Decrements the reference count on an entire type of IDs.
-- If the type reference count becomes zero then the type is
-- destroyed along with all atoms in that type regardless of
-- their reference counts.  Destroying IDs involves calling
-- the free-func for each ID's object and then adding the ID
-- struct to the ID free list.
--
-- Returns the number of references to the type on success; a
-- return value of 0 means that the type will have to be
-- re-initialized before it can be used again (and should probably
-- be set to H5I_UNINIT).
--
-- > int H5Idec_type_ref(H5I_type_t type);
foreign import ccall "H5Idec_type_ref" h5i_dec_type_ref
  :: H5I_type_t -> IO CInt
foreign import ccall "&H5Idec_type_ref" p_H5Idec_type_ref
  :: FunPtr (H5I_type_t -> IO CInt)

{-# LINE 238 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Retrieves the number of references outstanding for a type.
-- Returns a negative value on failure.
--
-- > int H5Iget_type_ref(H5I_type_t type);
foreign import ccall "H5Iget_type_ref" h5i_get_type_ref
  :: H5I_type_t -> IO CInt
foreign import ccall "&H5Iget_type_ref" p_H5Iget_type_ref
  :: FunPtr (H5I_type_t -> IO CInt)

{-# LINE 244 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Apply function 'func' to each member of type 'type' and return a
-- pointer to the first object for which 'func' returns non-zero.
-- The 'func' should take a pointer to the object and the 'key' as
-- arguments and return non-zero to terminate the search (zero
-- to continue).
--
-- Limitation:  Currently there is no way to start searching from where a
-- previous search left off.
--
-- Returns the first object in the type for which 'func' returns
-- non-zero.  Returns NULL if 'func' returned zero for every object in
-- the type.
--
-- > void *H5Isearch(H5I_type_t type, H5I_search_func_t func, void *key);
foreign import ccall "H5Isearch" h5i_search
  :: H5I_type_t -> H5I_search_func_t a -> In a -> IO (Ptr a)
foreign import ccall "&H5Isearch" p_H5Isearch
  :: FunPtr (H5I_type_t -> H5I_search_func_t a -> In a -> IO (Ptr a))

{-# LINE 260 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Returns the number of members in a type.  The public interface
-- throws an error if the supplied type does not exist.  This is
-- different than the private interface, which will just return 0.
--
-- Returns zero on success, negative on failure.
--
-- > herr_t H5Inmembers(H5I_type_t type, hsize_t *num_members);
foreign import ccall "H5Inmembers" h5i_nmembers
  :: H5I_type_t -> Out HSize_t -> IO HErr_t
foreign import ccall "&H5Inmembers" p_H5Inmembers
  :: FunPtr (H5I_type_t -> Out HSize_t -> IO HErr_t)

{-# LINE 269 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Check whether the given type is currently registered with the library.
--
-- > htri_t H5Itype_exists(H5I_type_t type);
foreign import ccall "H5Itype_exists" h5i_type_exists
  :: H5I_type_t -> IO HTri_t
foreign import ccall "&H5Itype_exists" p_H5Itype_exists
  :: FunPtr (H5I_type_t -> IO HTri_t)

{-# LINE 274 "src/Bindings/HDF5/Raw/H5I.hsc" #-}

-- |Check if the given id is valid.  An id is valid if it is in
-- use and has an application reference count of at least 1.
--
-- > htri_t H5Iis_valid(hid_t id);
foreign import ccall "H5Iis_valid" h5i_is_valid
  :: HId_t -> IO HTri_t
foreign import ccall "&H5Iis_valid" p_H5Iis_valid
  :: FunPtr (HId_t -> IO HTri_t)

{-# LINE 280 "src/Bindings/HDF5/Raw/H5I.hsc" #-}