{-# 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
poke :: Ptr H5G_storage_type_t -> H5G_storage_type_t -> IO ()
$cpoke :: Ptr H5G_storage_type_t -> H5G_storage_type_t -> IO ()
peek :: Ptr H5G_storage_type_t -> IO H5G_storage_type_t
$cpeek :: Ptr H5G_storage_type_t -> IO H5G_storage_type_t
pokeByteOff :: forall b. Ptr b -> Int -> H5G_storage_type_t -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> H5G_storage_type_t -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO H5G_storage_type_t
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5G_storage_type_t
pokeElemOff :: Ptr H5G_storage_type_t -> Int -> H5G_storage_type_t -> IO ()
$cpokeElemOff :: Ptr H5G_storage_type_t -> Int -> H5G_storage_type_t -> IO ()
peekElemOff :: Ptr H5G_storage_type_t -> Int -> IO H5G_storage_type_t
$cpeekElemOff :: Ptr H5G_storage_type_t -> Int -> IO H5G_storage_type_t
alignment :: H5G_storage_type_t -> Int
$calignment :: H5G_storage_type_t -> Int
sizeOf :: H5G_storage_type_t -> Int
$csizeOf :: H5G_storage_type_t -> Int
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
showList :: [H5G_storage_type_t] -> ShowS
$cshowList :: [H5G_storage_type_t] -> ShowS
show :: H5G_storage_type_t -> String
$cshow :: H5G_storage_type_t -> String
showsPrec :: Int -> H5G_storage_type_t -> ShowS
$cshowsPrec :: Int -> 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
/= :: 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
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
min :: 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
max :: H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t
$cmax :: H5G_storage_type_t -> H5G_storage_type_t -> H5G_storage_type_t
>= :: 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
$c< :: H5G_storage_type_t -> H5G_storage_type_t -> Bool
compare :: H5G_storage_type_t -> H5G_storage_type_t -> Ordering
$ccompare :: H5G_storage_type_t -> H5G_storage_type_t -> Ordering
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
readListPrec :: ReadPrec [H5G_storage_type_t]
$creadListPrec :: ReadPrec [H5G_storage_type_t]
readPrec :: ReadPrec H5G_storage_type_t
$creadPrec :: ReadPrec H5G_storage_type_t
readList :: ReadS [H5G_storage_type_t]
$creadList :: ReadS [H5G_storage_type_t]
readsPrec :: Int -> ReadS H5G_storage_type_t
$creadsPrec :: Int -> ReadS 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 48 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 50 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 51 "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
/= :: H5G_info_t -> H5G_info_t -> Bool
$c/= :: H5G_info_t -> H5G_info_t -> Bool
== :: H5G_info_t -> H5G_info_t -> Bool
$c== :: 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
showList :: [H5G_info_t] -> ShowS
$cshowList :: [H5G_info_t] -> ShowS
show :: H5G_info_t -> String
$cshow :: H5G_info_t -> String
showsPrec :: Int -> H5G_info_t -> ShowS
$cshowsPrec :: Int -> 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 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 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 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 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 (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 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 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 (m :: * -> *) a. Monad m => a -> m a
return ()
{-# LINE 53 "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 79 "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 113 "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 125 "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 134 "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 141 "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 149 "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 158 "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 166 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 168 "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 170 "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 172 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 173 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 175 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_SAME_LOC = 0
h5g_SAME_LOC :: (Num a) => a
{-# LINE 177 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK_ERROR :: H5L_type_t
h5g_LINK_ERROR = H5L_type_t (-1)
{-# LINE 178 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK_HARD :: H5L_type_t
h5g_LINK_HARD = H5L_type_t (0)
{-# LINE 179 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_LINK_SOFT :: H5L_type_t
h5g_LINK_SOFT = H5L_type_t (1)
{-# LINE 180 "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 184 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_NLIBTYPES = 8
h5g_NLIBTYPES :: (Num a) => a
{-# LINE 185 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
h5g_NUSERTYPES = 248
h5g_NUSERTYPES :: (Num a) => a
{-# LINE 186 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
foreign import ccall "inline_H5G_USERTYPE" h5g_USERTYPE
:: H5G_obj_t -> H5G_obj_t
{-# LINE 187 "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
poke :: Ptr H5G_obj_t -> H5G_obj_t -> IO ()
$cpoke :: Ptr H5G_obj_t -> H5G_obj_t -> IO ()
peek :: Ptr H5G_obj_t -> IO H5G_obj_t
$cpeek :: Ptr H5G_obj_t -> IO H5G_obj_t
pokeByteOff :: forall b. Ptr b -> Int -> H5G_obj_t -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> H5G_obj_t -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO H5G_obj_t
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5G_obj_t
pokeElemOff :: Ptr H5G_obj_t -> Int -> H5G_obj_t -> IO ()
$cpokeElemOff :: Ptr H5G_obj_t -> Int -> H5G_obj_t -> IO ()
peekElemOff :: Ptr H5G_obj_t -> Int -> IO H5G_obj_t
$cpeekElemOff :: Ptr H5G_obj_t -> Int -> IO H5G_obj_t
alignment :: H5G_obj_t -> Int
$calignment :: H5G_obj_t -> Int
sizeOf :: H5G_obj_t -> Int
$csizeOf :: H5G_obj_t -> Int
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
showList :: [H5G_obj_t] -> ShowS
$cshowList :: [H5G_obj_t] -> ShowS
show :: H5G_obj_t -> String
$cshow :: H5G_obj_t -> String
showsPrec :: Int -> H5G_obj_t -> ShowS
$cshowsPrec :: Int -> 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
/= :: H5G_obj_t -> H5G_obj_t -> Bool
$c/= :: H5G_obj_t -> H5G_obj_t -> Bool
== :: H5G_obj_t -> H5G_obj_t -> Bool
$c== :: H5G_obj_t -> H5G_obj_t -> Bool
Eq)
{-# LINE 193 "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 196 "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 199 "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 202 "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 205 "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 208 "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 211 "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 214 "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 217 "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 220 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
type H5G_iterate_t a = FunPtr (HId_t -> CString -> InOut a -> IO HErr_t)
{-# 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" #-}
{-# LINE 249 "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 :: Ptr H5G_stat_t -> IO H5G_stat_t
peek Ptr H5G_stat_t
_p = do
[CULong]
v0 <- let s0 :: Int
s0 = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ CULong -> Int
forall a. Storable a => a -> Int
sizeOf (CULong -> Int) -> CULong -> Int
forall a b. (a -> b) -> a -> b
$ (CULong
forall a. HasCallStack => a
undefined :: CULong) in Int -> Ptr CULong -> IO [CULong]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
s0 (Ptr H5G_stat_t -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
_p Int
0)
[CULong]
v1 <- let s1 :: Int
s1 = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ CULong -> Int
forall a. Storable a => a -> Int
sizeOf (CULong -> Int) -> CULong -> Int
forall a b. (a -> b) -> a -> b
$ (CULong
forall a. HasCallStack => a
undefined :: CULong) in Int -> Ptr CULong -> IO [CULong]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
s1 (Ptr H5G_stat_t -> Int -> Ptr CULong
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5G_stat_t
_p Int
16)
CUInt
v2 <- Ptr H5G_stat_t -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr H5G_stat_t
_p Int
32
v3 <- peekByteOff _p 36
v4 <- peekByteOff _p 40
v5 <- peekByteOff _p 48
v6 <- peekByteOff _p 56
H5G_stat_t -> IO H5G_stat_t
forall (m :: * -> *) a. Monad m => a -> m a
return (H5G_stat_t -> IO H5G_stat_t) -> H5G_stat_t -> IO H5G_stat_t
forall a b. (a -> b) -> a -> b
$ [CULong]
-> [CULong]
-> CUInt
-> H5G_obj_t
-> CTime
-> CSize
-> H5O_stat_t
-> H5G_stat_t
H5G_stat_t [CULong]
v0 [CULong]
v1 CUInt
v2 H5G_obj_t
v3 CTime
v4 CSize
v5 H5O_stat_t
v6
poke :: Ptr H5G_stat_t -> H5G_stat_t -> IO ()
poke Ptr H5G_stat_t
_p (H5G_stat_t [CULong]
v0 [CULong]
v1 CUInt
v2 H5G_obj_t
v3 CTime
v4 CSize
v5 H5O_stat_t
v6) = do
let s0 :: Int
s0 = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ CULong -> Int
forall a. Storable a => a -> Int
sizeOf (CULong -> Int) -> CULong -> Int
forall a b. (a -> b) -> a -> b
$ (CULong
forall a. HasCallStack => a
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
Ptr H5G_stat_t -> Int -> H5G_obj_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5G_stat_t
_p Int
36 H5G_obj_t
v3
Ptr H5G_stat_t -> Int -> CTime -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5G_stat_t
_p Int
40 CTime
v4
Ptr H5G_stat_t -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5G_stat_t
_p Int
48 CSize
v5
Ptr H5G_stat_t -> Int -> H5O_stat_t -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5G_stat_t
_p Int
56 H5O_stat_t
v6
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# LINE 250 "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 269 "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 280 "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 287 "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 294 "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 300 "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 306 "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 311 "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 317 "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 329 "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 346 "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 369 "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 379 "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 392 "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 410 "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 420 "src/Bindings/HDF5/Raw/H5G.hsc" #-}
{-# LINE 423 "src/Bindings/HDF5/Raw/H5G.hsc" #-}