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



-- |A driver which stores the HDF5 data in main memory using
-- only the HDF5 public API. This driver is useful for fast
-- access to small, temporary hdf5 files.
module Bindings.HDF5.Raw.H5FD.Core where

import Foreign.C.Types
import Foreign.Ptr
import System.IO.Unsafe (unsafePerformIO)

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

import Foreign.Ptr.Conventions

h5fd_CORE
{-# LINE 19 "src/Bindings/HDF5/Raw/H5FD/Core.hsc" #-}
  :: HId_t
h5fd_CORE :: HId_t
h5fd_CORE
{-# LINE 21 "src/Bindings/HDF5/Raw/H5FD/Core.hsc" #-}
    = unsafePerformIO (h5fd_core_init)
{-# LINE 22 "src/Bindings/HDF5/Raw/H5FD/Core.hsc" #-}

-- |Initialize this driver by registering the driver with the library.
--
-- > hid_t H5FD_core_init(void);x
foreign import ccall "H5FD_core_init" h5fd_core_init
  :: IO HId_t
foreign import ccall "&H5FD_core_init" p_H5FD_core_init
  :: FunPtr (IO HId_t)

{-# LINE 27 "src/Bindings/HDF5/Raw/H5FD/Core.hsc" #-}


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

-- |Modify the file access property list to use the H5FD_CORE
-- driver.  The 'increment' specifies how much to grow the memory
-- each time we need more.
--
-- > herr_t H5Pset_fapl_core(hid_t fapl_id, size_t increment,
-- >        hbool_t backing_store);
foreign import ccall "H5Pset_fapl_core" h5p_set_fapl_core
  :: HId_t -> CSize -> HBool_t -> IO HErr_t
foreign import ccall "&H5Pset_fapl_core" p_H5Pset_fapl_core
  :: FunPtr (HId_t -> CSize -> HBool_t -> IO HErr_t)

{-# LINE 42 "src/Bindings/HDF5/Raw/H5FD/Core.hsc" #-}

-- |Queries properties set by the H5Pset_fapl_core() function.
--
-- > herr_t H5Pget_fapl_core(hid_t fapl_id, size_t *increment/*out*/,
-- >        hbool_t *backing_store/*out*/);
foreign import ccall "H5Pget_fapl_core" h5p_get_fapl_core
  :: HId_t -> Out CSize -> Out HBool_t -> IO HErr_t
foreign import ccall "&H5Pget_fapl_core" p_H5Pget_fapl_core
  :: FunPtr (HId_t -> Out CSize -> Out HBool_t -> IO HErr_t)

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