{-# LINE 1 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
module Bindings.HDF5.Raw.H5G where
import Data.Int
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5L
import Bindings.HDF5.Raw.H5O
import Foreign.Ptr.Conventions
newtype H5G_storage_type_t = H5G_storage_type_t Int32 deriving (Ptr H5G_storage_type_t -> IO H5G_storage_type_t
Ptr H5G_storage_type_t -> Int -> IO H5G_storage_type_t
Ptr H5G_storage_type_t -> Int -> H5G_storage_type_t -> IO ()
Ptr H5G_storage_type_t -> H5G_storage_type_t -> IO ()
H5G_storage_type_t -> Int
(H5G_storage_type_t -> Int)
-> (H5G_storage_type_t -> Int)
-> (Ptr H5G_storage_type_t -> Int -> IO H5G_storage_type_t)
-> (Ptr H5G_storage_type_t -> Int -> H5G_storage_type_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5G_storage_type_t)
-> (forall b. Ptr b -> Int -> H5G_storage_type_t -> IO ())
-> (Ptr H5G_storage_type_t -> IO H5G_storage_type_t)
-> (Ptr H5G_storage_type_t -> H5G_storage_type_t -> IO ())
-> Storable H5G_storage_type_t
forall b. Ptr b -> Int -> IO H5G_storage_type_t
forall b. Ptr b -> Int -> H5G_storage_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 :: H5G_storage_type_t -> Int
sizeOf :: H5G_storage_type_t -> Int
$calignment :: H5G_storage_type_t -> Int
alignment :: H5G_storage_type_t -> Int
$cpeekElemOff :: Ptr H5G_storage_type_t -> Int -> IO H5G_storage_type_t
peekElemOff :: Ptr H5G_storage_type_t -> Int -> IO H5G_storage_type_t
$cpokeElemOff :: Ptr H5G_storage_type_t -> Int -> H5G_storage_type_t -> IO ()
pokeElemOff :: Ptr H5G_storage_type_t -> Int -> H5G_storage_type_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5G_storage_type_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5G_storage_type_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5G_storage_type_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5G_storage_type_t -> IO ()
$cpeek :: Ptr H5G_storage_type_t -> IO H5G_storage_type_t
peek :: Ptr H5G_storage_type_t -> IO H5G_storage_type_t
$cpoke :: Ptr H5G_storage_type_t -> H5G_storage_type_t -> IO ()
poke :: Ptr H5G_storage_type_t -> H5G_storage_type_t -> IO ()
Storable, Int -> H5G_storage_type_t -> ShowS
[H5G_storage_type_t] -> ShowS
H5G_storage_type_t -> String
(Int -> H5G_storage_type_t -> ShowS)
-> (H5G_storage_type_t -> String)
-> ([H5G_storage_type_t] -> ShowS)
-> Show H5G_storage_type_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5G_storage_type_t -> ShowS
showsPrec :: Int -> H5G_storage_type_t -> ShowS
$cshow :: H5G_storage_type_t -> String
show :: H5G_storage_type_t -> String
$cshowList :: [H5G_storage_type_t] -> ShowS
showList :: [H5G_storage_type_t] -> ShowS
Show, H5G_storage_type_t -> H5G_storage_type_t -> Bool
(H5G_storage_type_t -> H5G_storage_type_t -> Bool)
-> (H5G_storage_type_t -> H5G_storage_type_t -> Bool)
-> Eq H5G_storage_type_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
== :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
$c/= :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
/= :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
Eq, Eq H5G_storage_type_t
Eq H5G_storage_type_t =>
(H5G_storage_type_t -> H5G_storage_type_t -> Ordering)
-> (H5G_storage_type_t -> H5G_storage_type_t -> Bool)
-> (H5G_storage_type_t -> H5G_storage_type_t -> Bool)
-> (H5G_storage_type_t -> H5G_storage_type_t -> Bool)
-> (H5G_storage_type_t -> H5G_storage_type_t -> Bool)
-> (H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t)
-> (H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t)
-> Ord H5G_storage_type_t
H5G_storage_type_t -> H5G_storage_type_t -> Bool
H5G_storage_type_t -> H5G_storage_type_t -> Ordering
H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_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 :: H5G_storage_type_t -> H5G_storage_type_t -> Ordering
compare :: H5G_storage_type_t -> H5G_storage_type_t -> Ordering
$c< :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
< :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
$c<= :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
<= :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
$c> :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
> :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
$c>= :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
>= :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
$cmax :: H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t
max :: H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t
$cmin :: H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t
min :: H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t
Ord, ReadPrec [H5G_storage_type_t]
ReadPrec H5G_storage_type_t
Int -> ReadS H5G_storage_type_t
ReadS [H5G_storage_type_t]
(Int -> ReadS H5G_storage_type_t)
-> ReadS [H5G_storage_type_t]
-> ReadPrec H5G_storage_type_t
-> ReadPrec [H5G_storage_type_t]
-> Read H5G_storage_type_t
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS H5G_storage_type_t
readsPrec :: Int -> ReadS H5G_storage_type_t
$creadList :: ReadS [H5G_storage_type_t]
readList :: ReadS [H5G_storage_type_t]
$creadPrec :: ReadPrec H5G_storage_type_t
readPrec :: ReadPrec H5G_storage_type_t
$creadListPrec :: ReadPrec [H5G_storage_type_t]
readListPrec :: ReadPrec [H5G_storage_type_t]
Read)
{-# LINE 21 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_STORAGE_TYPE_UNKNOWN :: H5G_storage_type_t
h5g_STORAGE_TYPE_UNKNOWN :: H5G_storage_type_t
h5g_STORAGE_TYPE_UNKNOWN = Int32 -> H5G_storage_type_t
H5G_storage_type_t (-Int32
1)
{-# LINE 24 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_STORAGE_TYPE_SYMBOL_TABLE :: H5G_storage_type_t
h5g_STORAGE_TYPE_SYMBOL_TABLE :: H5G_storage_type_t
h5g_STORAGE_TYPE_SYMBOL_TABLE = Int32 -> H5G_storage_type_t
H5G_storage_type_t (Int32
0)
{-# LINE 28 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_STORAGE_TYPE_COMPACT :: H5G_storage_type_t
h5g_STORAGE_TYPE_COMPACT :: H5G_storage_type_t
h5g_STORAGE_TYPE_COMPACT = Int32 -> H5G_storage_type_t
H5G_storage_type_t (Int32
1)
{-# LINE 31 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_STORAGE_TYPE_DENSE :: H5G_storage_type_t
h5g_STORAGE_TYPE_DENSE :: H5G_storage_type_t
h5g_STORAGE_TYPE_DENSE = Int32 -> H5G_storage_type_t
H5G_storage_type_t (Int32
2)
{-# LINE 34 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 37 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 40 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 43 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 46 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 49 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
data H5G_info_t = H5G_info_t{
H5G_info_t -> H5G_storage_type_t
h5g_info_t'storage_type :: H5G_storage_type_t,
H5G_info_t -> HSize_t
h5g_info_t'nlinks :: HSize_t,
H5G_info_t -> Int64
h5g_info_t'max_corder :: Int64,
H5G_info_t -> HBool_t
h5g_info_t'mounted :: HBool_t
} deriving (H5G_info_t -> H5G_info_t -> Bool
(H5G_info_t -> H5G_info_t -> Bool)
-> (H5G_info_t -> H5G_info_t -> Bool) -> Eq H5G_info_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H5G_info_t -> H5G_info_t -> Bool
== :: H5G_info_t -> H5G_info_t -> Bool
$c/= :: H5G_info_t -> H5G_info_t -> Bool
/= :: H5G_info_t -> H5G_info_t -> Bool
Eq,Int -> H5G_info_t -> ShowS
[H5G_info_t] -> ShowS
H5G_info_t -> String
(Int -> H5G_info_t -> ShowS)
-> (H5G_info_t -> String)
-> ([H5G_info_t] -> ShowS)
-> Show H5G_info_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5G_info_t -> ShowS
showsPrec :: Int -> H5G_info_t -> ShowS
$cshow :: H5G_info_t -> String
show :: H5G_info_t -> String
$cshowList :: [H5G_info_t] -> ShowS
showList :: [H5G_info_t] -> ShowS
Show)
p'H5G_info_t'storage_type :: Ptr H5G_info_t -> Ptr H5G_storage_type_t
p'H5G_info_t'storage_type Ptr H5G_info_t
p = Ptr H5G_info_t -> Int -> Ptr H5G_storage_type_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_info_t
p Int
0
p'H5G_info_t'storage_type :: Ptr (H5G_info_t) -> Ptr (H5G_storage_type_t)
p'H5G_info_t'nlinks :: Ptr H5G_info_t -> Ptr HSize_t
p'H5G_info_t'nlinks Ptr H5G_info_t
p = Ptr H5G_info_t -> Int -> Ptr HSize_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_info_t
p Int
8
p'H5G_info_t'nlinks :: Ptr (H5G_info_t) -> Ptr (HSize_t)
p'H5G_info_t'max_corder :: Ptr H5G_info_t -> Ptr Int64
p'H5G_info_t'max_corder Ptr H5G_info_t
p = Ptr H5G_info_t -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_info_t
p Int
16
p'H5G_info_t'max_corder :: Ptr (H5G_info_t) -> Ptr (Int64)
p'H5G_info_t'mounted :: Ptr H5G_info_t -> Ptr HBool_t
p'H5G_info_t'mounted Ptr H5G_info_t
p = Ptr H5G_info_t -> Int -> Ptr HBool_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_info_t
p Int
24
p'H5G_info_t'mounted :: Ptr (H5G_info_t) -> Ptr (HBool_t)
instance Storable H5G_info_t where
sizeOf :: H5G_info_t -> Int
sizeOf H5G_info_t
_ = Int
32
alignment :: H5G_info_t -> Int
alignment H5G_info_t
_ = Int
8
peek :: Ptr H5G_info_t -> IO H5G_info_t
peek Ptr H5G_info_t
_p = do
H5G_storage_type_t
v0 <- Ptr H5G_info_t -> Int -> IO H5G_storage_type_t
forall b. Ptr b -> Int -> IO H5G_storage_type_t
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr H5G_info_t
_p Int
0
HSize_t
v1 <- Ptr H5G_info_t -> Int -> IO HSize_t
forall b. Ptr b -> Int -> IO HSize_t
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr H5G_info_t
_p Int
8
Int64
v2 <- Ptr H5G_info_t -> Int -> IO Int64
forall b. Ptr b -> Int -> IO Int64
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr H5G_info_t
_p Int
16
HBool_t
v3 <- Ptr H5G_info_t -> Int -> IO HBool_t
forall b. Ptr b -> Int -> IO HBool_t
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr H5G_info_t
_p Int
24
H5G_info_t -> IO H5G_info_t
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (H5G_info_t -> IO H5G_info_t) -> H5G_info_t -> IO H5G_info_t
forall a b. (a -> b) -> a -> b
$ H5G_storage_type_t -> HSize_t -> Int64 -> HBool_t -> H5G_info_t
H5G_info_t H5G_storage_type_t
v0 HSize_t
v1 Int64
v2 HBool_t
v3
poke :: Ptr H5G_info_t -> H5G_info_t -> IO ()
poke Ptr H5G_info_t
_p (H5G_info_t H5G_storage_type_t
v0 HSize_t
v1 Int64
v2 HBool_t
v3) = do
Ptr H5G_info_t -> Int -> H5G_storage_type_t -> IO ()
forall b. Ptr b -> Int -> H5G_storage_type_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5G_info_t
_p Int
0 H5G_storage_type_t
v0
Ptr H5G_info_t -> Int -> HSize_t -> IO ()
forall b. Ptr b -> Int -> HSize_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5G_info_t
_p Int
8 HSize_t
v1
pokeByteOff _p 16 v2
pokeByteOff _p 24 v3
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# LINE 51 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gcreate2" h5g_create2
:: HId_t -> CString -> HId_t -> HId_t -> HId_t -> IO HId_t
foreign import ccall "&H5Gcreate2" p_H5Gcreate2
:: FunPtr (HId_t -> CString -> HId_t -> HId_t -> HId_t -> IO HId_t)
{-# LINE 77 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gcreate_anon" h5g_create_anon
:: HId_t -> HId_t -> HId_t -> IO HId_t
foreign import ccall "&H5Gcreate_anon" p_H5Gcreate_anon
:: FunPtr (HId_t -> HId_t -> HId_t -> IO HId_t)
{-# LINE 111 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gopen2" h5g_open2
:: HId_t -> CString -> HId_t -> IO HId_t
foreign import ccall "&H5Gopen2" p_H5Gopen2
:: FunPtr (HId_t -> CString -> HId_t -> IO HId_t)
{-# LINE 123 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_create_plist" h5g_get_create_plist
:: HId_t -> IO HId_t
foreign import ccall "&H5Gget_create_plist" p_H5Gget_create_plist
:: FunPtr (HId_t -> IO HId_t)
{-# LINE 132 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_info" h5g_get_info
:: HId_t -> Out H5G_info_t -> IO HErr_t
foreign import ccall "&H5Gget_info" p_H5Gget_info
:: FunPtr (HId_t -> Out H5G_info_t -> IO HErr_t)
{-# LINE 139 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_info_by_name" h5g_get_info_by_name
:: HId_t -> CString -> Out H5G_info_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Gget_info_by_name" p_H5Gget_info_by_name
:: FunPtr (HId_t -> CString -> Out H5G_info_t -> HId_t -> IO HErr_t)
{-# LINE 147 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_info_by_idx" h5g_get_info_by_idx
:: HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5G_info_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Gget_info_by_idx" p_H5Gget_info_by_idx
:: FunPtr (HId_t -> CString -> H5_index_t -> H5_iter_order_t -> HSize_t -> Out H5G_info_t -> HId_t -> IO HErr_t)
{-# LINE 156 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gclose" h5g_close
:: HId_t -> IO HErr_t
foreign import ccall "&H5Gclose" p_H5Gclose
:: FunPtr (HId_t -> IO HErr_t)
{-# LINE 164 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gflush" h5g_flush
:: HId_t -> IO HErr_t
foreign import ccall "&H5Gflush" p_H5Gflush
:: FunPtr (HId_t -> IO HErr_t)
{-# LINE 167 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Grefresh" h5g_refresh
:: HId_t -> IO HErr_t
foreign import ccall "&H5Grefresh" p_H5Grefresh
:: FunPtr (HId_t -> IO HErr_t)
{-# LINE 170 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 172 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_SAME_LOC = 0
h5g_SAME_LOC :: (Num a) => a
{-# LINE 174 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK_ERROR :: H5L_type_t
h5g_LINK_ERROR = H5L_type_t (-1)
{-# LINE 175 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK_HARD :: H5L_type_t
h5g_LINK_HARD = H5L_type_t (0)
{-# LINE 176 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK_SOFT :: H5L_type_t
h5g_LINK_SOFT = H5L_type_t (1)
{-# LINE 177 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
type H5G_link_t = H5L_type_t
h5g_NTYPES :: forall a. Num a => a
h5g_NTYPES = a
256
h5g_NTYPES :: (Num a) => a
{-# LINE 181 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_NLIBTYPES = 8
h5g_NLIBTYPES :: (Num a) => a
{-# LINE 182 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_NUSERTYPES = 248
h5g_NUSERTYPES :: (Num a) => a
{-# LINE 183 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "inline_H5G_USERTYPE" h5g_USERTYPE
:: H5G_obj_t -> H5G_obj_t
{-# LINE 184 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
newtype H5G_obj_t = H5G_obj_t Int32 deriving (Ptr H5G_obj_t -> IO H5G_obj_t
Ptr H5G_obj_t -> Int -> IO H5G_obj_t
Ptr H5G_obj_t -> Int -> H5G_obj_t -> IO ()
Ptr H5G_obj_t -> H5G_obj_t -> IO ()
H5G_obj_t -> Int
(H5G_obj_t -> Int)
-> (H5G_obj_t -> Int)
-> (Ptr H5G_obj_t -> Int -> IO H5G_obj_t)
-> (Ptr H5G_obj_t -> Int -> H5G_obj_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5G_obj_t)
-> (forall b. Ptr b -> Int -> H5G_obj_t -> IO ())
-> (Ptr H5G_obj_t -> IO H5G_obj_t)
-> (Ptr H5G_obj_t -> H5G_obj_t -> IO ())
-> Storable H5G_obj_t
forall b. Ptr b -> Int -> IO H5G_obj_t
forall b. Ptr b -> Int -> H5G_obj_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 :: H5G_obj_t -> Int
sizeOf :: H5G_obj_t -> Int
$calignment :: H5G_obj_t -> Int
alignment :: H5G_obj_t -> Int
$cpeekElemOff :: Ptr H5G_obj_t -> Int -> IO H5G_obj_t
peekElemOff :: Ptr H5G_obj_t -> Int -> IO H5G_obj_t
$cpokeElemOff :: Ptr H5G_obj_t -> Int -> H5G_obj_t -> IO ()
pokeElemOff :: Ptr H5G_obj_t -> Int -> H5G_obj_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5G_obj_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5G_obj_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5G_obj_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5G_obj_t -> IO ()
$cpeek :: Ptr H5G_obj_t -> IO H5G_obj_t
peek :: Ptr H5G_obj_t -> IO H5G_obj_t
$cpoke :: Ptr H5G_obj_t -> H5G_obj_t -> IO ()
poke :: Ptr H5G_obj_t -> H5G_obj_t -> IO ()
Storable, Int -> H5G_obj_t -> ShowS
[H5G_obj_t] -> ShowS
H5G_obj_t -> String
(Int -> H5G_obj_t -> ShowS)
-> (H5G_obj_t -> String)
-> ([H5G_obj_t] -> ShowS)
-> Show H5G_obj_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5G_obj_t -> ShowS
showsPrec :: Int -> H5G_obj_t -> ShowS
$cshow :: H5G_obj_t -> String
show :: H5G_obj_t -> String
$cshowList :: [H5G_obj_t] -> ShowS
showList :: [H5G_obj_t] -> ShowS
Show, H5G_obj_t -> H5G_obj_t -> Bool
(H5G_obj_t -> H5G_obj_t -> Bool)
-> (H5G_obj_t -> H5G_obj_t -> Bool) -> Eq H5G_obj_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H5G_obj_t -> H5G_obj_t -> Bool
== :: H5G_obj_t -> H5G_obj_t -> Bool
$c/= :: H5G_obj_t -> H5G_obj_t -> Bool
/= :: H5G_obj_t -> H5G_obj_t -> Bool
Eq)
{-# LINE 190 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_UNKNOWN :: H5G_obj_t
h5g_UNKNOWN :: H5G_obj_t
h5g_UNKNOWN = Int32 -> H5G_obj_t
H5G_obj_t (-Int32
1)
{-# LINE 193 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_GROUP :: H5G_obj_t
h5g_GROUP :: H5G_obj_t
h5g_GROUP = Int32 -> H5G_obj_t
H5G_obj_t (Int32
0)
{-# LINE 196 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_DATASET :: H5G_obj_t
h5g_DATASET :: H5G_obj_t
h5g_DATASET = Int32 -> H5G_obj_t
H5G_obj_t (Int32
1)
{-# LINE 199 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_TYPE :: H5G_obj_t
h5g_TYPE :: H5G_obj_t
h5g_TYPE = Int32 -> H5G_obj_t
H5G_obj_t (Int32
2)
{-# LINE 202 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK :: H5G_obj_t
h5g_LINK :: H5G_obj_t
h5g_LINK = Int32 -> H5G_obj_t
H5G_obj_t (Int32
3)
{-# LINE 205 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_UDLINK :: H5G_obj_t
h5g_UDLINK :: H5G_obj_t
h5g_UDLINK = Int32 -> H5G_obj_t
H5G_obj_t (Int32
4)
{-# LINE 208 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_RESERVED_5 :: H5G_obj_t
h5g_RESERVED_5 :: H5G_obj_t
h5g_RESERVED_5 = Int32 -> H5G_obj_t
H5G_obj_t (Int32
5)
{-# LINE 211 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_RESERVED_6 :: H5G_obj_t
h5g_RESERVED_6 :: H5G_obj_t
h5g_RESERVED_6 = Int32 -> H5G_obj_t
H5G_obj_t (Int32
6)
{-# LINE 214 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_RESERVED_7 :: H5G_obj_t
h5g_RESERVED_7 :: H5G_obj_t
h5g_RESERVED_7 = Int32 -> H5G_obj_t
H5G_obj_t (Int32
7)
{-# LINE 217 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
type H5G_iterate_t a = FunPtr (HId_t -> CString -> InOut a -> IO HErr_t)
{-# LINE 225 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 228 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 231 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 234 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 237 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 240 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 243 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 246 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
data H5G_stat_t = H5G_stat_t{
h5g_stat_t'fileno :: [CULong],
h5g_stat_t'objno :: [CULong],
h5g_stat_t'nlink :: CUInt,
h5g_stat_t'type :: H5G_obj_t,
h5g_stat_t'mtime :: CTime,
h5g_stat_t'linklen :: CSize,
h5g_stat_t'ohdr :: H5O_stat_t
} deriving (Eq,Show)
p'H5G_stat_t'fileno :: Ptr H5G_stat_t -> Ptr CULong
p'H5G_stat_t'fileno Ptr H5G_stat_t
p = Ptr H5G_stat_t -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
p Int
0
p'H5G_stat_t'fileno :: Ptr (H5G_stat_t) -> Ptr (CULong)
p'H5G_stat_t'objno :: Ptr H5G_stat_t -> Ptr CULong
p'H5G_stat_t'objno Ptr H5G_stat_t
p = Ptr H5G_stat_t -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
p Int
16
p'H5G_stat_t'objno :: Ptr (H5G_stat_t) -> Ptr (CULong)
p'H5G_stat_t'nlink :: Ptr H5G_stat_t -> Ptr CUInt
p'H5G_stat_t'nlink Ptr H5G_stat_t
p = Ptr H5G_stat_t -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
p Int
32
p'H5G_stat_t'nlink :: Ptr (H5G_stat_t) -> Ptr (CUInt)
p'H5G_stat_t'type :: Ptr H5G_stat_t -> Ptr H5G_obj_t
p'H5G_stat_t'type Ptr H5G_stat_t
p = Ptr H5G_stat_t -> Int -> Ptr H5G_obj_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
p Int
36
p'H5G_stat_t'type :: Ptr (H5G_stat_t) -> Ptr (H5G_obj_t)
p'H5G_stat_t'mtime :: Ptr H5G_stat_t -> Ptr CTime
p'H5G_stat_t'mtime Ptr H5G_stat_t
p = Ptr H5G_stat_t -> Int -> Ptr CTime
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
p Int
40
p'H5G_stat_t'mtime :: Ptr (H5G_stat_t) -> Ptr (CTime)
p'H5G_stat_t'linklen :: Ptr H5G_stat_t -> Ptr CSize
p'H5G_stat_t'linklen Ptr H5G_stat_t
p = plusPtr p 48
p'H5G_stat_t'linklen :: Ptr (H5G_stat_t) -> Ptr (CSize)
p'H5G_stat_t'ohdr :: Ptr H5G_stat_t -> Ptr H5O_stat_t
p'H5G_stat_t'ohdr Ptr H5G_stat_t
p = Ptr H5G_stat_t -> Int -> Ptr H5O_stat_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
p Int
56
p'H5G_stat_t'ohdr :: Ptr (H5G_stat_t) -> Ptr (H5O_stat_t)
instance Storable H5G_stat_t where
sizeOf :: H5G_stat_t -> Int
sizeOf H5G_stat_t
_ = Int
80
alignment :: H5G_stat_t -> Int
alignment H5G_stat_t
_ = Int
8
peek _p = do
v0 <- let s0 = div 16 $ sizeOf $ (undefined :: CULong) in peekArray s0 (plusPtr _p 0)
v1 <- let s1 = div 16 $ sizeOf $ (undefined :: CULong) in peekArray s1 (plusPtr _p 16)
v2 <- peekByteOff _p 32
v3 <- peekByteOff _p 36
v4 <- peekByteOff _p 40
v5 <- peekByteOff _p 48
v6 <- peekByteOff _p 56
return $ H5G_stat_t v0 v1 v2 v3 v4 v5 v6
poke _p (H5G_stat_t v0 v1 v2 v3 v4 v5 v6) = do
let s0 = div 16 $ sizeOf $ (undefined :: CULong)
pokeArray (plusPtr _p 0) (take s0 v0)
let s1 = div 16 $ sizeOf $ (undefined :: CULong)
pokeArray (plusPtr _p 16) (take s1 v1)
pokeByteOff _p 32 v2
pokeByteOff _p 36 v3
pokeByteOff _p 40 v4
pokeByteOff _p 48 v5
pokeByteOff _p 56 v6
return ()
{-# LINE 247 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gcreate1" h5g_create1
:: HId_t -> CString -> CSize -> IO HId_t
foreign import ccall "&H5Gcreate1" p_H5Gcreate1
:: FunPtr (HId_t -> CString -> CSize -> IO HId_t)
{-# LINE 266 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gopen1" h5g_open1
:: HId_t -> CString -> IO HId_t
foreign import ccall "&H5Gopen1" p_H5Gopen1
:: FunPtr (HId_t -> CString -> IO HId_t)
{-# LINE 277 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Glink" h5g_link
:: HId_t -> H5L_type_t -> CString -> CString -> IO HErr_t
foreign import ccall "&H5Glink" p_H5Glink
:: FunPtr (HId_t -> H5L_type_t -> CString -> CString -> IO HErr_t)
{-# LINE 284 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Glink2" h5g_link2
:: HId_t -> CString -> H5L_type_t -> HId_t -> CString -> IO HErr_t
foreign import ccall "&H5Glink2" p_H5Glink2
:: FunPtr (HId_t -> CString -> H5L_type_t -> HId_t -> CString -> IO HErr_t)
{-# LINE 291 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gmove" h5g_move
:: HId_t -> CString -> CString -> IO HErr_t
foreign import ccall "&H5Gmove" p_H5Gmove
:: FunPtr (HId_t -> CString -> CString -> IO HErr_t)
{-# LINE 297 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gmove2" h5g_move2
:: HId_t -> CString -> HId_t -> CString -> IO HErr_t
foreign import ccall "&H5Gmove2" p_H5Gmove2
:: FunPtr (HId_t -> CString -> HId_t -> CString -> IO HErr_t)
{-# LINE 303 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gunlink" h5g_unlink
:: HId_t -> CString -> IO HErr_t
foreign import ccall "&H5Gunlink" p_H5Gunlink
:: FunPtr (HId_t -> CString -> IO HErr_t)
{-# LINE 308 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_linkval" h5g_get_linkval
:: HId_t -> CString -> CSize -> OutArray a -> IO HErr_t
foreign import ccall "&H5Gget_linkval" p_H5Gget_linkval
:: FunPtr (HId_t -> CString -> CSize -> OutArray a -> IO HErr_t)
{-# LINE 314 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gset_comment"
:: HId_t -> CString -> CString -> IO HErr_t
foreign import ccall "&H5Gset_comment"
:: FunPtr (HId_t -> CString -> CString -> IO HErr_t)
{-# LINE 326 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_comment"
:: HId_t -> CString -> CSize -> OutArray CChar -> IO CInt
foreign import ccall "&H5Gget_comment"
:: FunPtr (HId_t -> CString -> CSize -> OutArray CChar -> IO CInt)
{-# LINE 343 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Giterate" h5g_iterate
:: HId_t -> CString -> InOut CInt -> H5G_iterate_t a -> InOut a -> IO HErr_t
foreign import ccall "&H5Giterate" p_H5Giterate
:: FunPtr (HId_t -> CString -> InOut CInt -> H5G_iterate_t a -> InOut a -> IO HErr_t)
{-# LINE 366 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_num_objs" h5g_get_num_objs
:: HId_t -> Out HSize_t -> IO HErr_t
foreign import ccall "&H5Gget_num_objs" p_H5Gget_num_objs
:: FunPtr (HId_t -> Out HSize_t -> IO HErr_t)
{-# LINE 376 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_objinfo" h5g_get_objinfo
:: HId_t -> CString -> HBool_t -> Out H5G_stat_t -> IO HErr_t
foreign import ccall "&H5Gget_objinfo" p_H5Gget_objinfo
:: FunPtr (HId_t -> CString -> HBool_t -> Out H5G_stat_t -> IO HErr_t)
{-# LINE 389 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_objname_by_idx" h5g_get_objname_by_idx
:: HId_t -> HSize_t -> OutArray CChar -> CSize -> IO CSSize
foreign import ccall "&H5Gget_objname_by_idx" p_H5Gget_objname_by_idx
:: FunPtr (HId_t -> HSize_t -> OutArray CChar -> CSize -> IO CSSize)
{-# LINE 407 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "H5Gget_objtype_by_idx" h5g_get_objtype_by_idx
:: HId_t -> HSize_t -> IO H5G_obj_t
foreign import ccall "&H5Gget_objtype_by_idx" p_H5Gget_objtype_by_idx
:: FunPtr (HId_t -> HSize_t -> IO H5G_obj_t)
{-# LINE 417 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 420 "src/Bindings/HDF5/Raw/H5G.hsc" #-}