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




{-# LINE 5 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


{-# LINE 7 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
module Bindings.HDF5.Raw.H5L where

import Data.Int
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable

import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5O
import Bindings.HDF5.Raw.H5T

import Foreign.Ptr.Conventions

-- |Maximum length of a link's name
-- (encoded in a 32-bit unsigned integer)
h5l_MAX_LINK_NAME_LEN :: Word32
h5l_MAX_LINK_NAME_LEN :: Word32
h5l_MAX_LINK_NAME_LEN = Word32
4294967295
{-# LINE 28 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Macro to indicate operation occurs on same location
h5l_SAME_LOC :: HId_t
h5l_SAME_LOC :: HId_t
h5l_SAME_LOC = Int64 -> HId_t
HId_t (Int64
0)

{-# LINE 31 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Current version of the H5L_class_t struct
h5l_LINK_CLASS_T_VERS = 1
h5l_LINK_CLASS_T_VERS :: (Num a) => a

{-# LINE 34 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Link class types.
--
-- Values less than 64 are reserved for the HDF5 library's internal use.
-- Values 64 to 255 are for "user-defined" link class types; these types are
-- defined by HDF5 but their behavior can be overridden by users.
-- Users who want to create new classes of links should contact the HDF5
-- development team at <mailto:hdfhelp@ncsa.uiuc.edu>.
--
-- These values can never change because they appear in HDF5 files.
newtype H5L_type_t = H5L_type_t Int32 deriving (Ptr H5L_type_t -> IO H5L_type_t
Ptr H5L_type_t -> Int -> IO H5L_type_t
Ptr H5L_type_t -> Int -> H5L_type_t -> IO ()
Ptr H5L_type_t -> H5L_type_t -> IO ()
H5L_type_t -> Int
(H5L_type_t -> Int)
-> (H5L_type_t -> Int)
-> (Ptr H5L_type_t -> Int -> IO H5L_type_t)
-> (Ptr H5L_type_t -> Int -> H5L_type_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5L_type_t)
-> (forall b. Ptr b -> Int -> H5L_type_t -> IO ())
-> (Ptr H5L_type_t -> IO H5L_type_t)
-> (Ptr H5L_type_t -> H5L_type_t -> IO ())
-> Storable H5L_type_t
forall b. Ptr b -> Int -> IO H5L_type_t
forall b. Ptr b -> Int -> H5L_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 :: H5L_type_t -> Int
sizeOf :: H5L_type_t -> Int
$calignment :: H5L_type_t -> Int
alignment :: H5L_type_t -> Int
$cpeekElemOff :: Ptr H5L_type_t -> Int -> IO H5L_type_t
peekElemOff :: Ptr H5L_type_t -> Int -> IO H5L_type_t
$cpokeElemOff :: Ptr H5L_type_t -> Int -> H5L_type_t -> IO ()
pokeElemOff :: Ptr H5L_type_t -> Int -> H5L_type_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5L_type_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5L_type_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5L_type_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5L_type_t -> IO ()
$cpeek :: Ptr H5L_type_t -> IO H5L_type_t
peek :: Ptr H5L_type_t -> IO H5L_type_t
$cpoke :: Ptr H5L_type_t -> H5L_type_t -> IO ()
poke :: Ptr H5L_type_t -> H5L_type_t -> IO ()
Storable, Int -> H5L_type_t -> ShowS
[H5L_type_t] -> ShowS
H5L_type_t -> String
(Int -> H5L_type_t -> ShowS)
-> (H5L_type_t -> String)
-> ([H5L_type_t] -> ShowS)
-> Show H5L_type_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5L_type_t -> ShowS
showsPrec :: Int -> H5L_type_t -> ShowS
$cshow :: H5L_type_t -> String
show :: H5L_type_t -> String
$cshowList :: [H5L_type_t] -> ShowS
showList :: [H5L_type_t] -> ShowS
Show, H5L_type_t -> H5L_type_t -> Bool
(H5L_type_t -> H5L_type_t -> Bool)
-> (H5L_type_t -> H5L_type_t -> Bool) -> Eq H5L_type_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H5L_type_t -> H5L_type_t -> Bool
== :: H5L_type_t -> H5L_type_t -> Bool
$c/= :: H5L_type_t -> H5L_type_t -> Bool
/= :: H5L_type_t -> H5L_type_t -> Bool
Eq, Eq H5L_type_t
Eq H5L_type_t =>
(H5L_type_t -> H5L_type_t -> Ordering)
-> (H5L_type_t -> H5L_type_t -> Bool)
-> (H5L_type_t -> H5L_type_t -> Bool)
-> (H5L_type_t -> H5L_type_t -> Bool)
-> (H5L_type_t -> H5L_type_t -> Bool)
-> (H5L_type_t -> H5L_type_t -> H5L_type_t)
-> (H5L_type_t -> H5L_type_t -> H5L_type_t)
-> Ord H5L_type_t
H5L_type_t -> H5L_type_t -> Bool
H5L_type_t -> H5L_type_t -> Ordering
H5L_type_t -> H5L_type_t -> H5L_type_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 :: H5L_type_t -> H5L_type_t -> Ordering
compare :: H5L_type_t -> H5L_type_t -> Ordering
$c< :: H5L_type_t -> H5L_type_t -> Bool
< :: H5L_type_t -> H5L_type_t -> Bool
$c<= :: H5L_type_t -> H5L_type_t -> Bool
<= :: H5L_type_t -> H5L_type_t -> Bool
$c> :: H5L_type_t -> H5L_type_t -> Bool
> :: H5L_type_t -> H5L_type_t -> Bool
$c>= :: H5L_type_t -> H5L_type_t -> Bool
>= :: H5L_type_t -> H5L_type_t -> Bool
$cmax :: H5L_type_t -> H5L_type_t -> H5L_type_t
max :: H5L_type_t -> H5L_type_t -> H5L_type_t
$cmin :: H5L_type_t -> H5L_type_t -> H5L_type_t
min :: H5L_type_t -> H5L_type_t -> H5L_type_t
Ord, ReadPrec [H5L_type_t]
ReadPrec H5L_type_t
Int -> ReadS H5L_type_t
ReadS [H5L_type_t]
(Int -> ReadS H5L_type_t)
-> ReadS [H5L_type_t]
-> ReadPrec H5L_type_t
-> ReadPrec [H5L_type_t]
-> Read H5L_type_t
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS H5L_type_t
readsPrec :: Int -> ReadS H5L_type_t
$creadList :: ReadS [H5L_type_t]
readList :: ReadS [H5L_type_t]
$creadPrec :: ReadPrec H5L_type_t
readPrec :: ReadPrec H5L_type_t
$creadListPrec :: ReadPrec [H5L_type_t]
readListPrec :: ReadPrec [H5L_type_t]
Read)

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

-- |Invalid link type id
h5l_TYPE_ERROR :: H5L_type_t
h5l_TYPE_ERROR :: H5L_type_t
h5l_TYPE_ERROR = Int32 -> H5L_type_t
H5L_type_t (-Int32
1)

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

-- |Hard link id
h5l_TYPE_HARD :: H5L_type_t
h5l_TYPE_HARD :: H5L_type_t
h5l_TYPE_HARD = Int32 -> H5L_type_t
H5L_type_t (Int32
0)

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

-- |Soft link id
h5l_TYPE_SOFT :: H5L_type_t
h5l_TYPE_SOFT :: H5L_type_t
h5l_TYPE_SOFT = Int32 -> H5L_type_t
H5L_type_t (Int32
1)

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

-- |External link id
h5l_TYPE_EXTERNAL :: H5L_type_t
h5l_TYPE_EXTERNAL :: H5L_type_t
h5l_TYPE_EXTERNAL = Int32 -> H5L_type_t
H5L_type_t (Int32
64)

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

-- |Maximum link type id
h5l_TYPE_MAX :: H5L_type_t
h5l_TYPE_MAX :: H5L_type_t
h5l_TYPE_MAX = Int32 -> H5L_type_t
H5L_type_t (Int32
255)

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

-- |Maximum value link value for \"built-in\" link types
h5l_TYPE_BUILTIN_MAX :: H5L_type_t
h5l_TYPE_BUILTIN_MAX :: H5L_type_t
h5l_TYPE_BUILTIN_MAX = Int32 -> H5L_type_t
H5L_type_t (Int32
1)

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

-- |Link ids at or above this value are \"user-defined\" link types.
h5l_TYPE_UD_MIN :: H5L_type_t
h5l_TYPE_UD_MIN :: H5L_type_t
h5l_TYPE_UD_MIN = Int32 -> H5L_type_t
H5L_type_t (Int32
64)

{-# LINE 66 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


-- /* The H5L_class_t struct can be used to override the behavior of a
--  * "user-defined" link class. Users should populate the struct with callback
--  * functions defined below.
--  */

-- * Callback prototypes for user-defined links

-- |Link creation callback
--
-- > typedef herr_t (*H5L_create_func_t)(const char *link_name, hid_t loc_group,
-- >     const void *lnkdata, size_t lnkdata_size, hid_t lcpl_id);
type H5L_create_func_t a = FunPtr (CString -> HId_t -> Ptr a -> CSize -> HId_t -> IO HErr_t)

-- |Callback for when the link is moved
--
-- > typedef herr_t (*H5L_move_func_t)(const char *new_name, hid_t new_loc,
-- >     const void *lnkdata, size_t lnkdata_size);
type H5L_move_func_t a = FunPtr (CString -> HId_t -> Ptr a -> CSize -> IO HErr_t)

-- |Callback for when the link is copied
--
-- > typedef herr_t (*H5L_copy_func_t)(const char *new_name, hid_t new_loc,
-- >     const void *lnkdata, size_t lnkdata_size);
type H5L_copy_func_t a = FunPtr (CString -> HId_t -> Ptr a -> CSize -> IO HErr_t)

-- |Callback during link traversal
--
-- > typedef herr_t (*H5L_traverse_func_t)(const char *link_name, hid_t cur_group,
-- >     const void *lnkdata, size_t lnkdata_size, hid_t lapl_id);
type H5L_traverse_func_t a = FunPtr (CString -> HId_t -> Ptr a -> CSize -> HId_t -> IO HErr_t)

-- |Callback for when the link is deleted
--
-- > typedef herr_t (*H5L_delete_func_t)(const char *link_name, hid_t file,
-- >     const void *lnkdata, size_t lnkdata_size);
type H5L_delete_func_t a = FunPtr (CString -> HId_t -> Ptr a -> CSize -> IO HErr_t)

-- |Callback for querying the link
--
-- Returns the size of the buffer needed
--
-- > typedef ssize_t (*H5L_query_func_t)(const char *link_name, const void *lnkdata,
-- >     size_t lnkdata_size, void *buf /*out*/, size_t buf_size);
type H5L_query_func_t a b = FunPtr (CString -> Ptr a -> CSize -> Out b -> CSize -> IO CSSize)

-- |User-defined link types

{-# LINE 115 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Version number of this struct

{-# LINE 118 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Link type ID

{-# LINE 121 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Comment for debugging

{-# LINE 124 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Callback during link creation

{-# LINE 127 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Callback after moving link

{-# LINE 130 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Callback after copying link

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

-- |Callback during link traversal

{-# LINE 136 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Callback for link deletion

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

-- |Callback for queries

{-# LINE 142 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
data H5L_class_t = H5L_class_t{
  h5l_class_t'version :: CInt,
  h5l_class_t'id :: H5L_type_t,
  h5l_class_t'comment :: CString,
  h5l_class_t'create_func :: H5L_create_func_t (),
  h5l_class_t'move_func :: H5L_move_func_t (),
  h5l_class_t'copy_func :: H5L_copy_func_t (),
  h5l_class_t'trav_func :: H5L_traverse_func_t (),
  h5l_class_t'del_func :: H5L_delete_func_t (),
  h5l_class_t'query_func :: H5L_query_func_t () ()
} deriving (Eq,Show)
p'H5L_class_t'version :: Ptr H5L_class_t -> Ptr CInt
p'H5L_class_t'version Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
0
p'H5L_class_t'version :: Ptr (H5L_class_t) -> Ptr (CInt)
p'H5L_class_t'id :: Ptr H5L_class_t -> Ptr H5L_type_t
p'H5L_class_t'id Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr H5L_type_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
4
p'H5L_class_t'id :: Ptr (H5L_class_t) -> Ptr (H5L_type_t)
p'H5L_class_t'comment :: Ptr H5L_class_t -> Ptr CString
p'H5L_class_t'comment Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
8
p'H5L_class_t'comment :: Ptr (H5L_class_t) -> Ptr (CString)
p'H5L_class_t'create_func :: Ptr H5L_class_t -> Ptr (H5L_create_func_t ())
p'H5L_class_t'create_func Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr (H5L_create_func_t ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
16
p'H5L_class_t'create_func :: Ptr (H5L_class_t) -> Ptr (H5L_create_func_t ())
p'H5L_class_t'move_func :: Ptr H5L_class_t -> Ptr (H5L_move_func_t ())
p'H5L_class_t'move_func Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr (H5L_move_func_t ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
24
p'H5L_class_t'move_func :: Ptr (H5L_class_t) -> Ptr (H5L_move_func_t ())
p'H5L_class_t'copy_func :: Ptr H5L_class_t -> Ptr (H5L_move_func_t ())
p'H5L_class_t'copy_func Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr (H5L_move_func_t ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
32
p'H5L_class_t'copy_func :: Ptr (H5L_class_t) -> Ptr (H5L_copy_func_t ())
p'H5L_class_t'trav_func :: Ptr H5L_class_t -> Ptr (H5L_create_func_t ())
p'H5L_class_t'trav_func Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr (H5L_create_func_t ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
40
p'H5L_class_t'trav_func :: Ptr (H5L_class_t) -> Ptr (H5L_traverse_func_t ())
p'H5L_class_t'del_func :: Ptr H5L_class_t -> Ptr (H5L_move_func_t ())
p'H5L_class_t'del_func Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr (H5L_move_func_t ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
48
p'H5L_class_t'del_func :: Ptr (H5L_class_t) -> Ptr (H5L_delete_func_t ())
p'H5L_class_t'query_func :: Ptr H5L_class_t -> Ptr (H5L_query_func_t () ())
p'H5L_class_t'query_func Ptr H5L_class_t
p = Ptr H5L_class_t -> Int -> Ptr (H5L_query_func_t () ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_class_t
p Int
56
p'H5L_class_t'query_func :: Ptr (H5L_class_t) -> Ptr (H5L_query_func_t () ())
instance Storable H5L_class_t where
  sizeOf :: H5L_class_t -> Int
sizeOf H5L_class_t
_ = Int
64
  alignment :: H5L_class_t -> Int
alignment H5L_class_t
_ = Int
8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 4
    v2 <- peekByteOff _p 8
    v3 <- peekByteOff _p 16
    v4 <- peekByteOff _p 24
    v5 <- peekByteOff _p 32
    v6 <- peekByteOff _p 40
    v7 <- peekByteOff _p 48
    v8 <- peekByteOff _p 56
    return $ H5L_class_t v0 v1 v2 v3 v4 v5 v6 v7 v8
  poke _p (H5L_class_t v0 v1 v2 v3 v4 v5 v6 v7 v8) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 4 v1
    pokeByteOff _p 8 v2
    pokeByteOff _p 16 v3
    pokeByteOff _p 24 v4
    pokeByteOff _p 32 v5
    pokeByteOff _p 40 v6
    pokeByteOff _p 48 v7
    pokeByteOff _p 56 v8
    return ()

{-# LINE 143 "src/Bindings/HDF5/Raw/H5L.hsc" #-}



-- |Callback for external link traversal
--
-- > typedef herr_t (*H5L_elink_traverse_t)(const char *parent_file_name,
-- >     const char *parent_group_name, const char *child_file_name,
-- >     const char *child_object_name, unsigned *acc_flags, hid_t fapl_id,
-- >     void *op_data);
type H5L_elink_traverse_t a = FunPtr (CString
    -> CString -> CString
    -> CString -> Ptr CUInt -> HId_t
    -> Ptr a -> IO HErr_t)

-- |Renames an object within an HDF5 file and moves it to a new
-- group.  The original name 'src' is unlinked from the group graph
-- and then inserted with the new name 'dst' (which can specify a
-- new path for the object) as an atomic operation. The names
-- are interpreted relative to 'src_loc_id' and
-- 'dst_loc_id', which are either file IDs or group ID.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lmove(hid_t src_loc, const char *src_name, hid_t dst_loc,
-- >     const char *dst_name, hid_t lcpl_id, hid_t lapl_id);
foreign import ccall "H5Lmove" h5l_move
  :: HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lmove" p_H5Lmove
  :: FunPtr (HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t)

{-# LINE 169 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Creates an identical copy of a link with the same creation
-- time and target.  The new link can have a different name
-- and be in a different location than the original.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lcopy(hid_t src_loc, const char *src_name, hid_t dst_loc,
-- >     const char *dst_name, hid_t lcpl_id, hid_t lapl_id);
foreign import ccall "H5Lcopy" h5l_copy
  :: HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lcopy" p_H5Lcopy
  :: FunPtr (HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t)

{-# LINE 179 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Creates a hard link from 'new_name' to 'cur_name'.
--
-- 'cur_name' must name an existing object.  'cur_name' and
-- 'new_name' are interpreted relative to 'cur_loc_id' and
-- 'new_loc_id', which are either file IDs or group IDs.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Lcreate_hard(hid_t cur_loc, const char *cur_name,
-- >     hid_t dst_loc, const char *dst_name, hid_t lcpl_id, hid_t lapl_id);
foreign import ccall "H5Lcreate_hard" h5l_create_hard
  :: HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lcreate_hard" p_H5Lcreate_hard
  :: FunPtr (HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t)

{-# LINE 191 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Creates a soft link from 'link_name' to 'link_target'.
--
-- 'link_target' can be anything and is interpreted at lookup
-- time relative to the group which contains the final component
-- of 'link_name'.  For instance, if 'link_target' is \"./foo\" and
-- 'link_name' is \"./x/y/bar\" and a request is made for \"./x/y/bar\"
-- then the actual object looked up is \"./x/y/./foo\".
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lcreate_soft(const char *link_target, hid_t link_loc_id,
-- >     const char *link_name, hid_t lcpl_id, hid_t lapl_id);
foreign import ccall "H5Lcreate_soft" h5l_create_soft
  :: CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lcreate_soft" p_H5Lcreate_soft
  :: FunPtr (CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t)

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

-- |Removes the specified 'name' from the group graph and
-- decrements the link count for the object to which 'name'
-- points.  If the link count reaches zero then all file-space
-- associated with the object will be reclaimed (but if the
-- object is open, then the reclamation of the file space is
-- delayed until all handles to the object are closed).
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Ldelete(hid_t loc_id, const char *name, hid_t lapl_id);
foreign import ccall "H5Ldelete" h5l_delete
  :: HId_t -> CString -> HId_t -> IO HErr_t
foreign import ccall "&H5Ldelete" p_H5Ldelete
  :: FunPtr (HId_t -> CString -> HId_t -> IO HErr_t)

{-# LINE 217 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Removes the specified link from the group graph and
-- decrements the link count for the object to which it
-- points, according to the order within an index.
--
-- If the link count reaches zero then all file-space
-- associated with the object will be reclaimed (but if the
-- object is open, then the reclamation of the file space is
-- delayed until all handles to the object are closed).
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Ldelete_by_idx(hid_t loc_id, const char *group_name,
-- >     H5_index_t idx_type, H5_iter_order_t order, hsize_t n, hid_t lapl_id);
foreign import ccall "H5Ldelete_by_idx" h5l_delete_by_idx
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Ldelete_by_idx" p_H5Ldelete_by_idx
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> HId_t -> IO HErr_t)

{-# LINE 232 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Returns the link value of a link whose name is 'name'.  For
-- symbolic links, this is the path to which the link points,
-- including the null terminator.  For user-defined links, it
-- is the link buffer.
--
-- At most 'size' bytes are copied to the 'buf' result buffer.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lget_val(hid_t loc_id, const char *name, void *buf/*out*/,
-- >     size_t size, hid_t lapl_id);
foreign import ccall "H5Lget_val" h5l_get_val
  :: HId_t -> CString -> OutArray a -> CSize -> HId_t -> IO HErr_t
foreign import ccall "&H5Lget_val" p_H5Lget_val
  :: FunPtr (HId_t -> CString -> OutArray a -> CSize -> HId_t -> IO HErr_t)

{-# LINE 245 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Returns the link value of a link, according to the order of
-- an index.  For symbolic links, this is the path to which the
-- link points, including the null terminator.  For user-defined
-- links, it is the link buffer.
--
-- At most 'size' bytes are copied to the 'buf' result buffer.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lget_val_by_idx(hid_t loc_id, const char *group_name,
-- >     H5_index_t idx_type, H5_iter_order_t order, hsize_t n,
-- >     void *buf/*out*/, size_t size, hid_t lapl_id);
foreign import ccall "H5Lget_val_by_idx" h5l_get_val_by_idx
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> OutArray a -> CSize -> HId_t -> IO HErr_t
foreign import ccall "&H5Lget_val_by_idx" p_H5Lget_val_by_idx
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> OutArray a -> CSize -> HId_t -> IO HErr_t)

{-# LINE 259 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Checks if a link of a given name exists in a group
--
-- > htri_t H5Lexists(hid_t loc_id, const char *name, hid_t lapl_id);
foreign import ccall "H5Lexists" h5l_exists
  :: HId_t -> CString -> HId_t -> IO HTri_t
foreign import ccall "&H5Lexists" p_H5Lexists
  :: FunPtr (HId_t -> CString -> HId_t -> IO HTri_t)

{-# LINE 264 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Gets name for a link, according to the order within an index.
--
-- Same pattern of behavior as 'h5i_get_name'.
--
-- On success, returns non-negative length of name, with information
-- in 'name' buffer
-- On failure,returns a negative value.
--
-- > ssize_t H5Lget_name_by_idx(hid_t loc_id, const char *group_name,
-- >     H5_index_t idx_type, H5_iter_order_t order, hsize_t n,
-- >     char *name /*out*/, size_t size, hid_t lapl_id);
foreign import ccall "H5Lget_name_by_idx" h5l_get_name_by_idx
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> OutArray CChar -> CSSize -> HId_t -> IO CSSize
foreign import ccall "&H5Lget_name_by_idx" p_H5Lget_name_by_idx
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> OutArray CChar -> CSSize -> HId_t -> IO CSSize)

{-# LINE 277 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Creates a user-defined link of type 'link_type' named 'link_name'
-- with user-specified data 'udata'.
--
-- The format of the information pointed to by 'udata' is
-- defined by the user. 'udata_size' holds the size of this buffer.
--
-- 'link_name' is interpreted relative to 'link_loc_id'.
--
-- The property list specified by 'lcpl_id' holds properties used
-- to create the link.
--
-- The link class of the new link must already be registered
-- with the library.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lcreate_ud(hid_t link_loc_id, const char *link_name,
-- >     H5L_type_t link_type, const void *udata, size_t udata_size, hid_t lcpl_id,
-- >     hid_t lapl_id);
foreign import ccall "H5Lcreate_ud" h5l_create_ud
  :: HId_t -> CString -> H5L_type_t -> In a -> CSize -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lcreate_ud" p_H5Lcreate_ud
  :: FunPtr (HId_t -> CString -> H5L_type_t -> In a -> CSize -> HId_t -> HId_t -> IO HErr_t)

{-# LINE 298 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Registers a class of user-defined links, or changes the
-- behavior of an existing class.
--
-- The link class passed in will override any existing link
-- class for the specified link class ID. It must at least
-- include a 'H5L_class_t' version (which should be
-- 'h5l_LINK_CLASS_T_VERS'), a link class ID, and a traversal
-- function.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lregister(const H5L_class_t *cls);
foreign import ccall "H5Lregister" h5l_register
  :: In H5L_class_t -> IO HErr_t
foreign import ccall "&H5Lregister" p_H5Lregister
  :: FunPtr (In H5L_class_t -> IO HErr_t)

{-# LINE 312 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Unregisters a class of user-defined links, preventing them
-- from being traversed, queried, moved, etc.
--
-- A link class can be re-registered using 'h5l_register'.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lunregister(H5L_type_t id);
foreign import ccall "H5Lunregister" h5l_unregister
  :: H5L_type_t -> IO HErr_t
foreign import ccall "&H5Lunregister" p_H5Lunregister
  :: FunPtr (H5L_type_t -> IO HErr_t)

{-# LINE 322 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Tests whether a user-defined link class has been registered
-- or not.
--
-- > htri_t H5Lis_registered(H5L_type_t id);
foreign import ccall "H5Lis_registered" h5l_is_registered
  :: H5L_type_t -> IO HTri_t
foreign import ccall "&H5Lis_registered" p_H5Lis_registered
  :: FunPtr (H5L_type_t -> IO HTri_t)

{-# LINE 328 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Given a buffer holding the \"link value\" from an external link,
-- gets pointers to the information within the link value buffer.
--
-- External link link values contain some flags and
-- two NULL-terminated strings, one after the other.
--
-- The 'flags' value will be filled in and 'filename' and
-- 'obj_path' will be set to pointers within 'ext_linkval' (unless
-- any of these values is NULL).
--
-- Using this function on strings that aren't external link
-- 'udata' buffers can result in segmentation faults.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lunpack_elink_val(const void *ext_linkval/*in*/, size_t link_size,
-- >    unsigned *flags, const char **filename/*out*/, const char **obj_path /*out*/);
foreign import ccall "H5Lunpack_elink_val" h5l_unpack_elink_val
  :: InArray a -> CSize -> Out CUInt -> Out (Ptr CChar) -> Out (Ptr CChar) -> IO HErr_t
foreign import ccall "&H5Lunpack_elink_val" p_H5Lunpack_elink_val
  :: FunPtr (InArray a -> CSize -> Out CUInt -> Out (Ptr CChar) -> Out (Ptr CChar) -> IO HErr_t)

{-# LINE 347 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- |Creates an external link from 'link_name' to 'obj_name'.
--
-- External links are links to objects in other HDF5 files.  They
-- are allowed to \"dangle\" like soft links internal to a file.
-- 'file_name' is the name of the file that 'obj_name' is is contained
-- within.  If 'obj_name' is given as a relative path name, the
-- path will be relative to the root group of 'file_name'.
-- 'link_name' is interpreted relative to 'link_loc_id', which is
-- either a file ID or a group ID.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Lcreate_external(const char *file_name, const char *obj_name,
-- >     hid_t link_loc_id, const char *link_name, hid_t lcpl_id, hid_t lapl_id);
foreign import ccall "H5Lcreate_external" h5l_create_external
  :: CString -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lcreate_external" p_H5Lcreate_external
  :: FunPtr (CString -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t)

{-# LINE 363 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


--------------------------
-- Compatibility macros --
--------------------------

-- H5L_info_t


{-# LINE 372 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


{-# LINE 374 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 375 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 376 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 377 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 378 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 379 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 380 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
data H5L_info1_t = H5L_info1_t{
  h5l_info1_t'type :: H5L_type_t,
  h5l_info1_t'corder_valid :: HBool_t,
  h5l_info1_t'corder :: Int64,
  h5l_info1_t'cset :: H5T_cset_t,
  h5l_info1_t'u'address :: HAddr_t,
  h5l_info1_t'u'val_size :: CSize
} deriving (Eq,Show)
p'H5L_info1_t'type :: Ptr H5L_info1_t -> Ptr H5L_type_t
p'H5L_info1_t'type Ptr H5L_info1_t
p = Ptr H5L_info1_t -> Int -> Ptr H5L_type_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_info1_t
p Int
0
p'H5L_info1_t'type :: Ptr (H5L_info1_t) -> Ptr (H5L_type_t)
p'H5L_info1_t'corder_valid :: Ptr H5L_info1_t -> Ptr HBool_t
p'H5L_info1_t'corder_valid Ptr H5L_info1_t
p = Ptr H5L_info1_t -> Int -> Ptr HBool_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_info1_t
p Int
4
p'H5L_info1_t'corder_valid :: Ptr (H5L_info1_t) -> Ptr (HBool_t)
p'H5L_info1_t'corder :: Ptr H5L_info1_t -> Ptr Int64
p'H5L_info1_t'corder Ptr H5L_info1_t
p = Ptr H5L_info1_t -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_info1_t
p Int
8
p'H5L_info1_t'corder :: Ptr (H5L_info1_t) -> Ptr (Int64)
p'H5L_info1_t'cset :: Ptr H5L_info1_t -> Ptr H5T_cset_t
p'H5L_info1_t'cset Ptr H5L_info1_t
p = Ptr H5L_info1_t -> Int -> Ptr H5T_cset_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_info1_t
p Int
16
p'H5L_info1_t'cset :: Ptr (H5L_info1_t) -> Ptr (H5T_cset_t)
p'H5L_info1_t'u'address p = plusPtr p 24
p'H5L_info1_t'u'address :: Ptr Ptr H5L_info2_t
(H5L_info1_t) -> Ptr (HAddr_t)
p'H5L_info1_t'u'val_size :: Ptr H5L_info1_t -> Ptr CSize
p'H5L_info1_t'u'val_size Ptr H5L_info1_t
p = Ptr H5L_info1_t -> Int -> Ptr CSize
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5L_info1_t
p Int
24
p'H5L_info1_t'u'val_size :: Ptr (H5L_info1_t) -> Ptr (CSize)
u_H5L_info1_t'u'address :: H5L_info1_t -> HAddr_t -> IO H5L_info1_t
u_H5L_info1_t'u'address :: H5L_info1_t -> HAddr_t -> IO H5L_info1_t
u_H5L_info1_t'u'address H5L_info1_t
v HAddr_t
vf = (Ptr H5L_info1_t -> IO H5L_info1_t) -> IO H5L_info1_t
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr H5L_info1_t -> IO H5L_info1_t) -> IO H5L_info1_t)
-> (Ptr H5L_info1_t -> IO H5L_info1_t) -> IO H5L_info1_t
forall a b. (a -> b) -> a -> b
$ \Ptr H5L_info1_t
p -> do
  Ptr H5L_info1_t -> H5L_info1_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr H5L_info1_t
p H5L_info1_t
v
  pokeByteOff p 24 vf
  vu <- peek p
  H5L_info1_t -> IO H5L_info1_t
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (H5L_info1_t -> IO H5L_info1_t) -> H5L_info1_t -> IO H5L_info1_t
forall a b. (a -> b) -> a -> b
$ H5L_info1_t
v
    {h5l_info1_t'u'address = h5l_info1_t'u'address vu}
    {h5l_info1_t'u'val_size = h5l_info1_t'u'val_size vu}
u_H5L_info1_t'u'val_size :: H5L_info1_t -> CSize -> IO H5L_info1_t
u_H5L_info1_t'u'val_size :: H5L_info1_t -> CSize -> IO H5L_info1_t
u_H5L_info1_t'u'val_size H5L_info1_t
v CSize
vf = alloca $ \p -> do
  Ptr H5L_info1_t -> H5L_info1_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr H5L_info1_t
p H5L_info1_t
v
  Ptr H5L_info1_t -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
p Int
24 CSize
vf
  H5L_info1_t
vu <- peek p
  H5L_info1_t -> IO H5L_info1_t
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (H5L_info1_t -> IO H5L_info1_t) -> H5L_info1_t -> IO H5L_info1_t
forall a b. (a -> b) -> a -> b
$ v
    {h5l_info1_t'u'address = h5l_info1_t'u'address vu}
    {h5l_info1_t'u'val_size = h5l_info1_t'u'val_size vu}
instance Storable H5L_info1_t where
  sizeOf :: H5L_info1_t -> Int
sizeOf H5L_info1_t
_ = Int
32
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 4
    v2 <- peekByteOff _p 8
    v3 <- peekByteOff _p 16
    v4 <- peekByteOff _p 24
    v5 <- peekByteOff _p 24
    return $ H5L_info1_t v0 v1 v2 v3 v4 v5
  poke :: Ptr H5L_info1_t -> H5L_info1_t -> IO ()
poke Ptr H5L_info1_t
_p (H5L_info1_t H5L_type_t
v0 HBool_t
v1 Int64
v2 H5T_cset_t
v3 HAddr_t
v4 CSize
v5) = do
    Ptr H5L_info1_t -> Int -> H5L_type_t -> IO ()
forall b. Ptr b -> Int -> H5L_type_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
_p Int
0 H5L_type_t
v0
    Ptr H5L_info1_t -> Int -> HBool_t -> IO ()
forall b. Ptr b -> Int -> HBool_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
_p Int
4 HBool_t
v1
    Ptr H5L_info1_t -> Int -> Int64 -> IO ()
forall b. Ptr b -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
_p Int
8 Int64
v2
    Ptr H5L_info1_t -> Int -> H5T_cset_t -> IO ()
forall b. Ptr b -> Int -> H5T_cset_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
_p Int
16 H5T_cset_t
v3
    Ptr H5L_info1_t -> Int -> HAddr_t -> IO ()
forall b. Ptr b -> Int -> HAddr_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
_p Int
24 HAddr_t
v4
    Ptr H5L_info1_t -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5L_info1_t
_p Int
24 CSize
v5
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 381 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


{-# LINE 383 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 384 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 385 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 386 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 387 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 388 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 389 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
data H5L_info2_t = H5L_info2_t{
  h5l_info2_t'type :: H5L_type_t,
  h5l_info2_t'corder_valid :: HBool_t,
  h5l_info2_t'corder :: Int64,
  h5l_info2_t'cset :: H5T_cset_t,
  h5l_info2_t'u'token :: H5O_token_t,
  h5l_info2_t'u'val_size :: CSize
} deriving (Eq,Show)
p'H5L_info2_t'type p = plusPtr p 0
p'H5L_info2_t'type :: Ptr (H5L_info2_t) -> Ptr (H5L_type_t)
p'H5L_info2_t'corder_valid p = plusPtr p 4
p'H5L_info2_t'corder_valid :: Ptr (H5L_info2_t) -> Ptr (HBool_t)
p'H5L_info2_t'corder p = plusPtr p 8
p'H5L_info2_t'corder :: Ptr (H5L_info2_t) -> Ptr (Int64)
p'H5L_info2_t'cset p = plusPtr p 16
p'H5L_info2_t'cset :: Ptr (H5L_info2_t) -> Ptr (H5T_cset_t)
p'H5L_info2_t'u'token p = plusPtr p 24
p'H5L_info2_t'u'token :: Ptr (H5L_info2_t) -> Ptr (H5O_token_t)
p'H5L_info2_t'u'val_size p = plusPtr p 24
p'H5L_info2_t'u'val_size :: Ptr (H5L_info2_t) -> Ptr (CSize)
u_H5L_info2_t'u'token :: H5L_info2_t -> H5O_token_t -> IO H5L_info2_t
u_H5L_info2_t'u'token v vf = alloca $ \p -> do
  poke p v
  pokeByteOff p 24 vf
  vu <- peek p
  return $ v
    {h5l_info2_t'u'token = h5l_info2_t'u'token vu}
    {h5l_info2_t'u'val_size = h5l_info2_t'u'val_size vu}
u_H5L_info2_t'u'val_size :: H5L_info2_t -> CSize -> IO H5L_info2_t
u_H5L_info2_t'u'val_size v vf = alloca $ \p -> do
  poke p v
  pokeByteOff p 24 vf
  vu <- peek p
  return $ v
    {h5l_info2_t'u'token = h5l_info2_t'u'token vu}
    {h5l_info2_t'u'val_size = h5l_info2_t'u'val_size vu}
instance Storable H5L_info2_t where
  sizeOf _ = 40
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 4
    v2 <- peekByteOff _p 8
    v3 <- peekByteOff _p 16
    v4 <- peekByteOff _p 24
    v5 <- peekByteOff _p 24
    return $ H5L_info2_t v0 v1 v2 v3 v4 v5
  poke _p (H5L_info2_t v0 v1 v2 v3 v4 v5) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 4 v1
    pokeByteOff _p 8 v2
    pokeByteOff _p 16 v3
    pokeByteOff _p 24 v4
    pokeByteOff _p 24 v5
    return ()

{-# LINE 390 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


{-# LINE 392 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

type H5L_info_t = H5L_info1_t

{-# LINE 394 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


{-# LINE 400 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


{-# LINE 413 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- H5Lget_info


{-# LINE 417 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lget_info1" h5l_get_info1
  :: HId_t -> CString -> Out H5L_info1_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lget_info1" p_H5Lget_info1
  :: FunPtr (HId_t -> CString -> Out H5L_info1_t -> HId_t -> IO HErr_t)

{-# LINE 418 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lget_info2" h5l_get_info2
  :: HId_t -> CString -> Out H5L_info2_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lget_info2" p_H5Lget_info2
  :: FunPtr (HId_t -> CString -> Out H5L_info2_t -> HId_t -> IO HErr_t)

{-# LINE 419 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 420 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
h5l_get_info :: HId_t -> CString -> Out H5L_info_t -> HId_t -> IO HErr_t
h5l_get_info = h5l_get_info1

{-# LINE 426 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 431 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- H5Lget_info_by_idx


{-# LINE 435 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lget_info_by_idx1" h5l_get_info_by_idx1
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5L_info1_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lget_info_by_idx1" p_H5Lget_info_by_idx1
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5L_info1_t -> HId_t -> IO HErr_t)

{-# LINE 436 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lget_info_by_idx2" h5l_get_info_by_idx2
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5L_info2_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Lget_info_by_idx2" p_H5Lget_info_by_idx2
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5L_info2_t -> HId_t -> IO HErr_t)

{-# LINE 437 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 438 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
h5l_get_info_by_idx :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5L_info_t -> HId_t -> IO HErr_t
h5l_get_info_by_idx = h5l_get_info_by_idx1

{-# LINE 444 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 449 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- H5L_iterate_t


{-# LINE 453 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

type H5L_iterate1_t a = FunPtr (HId_t -> CString -> In H5L_info1_t -> InOut a -> IO HErr_t)

foreign import ccall "wrapper" mk'H5L_iterate1_t
    :: (HId_t -> CString -> In H5L_info1_t -> InOut a -> IO HErr_t)
    -> IO (FunPtr (HId_t -> CString -> In H5L_info1_t -> InOut a -> IO HErr_t))

type H5L_iterate2_t a = FunPtr (HId_t -> CString -> In H5L_info2_t -> InOut a -> IO HErr_t)

foreign import ccall "wrapper" mk'H5L_iterate2_t
    :: (HId_t -> CString -> In H5L_info2_t -> InOut a -> IO HErr_t)
    -> IO (FunPtr (HId_t -> CString -> In H5L_info2_t -> InOut a -> IO HErr_t))

{-# LINE 466 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

type H5L_iterate_t  a = FunPtr (HId_t -> CString -> In H5L_info_t  -> InOut a -> IO HErr_t)
foreign import ccall "wrapper" mk'H5L_iterate_t
    :: (HId_t -> CString -> In H5L_info_t -> InOut a -> IO HErr_t)
    -> IO (FunPtr (HId_t -> CString -> In H5L_info_t -> InOut a -> IO HErr_t))


{-# LINE 482 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 491 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

-- H5Literate


{-# LINE 495 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Literate1" h5l_iterate1
  :: HId_t -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate1_t a -> InOut a -> IO HErr_t
foreign import ccall "&H5Literate1" p_H5Literate1
  :: FunPtr (HId_t -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate1_t a -> InOut a -> IO HErr_t)

{-# LINE 496 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Literate2" h5l_iterate2
  :: HId_t -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate2_t a -> InOut a -> IO HErr_t
foreign import ccall "&H5Literate2" p_H5Literate2
  :: FunPtr (HId_t -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate2_t a -> InOut a -> IO HErr_t)

{-# LINE 497 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 498 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
h5l_iterate :: HId_t -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate_t  a -> InOut a -> IO HErr_t
h5l_iterate = h5l_iterate1

{-# LINE 506 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 511 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


-- H5Literate_by_name


{-# LINE 516 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Literate_by_name1" h5l_iterate_by_name1
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate1_t a -> InOut a -> HId_t -> IO HErr_t
foreign import ccall "&H5Literate_by_name1" p_H5Literate_by_name1
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate1_t a -> InOut a -> HId_t -> IO HErr_t)

{-# LINE 517 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Literate_by_name2" h5l_iterate_by_name2
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate2_t a -> InOut a -> HId_t -> IO HErr_t
foreign import ccall "&H5Literate_by_name2" p_H5Literate_by_name2
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate2_t a -> InOut a -> HId_t -> IO HErr_t)

{-# LINE 518 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 519 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
h5l_iterate_by_name :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> InOut HSize_t -> H5L_iterate_t  a -> InOut a -> HId_t -> IO HErr_t
h5l_iterate_by_name = h5l_iterate_by_name1

{-# LINE 527 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 532 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


-- H5Lvisit


{-# LINE 537 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lvisit1" h5l_visit1
  :: HId_t -> H5_index_t -> H5_iter_order_t -> H5L_iterate1_t a -> InOut a -> IO HErr_t
foreign import ccall "&H5Lvisit1" p_H5Lvisit1
  :: FunPtr (HId_t -> H5_index_t -> H5_iter_order_t -> H5L_iterate1_t a -> InOut a -> IO HErr_t)

{-# LINE 538 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lvisit2" h5l_visit2
  :: HId_t -> H5_index_t -> H5_iter_order_t -> H5L_iterate2_t a -> InOut a -> IO HErr_t
foreign import ccall "&H5Lvisit2" p_H5Lvisit2
  :: FunPtr (HId_t -> H5_index_t -> H5_iter_order_t -> H5L_iterate2_t a -> InOut a -> IO HErr_t)

{-# LINE 539 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 540 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
h5l_visit :: HId_t -> H5_index_t -> H5_iter_order_t -> H5L_iterate_t a -> InOut a -> IO HErr_t
h5l_visit = h5l_visit1

{-# LINE 548 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 553 "src/Bindings/HDF5/Raw/H5L.hsc" #-}


-- H5Lvisit_by_name


{-# LINE 558 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lvisit_by_name1" h5l_visit_by_name1
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> H5L_iterate1_t a -> InOut a -> HId_t -> IO HErr_t
foreign import ccall "&H5Lvisit_by_name1" p_H5Lvisit_by_name1
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> H5L_iterate1_t a -> InOut a -> HId_t -> IO HErr_t)

{-# LINE 559 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
foreign import ccall "H5Lvisit_by_name2" h5l_visit_by_name2
  :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> H5L_iterate2_t a -> InOut a -> HId_t -> IO HErr_t
foreign import ccall "&H5Lvisit_by_name2" p_H5Lvisit_by_name2
  :: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> H5L_iterate2_t a -> InOut a -> HId_t -> IO HErr_t)

{-# LINE 560 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 561 "src/Bindings/HDF5/Raw/H5L.hsc" #-}
h5l_visit_by_name :: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> H5L_iterate_t a -> InOut a -> HId_t -> IO HErr_t
h5l_visit_by_name = h5l_visit_by_name1

{-# LINE 569 "src/Bindings/HDF5/Raw/H5L.hsc" #-}

{-# LINE 574 "src/Bindings/HDF5/Raw/H5L.hsc" #-}