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



module Bindings.HDF5.Raw.H5F where

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

import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5AC
import Bindings.HDF5.Raw.H5I

import Foreign.Ptr.Conventions

-- * Types and constants

-- ** Flags for 'h5f_create' and 'h5f_open'
-- These are the bits that can be passed to the 'flags' argument of
-- H5Fcreate() and H5Fopen(). Use the bit-wise OR operator (|) to combine
-- them as needed.  As a side effect, they call H5check_version() to make sure
-- that the application is compiled with a version of the hdf5 header files
-- which are compatible with the library to which the application is linked.
-- We're assuming that these constants are used rather early in the hdf5
-- session.

-- |absence of rdwr => rd-only
h5f_ACC_RDONLY :: forall a. Num a => a
h5f_ACC_RDONLY = a
0
h5f_ACC_RDONLY :: (Num a) => a

{-# LINE 32 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |open for read and write
h5f_ACC_RDWR = 1
h5f_ACC_RDWR :: (Num a) => a

{-# LINE 35 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |overwrite existing files
h5f_ACC_TRUNC = 2
h5f_ACC_TRUNC :: (Num a) => a

{-# LINE 38 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |fail if file already exists
h5f_ACC_EXCL = 4
h5f_ACC_EXCL :: (Num a) => a

{-# LINE 41 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |print debug info
h5f_ACC_DEBUG = 0
h5f_ACC_DEBUG :: (Num a) => a

{-# LINE 44 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |create non-existing files
h5f_ACC_CREAT = 16
h5f_ACC_CREAT :: (Num a) => a

{-# LINE 47 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Value passed to 'h5p_set_elink_acc_flags' to cause flags to be taken from the
-- parent file.
h5f_ACC_DEFAULT :: forall a. Num a => a
h5f_ACC_DEFAULT = a
65535
h5f_ACC_DEFAULT :: (Num a) => a

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

-- ** Flags for 'h5f_get_obj_count' and 'h5f_get_obj_ids' calls

-- |File objects
h5f_OBJ_FILE :: forall a. Num a => a
h5f_OBJ_FILE = a
1
h5f_OBJ_FILE :: (Num a) => a

{-# LINE 56 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Dataset objects
h5f_OBJ_DATASET = 2
h5f_OBJ_DATASET :: (Num a) => a

{-# LINE 59 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Group objects
h5f_OBJ_GROUP = 4
h5f_OBJ_GROUP :: (Num a) => a

{-# LINE 62 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Named datatype objects
h5f_OBJ_DATATYPE = 8
h5f_OBJ_DATATYPE :: (Num a) => a

{-# LINE 65 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Attribute objects
h5f_OBJ_ATTR = 16
h5f_OBJ_ATTR :: (Num a) => a

{-# LINE 68 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

h5f_OBJ_ALL = 31
h5f_OBJ_ALL :: (Num a) => a

{-# LINE 70 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Restrict search to objects opened through current file ID
h5f_OBJ_LOCAL = 32
h5f_OBJ_LOCAL :: (Num a) => a

{-# LINE 73 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

h5f_FAMILY_DEFAULT :: HSize_t
h5f_FAMILY_DEFAULT = HSize_t (0)

{-# LINE 75 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


{-# LINE 85 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |The difference between a single file and a set of mounted files
newtype H5F_scope_t = H5F_scope_t Word32 deriving (Ptr H5F_scope_t -> IO H5F_scope_t
Ptr H5F_scope_t -> Int -> IO H5F_scope_t
Ptr H5F_scope_t -> Int -> H5F_scope_t -> IO ()
Ptr H5F_scope_t -> H5F_scope_t -> IO ()
H5F_scope_t -> Int
(H5F_scope_t -> Int)
-> (H5F_scope_t -> Int)
-> (Ptr H5F_scope_t -> Int -> IO H5F_scope_t)
-> (Ptr H5F_scope_t -> Int -> H5F_scope_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5F_scope_t)
-> (forall b. Ptr b -> Int -> H5F_scope_t -> IO ())
-> (Ptr H5F_scope_t -> IO H5F_scope_t)
-> (Ptr H5F_scope_t -> H5F_scope_t -> IO ())
-> Storable H5F_scope_t
forall b. Ptr b -> Int -> IO H5F_scope_t
forall b. Ptr b -> Int -> H5F_scope_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 :: H5F_scope_t -> Int
sizeOf :: H5F_scope_t -> Int
$calignment :: H5F_scope_t -> Int
alignment :: H5F_scope_t -> Int
$cpeekElemOff :: Ptr H5F_scope_t -> Int -> IO H5F_scope_t
peekElemOff :: Ptr H5F_scope_t -> Int -> IO H5F_scope_t
$cpokeElemOff :: Ptr H5F_scope_t -> Int -> H5F_scope_t -> IO ()
pokeElemOff :: Ptr H5F_scope_t -> Int -> H5F_scope_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5F_scope_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5F_scope_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5F_scope_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5F_scope_t -> IO ()
$cpeek :: Ptr H5F_scope_t -> IO H5F_scope_t
peek :: Ptr H5F_scope_t -> IO H5F_scope_t
$cpoke :: Ptr H5F_scope_t -> H5F_scope_t -> IO ()
poke :: Ptr H5F_scope_t -> H5F_scope_t -> IO ()
Storable, Int -> H5F_scope_t -> ShowS
[H5F_scope_t] -> ShowS
H5F_scope_t -> String
(Int -> H5F_scope_t -> ShowS)
-> (H5F_scope_t -> String)
-> ([H5F_scope_t] -> ShowS)
-> Show H5F_scope_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5F_scope_t -> ShowS
showsPrec :: Int -> H5F_scope_t -> ShowS
$cshow :: H5F_scope_t -> String
show :: H5F_scope_t -> String
$cshowList :: [H5F_scope_t] -> ShowS
showList :: [H5F_scope_t] -> ShowS
Show)

{-# LINE 88 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |specified file handle only
h5f_SCOPE_LOCAL :: H5F_scope_t
h5f_SCOPE_LOCAL :: H5F_scope_t
h5f_SCOPE_LOCAL = Word32 -> H5F_scope_t
H5F_scope_t (Word32
0)

{-# LINE 91 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |entire virtual file
h5f_SCOPE_GLOBAL :: H5F_scope_t
h5f_SCOPE_GLOBAL :: H5F_scope_t
h5f_SCOPE_GLOBAL = Word32 -> H5F_scope_t
H5F_scope_t (Word32
1)

{-# LINE 94 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Unlimited file size for 'h5p_set_external'
h5f_UNLIMITED :: HSize_t
h5f_UNLIMITED :: HSize_t
h5f_UNLIMITED = Word64 -> HSize_t
HSize_t (Word64
18446744073709551615)

{-# LINE 97 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |How does file close behave?
newtype H5F_close_degree_t = H5F_close_degree_t Word32 deriving (Storable, Show, Eq)

{-# LINE 100 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Use the degree pre-defined by underlining VFL
h5f_CLOSE_DEFAULT :: H5F_close_degree_t
h5f_CLOSE_DEFAULT :: H5F_close_degree_t
h5f_CLOSE_DEFAULT = Word32 -> H5F_close_degree_t
H5F_close_degree_t (Word32
0)

{-# LINE 103 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |file closes only after all opened objects are closed
h5f_CLOSE_WEAK :: H5F_close_degree_t
h5f_CLOSE_WEAK :: H5F_close_degree_t
h5f_CLOSE_WEAK = Word32 -> H5F_close_degree_t
H5F_close_degree_t (Word32
1)

{-# LINE 106 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |if no opened objects, file is close; otherwise, file close fails
h5f_CLOSE_SEMI :: H5F_close_degree_t
h5f_CLOSE_SEMI :: H5F_close_degree_t
h5f_CLOSE_SEMI = Word32 -> H5F_close_degree_t
H5F_close_degree_t (Word32
2)

{-# LINE 109 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |if there are opened objects, close them first, then close file
h5f_CLOSE_STRONG :: H5F_close_degree_t
h5f_CLOSE_STRONG :: H5F_close_degree_t
h5f_CLOSE_STRONG = Word32 -> H5F_close_degree_t
H5F_close_degree_t (Word32
3)

{-# LINE 112 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


-- |Types of allocation requests. The values larger than 'h5fd_MEM_DEFAULT'
-- should not change other than adding new types to the end. These numbers
-- might appear in files.
newtype H5F_mem_t = H5F_mem_t Int32 deriving (Ptr H5F_mem_t -> IO H5F_mem_t
Ptr H5F_mem_t -> Int -> IO H5F_mem_t
Ptr H5F_mem_t -> Int -> H5F_mem_t -> IO ()
Ptr H5F_mem_t -> H5F_mem_t -> IO ()
H5F_mem_t -> Int
(H5F_mem_t -> Int)
-> (H5F_mem_t -> Int)
-> (Ptr H5F_mem_t -> Int -> IO H5F_mem_t)
-> (Ptr H5F_mem_t -> Int -> H5F_mem_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5F_mem_t)
-> (forall b. Ptr b -> Int -> H5F_mem_t -> IO ())
-> (Ptr H5F_mem_t -> IO H5F_mem_t)
-> (Ptr H5F_mem_t -> H5F_mem_t -> IO ())
-> Storable H5F_mem_t
forall b. Ptr b -> Int -> IO H5F_mem_t
forall b. Ptr b -> Int -> H5F_mem_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 :: H5F_mem_t -> Int
sizeOf :: H5F_mem_t -> Int
$calignment :: H5F_mem_t -> Int
alignment :: H5F_mem_t -> Int
$cpeekElemOff :: Ptr H5F_mem_t -> Int -> IO H5F_mem_t
peekElemOff :: Ptr H5F_mem_t -> Int -> IO H5F_mem_t
$cpokeElemOff :: Ptr H5F_mem_t -> Int -> H5F_mem_t -> IO ()
pokeElemOff :: Ptr H5F_mem_t -> Int -> H5F_mem_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5F_mem_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5F_mem_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5F_mem_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5F_mem_t -> IO ()
$cpeek :: Ptr H5F_mem_t -> IO H5F_mem_t
peek :: Ptr H5F_mem_t -> IO H5F_mem_t
$cpoke :: Ptr H5F_mem_t -> H5F_mem_t -> IO ()
poke :: Ptr H5F_mem_t -> H5F_mem_t -> IO ()
Storable, Int -> H5F_mem_t -> ShowS
[H5F_mem_t] -> ShowS
H5F_mem_t -> String
(Int -> H5F_mem_t -> ShowS)
-> (H5F_mem_t -> String)
-> ([H5F_mem_t] -> ShowS)
-> Show H5F_mem_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5F_mem_t -> ShowS
showsPrec :: Int -> H5F_mem_t -> ShowS
$cshow :: H5F_mem_t -> String
show :: H5F_mem_t -> String
$cshowList :: [H5F_mem_t] -> ShowS
showList :: [H5F_mem_t] -> ShowS
Show, H5F_mem_t -> H5F_mem_t -> Bool
(H5F_mem_t -> H5F_mem_t -> Bool)
-> (H5F_mem_t -> H5F_mem_t -> Bool) -> Eq H5F_mem_t
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H5F_mem_t -> H5F_mem_t -> Bool
== :: H5F_mem_t -> H5F_mem_t -> Bool
$c/= :: H5F_mem_t -> H5F_mem_t -> Bool
/= :: H5F_mem_t -> H5F_mem_t -> Bool
Eq)

{-# LINE 118 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Data should not appear in the free list.
-- Must be negative.
h5fd_MEM_NOLIST :: H5F_mem_t
h5fd_MEM_NOLIST :: H5F_mem_t
h5fd_MEM_NOLIST = Int32 -> H5F_mem_t
H5F_mem_t (-Int32
1)

{-# LINE 121 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Value not yet set.  Can also be the
-- datatype set in a larger allocation
-- that will be suballocated by the library.
-- Must be zero.
h5fd_MEM_DEFAULT :: H5F_mem_t
h5fd_MEM_DEFAULT :: H5F_mem_t
h5fd_MEM_DEFAULT = Int32 -> H5F_mem_t
H5F_mem_t (Int32
0)

{-# LINE 126 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Superblock data
h5fd_MEM_SUPER :: H5F_mem_t
h5fd_MEM_SUPER = H5F_mem_t (1)

{-# LINE 128 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |B-tree data
h5fd_MEM_BTREE :: H5F_mem_t
h5fd_MEM_BTREE = H5F_mem_t (2)

{-# LINE 130 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Raw data (content of datasets, etc.)
h5fd_MEM_DRAW :: H5F_mem_t
h5fd_MEM_DRAW = H5F_mem_t (3)

{-# LINE 132 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Global heap data
h5fd_MEM_GHEAP :: H5F_mem_t
h5fd_MEM_GHEAP = H5F_mem_t (4)

{-# LINE 134 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Local heap data
h5fd_MEM_LHEAP :: H5F_mem_t
h5fd_MEM_LHEAP = H5F_mem_t (5)

{-# LINE 136 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Object header data
h5fd_MEM_OHDR :: H5F_mem_t
h5fd_MEM_OHDR = H5F_mem_t (6)

{-# LINE 138 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
-- |Sentinel value - must be last
h5fd_MEM_NTYPES = 7
h5fd_MEM_NTYPES :: (Num a) => a

{-# LINE 140 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


-- |Library's file format versions
newtype H5F_libver_t = H5F_libver_t Int32 deriving (Ptr H5F_libver_t -> IO H5F_libver_t
Ptr H5F_libver_t -> Int -> IO H5F_libver_t
Ptr H5F_libver_t -> Int -> H5F_libver_t -> IO ()
Ptr H5F_libver_t -> H5F_libver_t -> IO ()
H5F_libver_t -> Int
(H5F_libver_t -> Int)
-> (H5F_libver_t -> Int)
-> (Ptr H5F_libver_t -> Int -> IO H5F_libver_t)
-> (Ptr H5F_libver_t -> Int -> H5F_libver_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5F_libver_t)
-> (forall b. Ptr b -> Int -> H5F_libver_t -> IO ())
-> (Ptr H5F_libver_t -> IO H5F_libver_t)
-> (Ptr H5F_libver_t -> H5F_libver_t -> IO ())
-> Storable H5F_libver_t
forall b. Ptr b -> Int -> IO H5F_libver_t
forall b. Ptr b -> Int -> H5F_libver_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 :: H5F_libver_t -> Int
sizeOf :: H5F_libver_t -> Int
$calignment :: H5F_libver_t -> Int
alignment :: H5F_libver_t -> Int
$cpeekElemOff :: Ptr H5F_libver_t -> Int -> IO H5F_libver_t
peekElemOff :: Ptr H5F_libver_t -> Int -> IO H5F_libver_t
$cpokeElemOff :: Ptr H5F_libver_t -> Int -> H5F_libver_t -> IO ()
pokeElemOff :: Ptr H5F_libver_t -> Int -> H5F_libver_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5F_libver_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5F_libver_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5F_libver_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5F_libver_t -> IO ()
$cpeek :: Ptr H5F_libver_t -> IO H5F_libver_t
peek :: Ptr H5F_libver_t -> IO H5F_libver_t
$cpoke :: Ptr H5F_libver_t -> H5F_libver_t -> IO ()
poke :: Ptr H5F_libver_t -> H5F_libver_t -> IO ()
Storable, Int -> H5F_libver_t -> ShowS
[H5F_libver_t] -> ShowS
H5F_libver_t -> String
(Int -> H5F_libver_t -> ShowS)
-> (H5F_libver_t -> String)
-> ([H5F_libver_t] -> ShowS)
-> Show H5F_libver_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5F_libver_t -> ShowS
showsPrec :: Int -> H5F_libver_t -> ShowS
$cshow :: H5F_libver_t -> String
show :: H5F_libver_t -> String
$cshowList :: [H5F_libver_t] -> ShowS
showList :: [H5F_libver_t] -> ShowS
Show)

{-# LINE 144 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Use the earliest possible format for storing objects
h5f_LIBVER_EARLIEST :: H5F_libver_t
h5f_LIBVER_EARLIEST :: H5F_libver_t
h5f_LIBVER_EARLIEST = Int32 -> H5F_libver_t
H5F_libver_t (Int32
0)

{-# LINE 147 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Use the latest possible format available for storing objects
h5f_LIBVER_LATEST :: H5F_libver_t
h5f_LIBVER_LATEST :: H5F_libver_t
h5f_LIBVER_LATEST = Int32 -> H5F_libver_t
H5F_libver_t (Int32
4)

{-# LINE 150 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- * Public functions

-- |Check the file signature to detect an HDF5 file.
--
-- [Bugs:] This function is not robust: it only uses the default file
--         driver when attempting to open the file when in fact it
--         should use all known file drivers.
--
-- > htri_t H5Fis_hdf5(const char *filename);
foreign import ccall "H5Fis_hdf5" h5f_is_hdf5
  :: CString -> IO HTri_t
foreign import ccall "&H5Fis_hdf5" p_H5Fis_hdf5
  :: FunPtr (CString -> IO HTri_t)

{-# LINE 161 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |This is the primary function for creating HDF5 files. The
-- 'flags' parameter determines whether an existing file will be
-- overwritten or not.  All newly created files are opened for
-- both reading and writing.  All flags may be combined with the
-- bit-wise OR operator (@ .|. @ from "Data.Bits") to change the
-- behavior of the file create call.
--
-- The more complex behaviors of a file's creation and access
-- are controlled through the file-creation and file-access
-- property lists.  The value of 'h5p_DEFAULT' for a template
-- value indicates that the library should use the default
-- values for the appropriate template.
--
-- See also: "Bindings.HDF5.Raw.H5F" for the list of supported flags.
-- "Bindings.HDF5.Raw.H5P" for the list of file creation and file
-- access properties.
--
-- On success, returns a file ID.  On failure, returns a negative value.
--
-- > hid_t  H5Fcreate(const char *filename, unsigned flags,
-- >        hid_t create_plist, hid_t access_plist);
foreign import ccall "H5Fcreate" h5f_create
  :: CString -> CUInt -> HId_t -> HId_t -> IO HId_t
foreign import ccall "&H5Fcreate" p_H5Fcreate
  :: FunPtr (CString -> CUInt -> HId_t -> HId_t -> IO HId_t)

{-# LINE 184 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |This is the primary function for accessing existing HDF5
-- files.  The 'flags' argument determines whether writing to an
-- existing file will be allowed or not.  All flags may be
-- combined with the bit-wise OR operator (@ .|. @ from "Data.Bits")
-- to change the behavior of the file open call.  The more complex
-- behaviors of a file's access are controlled through the file-access
-- property list.
--
-- See Also: "Bindings.HDF5.Raw.H5F" for a list of possible values for 'flags'.
--
-- On success, returns a file ID.  On failure, returns a negative value.
--
-- > hid_t  H5Fopen(const char *filename, unsigned flags,
-- >        hid_t access_plist);
foreign import ccall "H5Fopen" h5f_open
  :: CString -> CUInt -> HId_t -> IO HId_t
foreign import ccall "&H5Fopen" p_H5Fopen
  :: FunPtr (CString -> CUInt -> HId_t -> IO HId_t)

{-# LINE 200 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Reopen a file.  The new file handle which is returned points
-- to the same file as the specified file handle.  Both handles
-- share caches and other information.  The only difference
-- between the handles is that the new handle is not mounted
-- anywhere and no files are mounted on it.
--
-- On success, returns a file ID.  On failure, returns a negative value.
--
-- > hid_t  H5Freopen(hid_t file_id);
foreign import ccall "H5Freopen" h5f_reopen
  :: HId_t -> IO HId_t
foreign import ccall "&H5Freopen" p_H5Freopen
  :: FunPtr (HId_t -> IO HId_t)

{-# LINE 211 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Flushes all outstanding buffers of a file to disk but does
-- not remove them from the cache.  The 'object_id' can be a file,
-- dataset, group, attribute, or named data type.
--
-- Returns non-negative on success / negative on failure
--
-- > herr_t H5Fflush(hid_t object_id, H5F_scope_t scope);
foreign import ccall "H5Fflush" h5f_flush
  :: HId_t -> H5F_scope_t -> IO HErr_t
foreign import ccall "&H5Fflush" p_H5Fflush
  :: FunPtr (HId_t -> H5F_scope_t -> IO HErr_t)

{-# LINE 220 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |This function closes the file specified by 'file_id' by
-- flushing all data to storage, and terminating access to the
-- file through 'file_id'.  If objects (e.g., datasets, groups,
-- etc.) are open in the file then the underlying storage is not
-- closed until those objects are closed; however, all data for
-- the file and the open objects is flushed.
--
-- Returns non-negative on success / negative on failure
--
-- > herr_t H5Fclose(hid_t file_id);
foreign import ccall "H5Fclose" h5f_close
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Fclose" p_H5Fclose
  :: FunPtr (HId_t -> IO HErr_t)

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

-- |Get an atom for a copy of the file-creation property list for
-- this file. This function returns an atom with a copy of the
-- properties used to create a file.
--
-- On success, returns a template ID.
-- On failure, returns a negative value.
--
-- > hid_t  H5Fget_create_plist(hid_t file_id);
foreign import ccall "H5Fget_create_plist" h5f_get_create_plist
  :: HId_t -> IO HId_t
foreign import ccall "&H5Fget_create_plist" p_H5Fget_create_plist
  :: FunPtr (HId_t -> IO HId_t)

{-# LINE 242 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Returns a copy of the file access property list of the
-- specified file.
--
-- NOTE: If you are going to overwrite information in the copied
-- property list that was previously opened and assigned to the
-- property list, then you must close it before overwriting the values.
--
-- On success, returns an Object ID for a copy of the file access
-- property list.  On failure, returns a negative value.
--
-- > hid_t  H5Fget_access_plist(hid_t file_id);
foreign import ccall "H5Fget_access_plist" h5f_get_access_plist
  :: HId_t -> IO HId_t
foreign import ccall "&H5Fget_access_plist" p_H5Fget_access_plist
  :: FunPtr (HId_t -> IO HId_t)

{-# LINE 255 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Public API to retrieve the file's 'intent' flags passed
-- during 'h5f_open'.
--
-- Returns non-negative on success / negative on failure
--
-- > herr_t H5Fget_intent(hid_t file_id, unsigned * intent);
foreign import ccall "H5Fget_intent" h5f_get_intent
  :: HId_t -> Out CUInt -> IO HErr_t
foreign import ccall "&H5Fget_intent" p_H5Fget_intent
  :: FunPtr (HId_t -> Out CUInt -> IO HErr_t)

{-# LINE 263 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Returns the number of opened object IDs (files, datasets, groups
-- and datatypes) in the same file.
--
-- Returns non-negative on success, negative on failure.
--
-- > ssize_t H5Fget_obj_count(hid_t file_id, unsigned types);
foreign import ccall "H5Fget_obj_count" h5f_get_obj_count
  :: HId_t -> CUInt -> IO CSSize
foreign import ccall "&H5Fget_obj_count" p_H5Fget_obj_count
  :: FunPtr (HId_t -> CUInt -> IO CSSize)

{-# LINE 271 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Returns a list of opened object IDs.
--
-- Returns non-negative on success, negative on failure
--
-- > ssize_t H5Fget_obj_ids(hid_t file_id, unsigned types, size_t max_objs, hid_t *obj_id_list);
foreign import ccall "H5Fget_obj_ids" h5f_get_obj_ids
  :: HId_t -> CUInt -> CSize -> OutArray HId_t -> IO CSSize
foreign import ccall "&H5Fget_obj_ids" p_H5Fget_obj_ids
  :: FunPtr (HId_t -> CUInt -> CSize -> OutArray HId_t -> IO CSSize)

{-# LINE 278 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Returns a pointer to the file handle of the low-level file driver.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fget_vfd_handle(hid_t file_id, hid_t fapl, void **file_handle);
foreign import ccall "H5Fget_vfd_handle" h5f_get_vfd_handle
  :: HId_t -> HId_t -> Out (Ptr CFile) -> IO HErr_t
foreign import ccall "&H5Fget_vfd_handle" p_H5Fget_vfd_handle
  :: FunPtr (HId_t -> HId_t -> Out (Ptr CFile) -> IO HErr_t)

{-# LINE 285 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Mount file 'child_id' onto the group specified by 'loc_id' and
-- 'name' using mount properties 'plist_id'.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fmount(hid_t loc, const char *name, hid_t child, hid_t plist);
foreign import ccall "H5Fmount" h5f_mount
  :: HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Fmount" p_H5Fmount
  :: FunPtr (HId_t -> CString -> HId_t -> HId_t -> IO HErr_t)

{-# LINE 293 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Given a mount point, dissassociate the mount point's file
-- from the file mounted there.  Do not close either file.
--
-- The mount point can either be the group in the parent or the
-- root group of the mounted file (both groups have the same
-- name).  If the mount point was opened before the mount then
-- it's the group in the parent, but if it was opened after the
-- mount then it's the root group of the child.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Funmount(hid_t loc, const char *name);
foreign import ccall "H5Funmount" h5f_unmount
  :: HId_t -> CString -> IO HErr_t
foreign import ccall "&H5Funmount" p_H5Funmount
  :: FunPtr (HId_t -> CString -> IO HErr_t)

{-# LINE 307 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Retrieves the amount of free space in the file.
-- Returns a negative value on failure.
--
-- hssize_t H5Fget_freespace(hid_t file_id);
foreign import ccall "H5Fget_freespace" h5f_get_freespace
  :: HId_t -> IO HSSize_t
foreign import ccall "&H5Fget_freespace" p_H5Fget_freespace
  :: FunPtr (HId_t -> IO HSSize_t)

{-# LINE 313 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Retrieves the file size of the HDF5 file. This function
-- is called after an existing file is opened in order
-- to learn the true size of the underlying file.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fget_filesize(hid_t file_id, hsize_t *size);
foreign import ccall "H5Fget_filesize" h5f_get_filesize
  :: HId_t -> Out HSize_t -> IO HErr_t
foreign import ccall "&H5Fget_filesize" p_H5Fget_filesize
  :: FunPtr (HId_t -> Out HSize_t -> IO HErr_t)

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

-- |If a buffer is provided (via the buf_ptr argument) and is
-- big enough (size in buf_len argument), load *buf_ptr with
-- an image of the open file whose ID is provided in the
-- file_id parameter, and return the number of bytes copied
-- to the buffer.
--
-- If the buffer exists, but is too small to contain an image
-- of the indicated file, return a negative number.
--
-- Finally, if no buffer is provided, return the size of the
-- buffer needed.  This value is simply the eoa of the target
-- file.
--
-- Note that any user block is skipped.
--
-- Also note that the function may not be used on files
-- opened with either the split/multi file driver or the
-- family file driver.
--
-- In the former case, the sparse address space makes the
-- get file image operation impractical, due to the size of
-- the image typically required.
--
-- In the case of the family file driver, the problem is
-- the driver message in the super block, which will prevent
-- the image being opened with any driver other than the
-- family file driver -- which negates the purpose of the
-- operation.  This can be fixed, but no resources for
-- this now.
--
-- Return:      Success:        Bytes copied / number of bytes needed.
--              Failure:        negative value
--
-- > ssize_t H5Fget_file_image(hid_t file_id, void * buf_ptr, size_t buf_len);
foreign import ccall "H5Fget_file_image" h5f_get_file_image
  :: HId_t -> InArray a -> CSize -> IO CSSize
foreign import ccall "&H5Fget_file_image" p_H5Fget_file_image
  :: FunPtr (HId_t -> InArray a -> CSize -> IO CSSize)

{-# LINE 358 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Retrieves the current automatic cache resize configuration
-- from the metadata cache, and return it in 'config_ptr'.
--
-- Note that the 'version' field of 'config_ptr' must be correctly
-- filled in by the caller.  This allows us to adapt for
-- obsolete versions of the structure.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fget_mdc_config(hid_t file_id,
-- >        H5AC_cache_config_t * config_ptr);
foreign import ccall "H5Fget_mdc_config" h5f_get_mdc_config
  :: HId_t -> Out H5AC_cache_config_t -> IO HErr_t
foreign import ccall "&H5Fget_mdc_config" p_H5Fget_mdc_config
  :: FunPtr (HId_t -> Out H5AC_cache_config_t -> IO HErr_t)

{-# LINE 371 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Sets the current metadata cache automatic resize
-- configuration, using the contents of the instance of
-- 'H5AC_cache_config_t' pointed to by 'config_ptr'.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fset_mdc_config(hid_t file_id,
-- >        H5AC_cache_config_t * config_ptr);
foreign import ccall "H5Fset_mdc_config" h5f_set_mdc_config
  :: HId_t -> In H5AC_cache_config_t -> IO HErr_t
foreign import ccall "&H5Fset_mdc_config" p_H5Fset_mdc_config
  :: FunPtr (HId_t -> In H5AC_cache_config_t -> IO HErr_t)

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

-- |Retrieves the current hit rate from the metadata cache.
-- This rate is the overall hit rate since the last time
-- the hit rate statistics were reset either manually or
-- automatically.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fget_mdc_hit_rate(hid_t file_id, double * hit_rate_ptr);
foreign import ccall "H5Fget_mdc_hit_rate" h5f_get_mdc_hit_rate
  :: HId_t -> Out CDouble -> IO HErr_t
foreign import ccall "&H5Fget_mdc_hit_rate" p_H5Fget_mdc_hit_rate
  :: FunPtr (HId_t -> Out CDouble -> IO HErr_t)

{-# LINE 391 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Retrieves the maximum size, minimum clean size, current
-- size, and current number of entries from the metadata
-- cache associated with the specified file.  If any of
-- the ptr parameters are NULL, the associated datum is
-- not returned.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fget_mdc_size(hid_t file_id,
-- >        size_t * max_size_ptr,
-- >        size_t * min_clean_size_ptr,
-- >        size_t * cur_size_ptr,
-- >        int * cur_num_entries_ptr);
foreign import ccall "H5Fget_mdc_size" h5f_get_mdc_size
  :: HId_t -> Out CSize -> Out CSize -> Out CSize -> Out CInt -> IO HErr_t
foreign import ccall "&H5Fget_mdc_size" p_H5Fget_mdc_size
  :: FunPtr (HId_t -> Out CSize -> Out CSize -> Out CSize -> Out CInt -> IO HErr_t)

{-# LINE 406 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Reset the hit rate statistic whose current value can
-- be obtained via the 'h5f_get_mdc_hit_rate' call.  Note
-- that this statistic will also be reset once per epoch
-- by the automatic cache resize code if it is enabled.
--
-- It is probably a bad idea to call this function unless
-- you are controlling cache size from your program instead
-- of using our cache size control code.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Freset_mdc_hit_rate_stats(hid_t file_id);
foreign import ccall "H5Freset_mdc_hit_rate_stats" h5f_reset_mdc_hit_rate_stats
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Freset_mdc_hit_rate_stats" p_H5Freset_mdc_hit_rate_stats
  :: FunPtr (HId_t -> IO HErr_t)

{-# LINE 420 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Gets the name of the file to which object OBJ_ID belongs.
-- If 'name' is non-NULL then write up to 'size' bytes into that
-- buffer and always return the length of the entry name.
-- Otherwise 'size' is ignored and the function does not store the name,
-- just returning the number of characters required to store the name.
-- If an error occurs then the buffer pointed to by 'name' (NULL or non-NULL)
-- is unchanged and the function returns a negative value.
--
-- Note:  This routine returns the name that was used to open the file,
-- not the actual name after resolving symlinks, etc.
--
-- Returns the length of the file name (_not_ the length of the data
-- copied into the output buffer) on success, or a negative value on failure.
--
-- > ssize_t H5Fget_name(hid_t obj_id, char *name, size_t size);
foreign import ccall "H5Fget_name" h5f_get_name
  :: HId_t -> OutArray CChar -> CSize -> IO CSSize
foreign import ccall "&H5Fget_name" p_H5Fget_name
  :: FunPtr (HId_t -> OutArray CChar -> CSize -> IO CSSize)

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

-- |#. Get storage size for superblock extension if there is one
--
--  #. Get the amount of btree and heap storage for entries in the SOHM table if there is one.
--
--  #. Consider success when there is no superblock extension and/or SOHM table
--
-- Returns non-negative on success, negative on failure
--
-- |Releases the external file cache associated with the
-- provided file, potentially closing any cached files
-- unless they are held open from somewhere else.
--
-- Returns non-negative on success, negative on failure
--
-- > herr_t H5Fclear_elink_file_cache(hid_t file_id);
foreign import ccall "H5Fclear_elink_file_cache" h5f_clear_elink_file_cache
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Fclear_elink_file_cache" p_H5Fclear_elink_file_cache
  :: FunPtr (HId_t -> IO HErr_t)

{-# LINE 454 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


{-# LINE 470 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |indicate that this file is open for writing in a
-- single-writer/multi-reader (SWMR) scenario.  Note that the
-- process(es) opening the file for reading must open the file with
-- RDONLY access, and use the special "SWMR_READ" access flag.
h5f_ACC_SWMR_WRITE :: forall a. Num a => a
h5f_ACC_SWMR_WRITE = a
32
h5f_ACC_SWMR_WRITE :: (Num a) => a

{-# LINE 476 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |indicate that this file is open for reading in a
-- single-writer/multi-reader (SWMR) scenario.  Note that the
-- process(es) opening the file for SWMR reading must also open the
-- file with the RDONLY flag.  */
h5f_ACC_SWMR_READ :: forall a. Num a => a
h5f_ACC_SWMR_READ = a
64
h5f_ACC_SWMR_READ :: (Num a) => a

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


{-# LINE 484 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 485 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 486 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 487 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
data H5F_info1_t = H5F_info1_t{
  h5f_info1_t'super_ext_size :: HSize_t,
  h5f_info1_t'sohm'hdr_size :: HSize_t,
  h5f_info1_t'sohm'msgs_info :: H5_ih_info_t
} deriving (Eq,Show)
p'H5F_info1_t'super_ext_size :: Ptr H5F_info1_t -> Ptr HSize_t
p'H5F_info1_t'super_ext_size Ptr H5F_info1_t
p = Ptr H5F_info1_t -> Int -> Ptr HSize_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5F_info1_t
p Int
0
p'H5F_info1_t'super_ext_size :: Ptr (H5F_info1_t) -> Ptr (HSize_t)
p'H5F_info1_t'sohm'hdr_size :: Ptr H5F_info1_t -> Ptr HSize_t
p'H5F_info1_t'sohm'hdr_size Ptr H5F_info1_t
p = Ptr H5F_info1_t -> Int -> Ptr HSize_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5F_info1_t
p Int
8
p'H5F_info1_t'sohm'hdr_size :: Ptr (H5F_info1_t) -> Ptr (HSize_t)
p'H5F_info1_t'sohm'msgs_info :: Ptr H5F_info1_t -> Ptr H5_ih_info_t
p'H5F_info1_t'sohm'msgs_info Ptr H5F_info1_t
p = Ptr H5F_info1_t -> Int -> Ptr H5_ih_info_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5F_info1_t
p Int
16
p'H5F_info1_t'sohm'msgs_info :: Ptr (H5F_info1_t) -> Ptr (H5_ih_info_t)
instance Storable H5F_info1_t where
  sizeOf _ = 32
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    v2 <- peekByteOff _p 16
    return $ H5F_info1_t v0 v1 v2
  poke _p (H5F_info1_t v0 v1 v2) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 8 v1
    pokeByteOff _p 16 v2
    return ()

{-# LINE 488 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


{-# LINE 490 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

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

{-# LINE 492 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 493 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 494 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 495 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 496 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

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

{-# LINE 498 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 499 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
data H5F_info2_t = H5F_info2_t{
  h5f_info2_t'super'version :: CUInt,
  h5f_info2_t'super'super_size :: HSize_t,
  h5f_info2_t'super'super_ext_size :: HSize_t,
  h5f_info2_t'free'version :: CUInt,
  h5f_info2_t'free'meta_size :: HSize_t,
  h5f_info2_t'free'tot_space :: HSize_t,
  h5f_info2_t'sohm'version :: CUInt,
  h5f_info2_t'sohm'hdr_size :: HSize_t,
  h5f_info2_t'sohm'msgs_info :: H5_ih_info_t
} deriving (Eq,Show)
p'H5F_info2_t'super'version p = plusPtr p 0
p'H5F_info2_t'super'version :: Ptr (H5F_info2_t) -> Ptr (CUInt)
p'H5F_info2_t'super'super_size p = plusPtr p 8
p'H5F_info2_t'super'super_size :: Ptr (H5F_info2_t) -> Ptr (HSize_t)
p'H5F_info2_t'super'super_ext_size :: Ptr H5F_info2_t -> Ptr HSize_t
p'H5F_info2_t'super'super_ext_size Ptr H5F_sect_info_t
Ptr H5F_info2_t
p :: Ptr H5F_sect_info_t
p :: Ptr H5F_info2_t
p Int
= Ptr H5F_info2_t -> Int -> Ptr HSize_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5F_info2_t
p Int
16
p'H5F_info2_t'super'super_ext_size :: Ptr (H5F_info2_t) -> Ptr (HSize_t)
p'H5F_info2_t'free'version :: Ptr H5F_info2_t -> Ptr CUInt
p'H5F_info2_t'free'version Ptr H5F_info2_t
p = plusPtr Ptr H5F_info2_t
p Int
24
p'H5F_info2_t'free'version :: Ptr (H5F_info2_t) -> Ptr (CUInt)
p'H5F_info2_t'free'meta_size :: Ptr H5F_info2_t -> Ptr HSize_t
p'H5F_info2_t'free'meta_size Ptr H5F_info2_t
p = Ptr H5F_info2_t -> Int -> Ptr HSize_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5F_info2_t
p Int
32
p'H5F_info2_t'free'meta_size :: Ptr (H5F_info2_t) -> Ptr (HSize_t)
p'H5F_info2_t'free'tot_space :: Ptr H5F_info2_t -> Ptr HSize_t
p'H5F_info2_t'free'tot_space Ptr H5F_info2_t
p = Ptr H5F_info2_t -> Int -> Ptr HSize_t
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr H5F_info2_t
p Int
40
p'H5F_info2_t'free'tot_space :: Ptr (H5F_info2_t) -> Ptr (HSize_t)
p'H5F_info2_t'sohm'version p = plusPtr p 48
p'H5F_info2_t'sohm'version :: Ptr (H5F_info2_t) -> Ptr (CUInt)
p'H5F_info2_t'sohm'hdr_size p = plusPtr p 56
p'H5F_info2_t'sohm'hdr_size :: Ptr (H5F_info2_t) -> Ptr (HSize_t)
p'H5F_info2_t'sohm'msgs_info p = plusPtr p 64
p'H5F_info2_t'sohm'msgs_info :: Ptr (H5F_info2_t) -> Ptr (H5_ih_info_t)
instance Storable H5F_info2_t where
  sizeOf _ = 80
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    v2 <- peekByteOff _p 16
    v3 <- peekByteOff _p 24
    v4 <- peekByteOff _p 32
    v5 <- peekByteOff _p 40
    v6 <- peekByteOff _p 48
    v7 <- peekByteOff _p 56
    v8 <- peekByteOff _p 64
    return $ H5F_info2_t v0 v1 v2 v3 v4 v5 v6 v7 v8
  poke _p (H5F_info2_t v0 v1 v2 v3 v4 v5 v6 v7 v8) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 8 v1
    pokeByteOff _p 16 v2
    pokeByteOff _p 24 v3
    pokeByteOff _p 32 v4
    pokeByteOff _p 40 v5
    pokeByteOff _p 48 v6
    pokeByteOff _p 56 v7
    pokeByteOff _p 64 v8
    return ()

{-# LINE 500 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Free space section information

{-# LINE 503 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Address of free space section

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

-- |Size of free space section

{-# LINE 509 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

data H5F_sect_info_t = H5F_sect_info_t{
  h5f_sect_info_t'addr :: HAddr_t,
  h5f_sect_info_t'size :: HSize_t
} deriving (Eq,Show)
p'H5F_sect_info_t'addr p = plusPtr p 0
p'H5F_sect_info_t'addr :: Ptr (H5F_sect_info_t) -> Ptr (HAddr_t)
p'H5F_sect_info_t'size p = plusPtr p 8
p'H5F_sect_info_t'size :: Ptr (H5F_sect_info_t) -> Ptr (HSize_t)
instance Storable H5F_sect_info_t where
  sizeOf _ = 16
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    return $ H5F_sect_info_t v0 v1
  poke _p (H5F_sect_info_t v0 v1) = do
    pokeByteOff _p 0 v0
    pokeByteOff _p 8 v1
    return ()

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

-- |File space handling strategy
newtype H5F_file_space_type_t = H5F_file_space_type_t Word32 deriving (Storable, Show, Eq)

{-# LINE 514 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Default (or current) free space strategy setting
h5f_FILE_SPACE_DEFAULT :: H5F_file_space_type_t
h5f_FILE_SPACE_DEFAULT = H5F_file_space_type_t (0)

{-# LINE 517 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Persistent free space managers, aggregators, virtual file driver
h5f_FILE_SPACE_ALL_PERSIST :: H5F_file_space_type_t
h5f_FILE_SPACE_ALL_PERSIST = H5F_file_space_type_t (1)

{-# LINE 520 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Non-persistent free space managers, aggregators, virtual file driver
-- This is the library default
h5f_FILE_SPACE_ALL :: H5F_file_space_type_t
h5f_FILE_SPACE_ALL = H5F_file_space_type_t (2)

{-# LINE 524 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- |Aggregators, Virtual file driver
h5f_FILE_SPACE_AGGR_VFD :: H5F_file_space_type_t
h5f_FILE_SPACE_AGGR_VFD = H5F_file_space_type_t (3)

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

-- |Virtual file driver
h5f_FILE_SPACE_VFD :: H5F_file_space_type_t
h5f_FILE_SPACE_VFD = H5F_file_space_type_t (4)

{-# LINE 530 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

h5f_FILE_SPACE_NTYPES = 5
h5f_FILE_SPACE_NTYPES :: (Num a) => a

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

-- | Data structure to report the collection of read retries for metadata items with checksum
-- Used by public routine H5Fget_metadata_read_retry_info()
-- TODO check the retries static array
h5f_NUM_METADATA_READ_RETRY_TYPES = 21
h5f_NUM_METADATA_READ_RETRY_TYPES :: (Num a) => a

{-# LINE 537 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


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

{-# LINE 540 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 541 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
data H5F_retry_info_t = H5F_retry_info_t{
  h5f_retry_info_t'nbins :: CUInt,
  h5f_retry_info_t'retries :: Ptr Word32
} deriving (Eq,Show)
p'H5F_retry_info_t'nbins p = plusPtr p 0
p'H5F_retry_info_t'nbins :: Ptr (H5F_retry_info_t) -> Ptr (CUInt)
p'H5F_retry_info_t'retries p = plusPtr p 8
p'H5F_retry_info_t'retries :: Ptr (H5F_retry_info_t) -> Ptr (Ptr Word32)
instance Storable H5F_retry_info_t where
  sizeOf _ = 176
  alignment _ = 8
  peek _p = do
    v0 <- peekByteOff _p 0
    v1 <- peekByteOff _p 8
    return $ H5F_retry_info_t v0 v1
  poke :: Ptr H5F_retry_info_t -> H5F_retry_info_t -> IO ()
poke Ptr H5F_retry_info_t
_p (H5F_retry_info_t CUInt
v0 Ptr Word32
v1) = do
    Ptr H5F_retry_info_t -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5F_retry_info_t
_p Int
0 CUInt
v0
    Ptr H5F_retry_info_t -> Int -> Ptr Word32 -> IO ()
forall b. Ptr b -> Int -> Ptr Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr H5F_retry_info_t
_p Int
8 Ptr Word32
v1
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 542 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

type H5F_flush_cb_t a = FunPtr (HId_t -> InOut a -> IO HErr_t)

foreign import ccall "H5Fformat_convert" h5f_format_convert
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Fformat_convert" p_H5Fformat_convert
  :: FunPtr (HId_t -> IO HErr_t)

{-# LINE 546 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fget_mdc_logging_status" h5f_get_mdc_logging_status
  :: HId_t -> Out hbool_t -> Out hbool_t -> IO HErr_t
foreign import ccall "&H5Fget_mdc_logging_status" p_H5Fget_mdc_logging_status
  :: FunPtr (HId_t -> Out hbool_t -> Out hbool_t -> IO HErr_t)

{-# LINE 547 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fget_metadata_read_retry_info" h5f_get_metadata_read_retry_info
  :: HId_t -> Out H5F_retry_info_t -> IO HErr_t
foreign import ccall "&H5Fget_metadata_read_retry_info" p_H5Fget_metadata_read_retry_info
  :: FunPtr (HId_t -> Out H5F_retry_info_t -> IO HErr_t)

{-# LINE 548 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fget_free_sections" h5f_get_free_sections
  :: HId_t -> H5F_mem_t -> CSize -> Out H5F_sect_info_t -> IO CSSize
foreign import ccall "&H5Fget_free_sections" p_H5Fget_free_sections
  :: FunPtr (HId_t -> H5F_mem_t -> CSize -> Out H5F_sect_info_t -> IO CSSize)

{-# LINE 549 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fstart_mdc_logging" h5f_start_mdc_logging
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Fstart_mdc_logging" p_H5Fstart_mdc_logging
  :: FunPtr (HId_t -> IO HErr_t)

{-# LINE 550 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fstart_swmr_write" h5f_start_swmr_write
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Fstart_swmr_write" p_H5Fstart_swmr_write
  :: FunPtr (HId_t -> IO HErr_t)

{-# LINE 551 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fstop_mdc_logging" h5f_stop_mdc_logging
  :: HId_t -> IO HErr_t
foreign import ccall "&H5Fstop_mdc_logging" p_H5Fstop_mdc_logging
  :: FunPtr (HId_t -> IO HErr_t)

{-# LINE 552 "src/Bindings/HDF5/Raw/H5F.hsc" #-}


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


-- H5F_info_t


{-# LINE 562 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
type H5F_info_t = H5F_info1_t

{-# LINE 563 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 568 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

-- H5Fget_info


{-# LINE 572 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fget_info1" h5f_get_info1
  :: HId_t -> Out H5F_info1_t -> IO HErr_t
foreign import ccall "&H5Fget_info1" p_H5Fget_info1
  :: FunPtr (HId_t -> Out H5F_info1_t -> IO HErr_t)

{-# LINE 573 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
foreign import ccall "H5Fget_info2" h5f_get_info2
  :: HId_t -> Out H5F_info2_t -> IO HErr_t
foreign import ccall "&H5Fget_info2" p_H5Fget_info2
  :: FunPtr (HId_t -> Out H5F_info2_t -> IO HErr_t)

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

{-# LINE 575 "src/Bindings/HDF5/Raw/H5F.hsc" #-}
h5f_get_info :: HId_t -> Out H5F_info1_t -> IO HErr_t
h5f_get_info = h5f_get_info1

{-# LINE 583 "src/Bindings/HDF5/Raw/H5F.hsc" #-}

{-# LINE 588 "src/Bindings/HDF5/Raw/H5F.hsc" #-}