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



-- |Implements a family of files that acts as a single hdf5
-- file.  The purpose is to be able to split a huge file on a
-- 64-bit platform, transfer all the <2GB members to a 32-bit
-- platform, and then access the entire huge file on the 32-bit
-- platform.
--
-- All family members are logically the same size although their
-- physical sizes may vary.  The logical member size is
-- determined by looking at the physical size of the first member
-- when the file is opened.  When creating a file family, the
-- first member is created with a predefined physical size
-- (actually, this happens when the file family is flushed, and
-- can be quite time consuming on file systems that don't
-- implement holes, like nfs).
module Bindings.HDF5.Raw.H5FD.Family where

import System.IO.Unsafe (unsafePerformIO)

import Foreign.Ptr

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

h5fd_FAMILY
{-# LINE 29 "src/Bindings/HDF5/Raw/H5FD/Family.hsc" #-}
  :: HId_t
h5fd_FAMILY :: HId_t
h5fd_FAMILY
{-# LINE 31 "src/Bindings/HDF5/Raw/H5FD/Family.hsc" #-}
    = unsafePerformIO (h5fd_family_init)
{-# LINE 32 "src/Bindings/HDF5/Raw/H5FD/Family.hsc" #-}

-- |Initialize this driver by registering the driver with the library.
--
-- > hid_t H5FD_family_init(void);
foreign import ccall "H5FD_family_init" h5fd_family_init
  :: IO HId_t
foreign import ccall "&H5FD_family_init" p_H5FD_family_init
  :: FunPtr (IO HId_t)

{-# LINE 37 "src/Bindings/HDF5/Raw/H5FD/Family.hsc" #-}


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

-- |Sets the file access property list 'fapl_id' to use the family
-- driver. The 'memb_size' is the size in bytes of each file
-- member (used only when creating a new file) and the
-- 'memb_fapl_id' is a file access property list to be used for
-- each family member.
--
-- > herr_t H5Pset_fapl_family(hid_t fapl_id, hsize_t memb_size,
-- >        hid_t memb_fapl_id);
foreign import ccall "H5Pset_fapl_family" h5p_set_fapl_family
  :: HId_t -> HSize_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Pset_fapl_family" p_H5Pset_fapl_family
  :: FunPtr (HId_t -> HSize_t -> HId_t -> IO HErr_t)

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

-- |Returns information about the family file access property
-- list though the function arguments.
--
-- > herr_t H5Pget_fapl_family(hid_t fapl_id, hsize_t *memb_size/*out*/,
-- >        hid_t *memb_fapl_id/*out*/);
foreign import ccall "H5Pget_fapl_family" h5p_get_fapl_family
  :: HId_t -> Out HSize_t -> Out HId_t -> IO HErr_t
foreign import ccall "&H5Pget_fapl_family" p_H5Pget_fapl_family
  :: FunPtr (HId_t -> Out HSize_t -> Out HId_t -> IO HErr_t)

{-# LINE 61 "src/Bindings/HDF5/Raw/H5FD/Family.hsc" #-}