{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Bindings.HDF5.PropertyList.DAPL
    ( module Bindings.HDF5.PropertyList.LAPL

    , DAPL
    , DatasetAccessPropertyList

    , setChunkCache
    , getChunkCache
    ) where

import Bindings.HDF5.Core
import Bindings.HDF5.Error
import Bindings.HDF5.PropertyList.LAPL
import Bindings.HDF5.Raw.H5P
import Foreign.C.Types
import Foreign.Ptr.Conventions

newtype DAPL = DAPL LAPL
    deriving (DAPL -> DAPL -> Bool
(DAPL -> DAPL -> Bool) -> (DAPL -> DAPL -> Bool) -> Eq DAPL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DAPL -> DAPL -> Bool
== :: DAPL -> DAPL -> Bool
$c/= :: DAPL -> DAPL -> Bool
/= :: DAPL -> DAPL -> Bool
Eq, DAPL -> HId_t
(DAPL -> HId_t) -> HId DAPL
forall t. (t -> HId_t) -> HId t
$chid :: DAPL -> HId_t
hid :: DAPL -> HId_t
HId, HId_t -> DAPL
(HId_t -> DAPL) -> FromHId DAPL
forall t. (HId_t -> t) -> FromHId t
$cuncheckedFromHId :: HId_t -> DAPL
uncheckedFromHId :: HId_t -> DAPL
FromHId, DAPL -> Bool
(DAPL -> Bool) -> HDFResultType DAPL
forall t. (t -> Bool) -> HDFResultType t
$cisError :: DAPL -> Bool
isError :: DAPL -> Bool
HDFResultType, FromHId DAPL
HId DAPL
(HId DAPL, FromHId DAPL) => PropertyListOrClass DAPL
forall t. (HId t, FromHId t) => PropertyListOrClass t
PropertyListOrClass, PropertyList DAPL
PropertyList DAPL => LinkAccessPropertyList DAPL
forall t. PropertyList t => LinkAccessPropertyList t
LinkAccessPropertyList)

instance PropertyList DAPL where
    staticPlistClass :: Tagged DAPL PropertyListClassID
staticPlistClass = PropertyListClassID -> Tagged DAPL PropertyListClassID
forall {k} (s :: k) b. b -> Tagged s b
Tagged PropertyListClassID
datasetAccess

class LinkAccessPropertyList t => DatasetAccessPropertyList t where
instance DatasetAccessPropertyList DAPL

setChunkCache :: DatasetAccessPropertyList dapl => dapl -> CSize -> CSize -> CDouble -> IO ()
setChunkCache :: forall dapl.
DatasetAccessPropertyList dapl =>
dapl -> CSize -> CSize -> CDouble -> IO ()
setChunkCache dapl
dapl CSize
rdccNSlots CSize
rdccNBytes CDouble
rddcW0 =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (IO HErr_t -> IO ()) -> IO HErr_t -> IO ()
forall a b. (a -> b) -> a -> b
$
        HId_t -> CSize -> CSize -> CDouble -> IO HErr_t
h5p_set_chunk_cache (dapl -> HId_t
forall t. HId t => t -> HId_t
hid dapl
dapl) CSize
rdccNSlots CSize
rdccNBytes CDouble
rddcW0

getChunkCache :: DatasetAccessPropertyList dapl => dapl -> IO (CSize, CSize, CDouble)
getChunkCache :: forall dapl.
DatasetAccessPropertyList dapl =>
dapl -> IO (CSize, CSize, CDouble)
getChunkCache dapl
dapl =
    ((CSize, (CSize, CDouble)) -> (CSize, CSize, CDouble))
-> IO (CSize, (CSize, CDouble)) -> IO (CSize, CSize, CDouble)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CSize
a,(CSize
b,CDouble
c)) -> (CSize
a,CSize
b,CDouble
c)) (IO (CSize, (CSize, CDouble)) -> IO (CSize, CSize, CDouble))
-> IO (CSize, (CSize, CDouble)) -> IO (CSize, CSize, CDouble)
forall a b. (a -> b) -> a -> b
$
        (Out CSize -> IO (CSize, CDouble)) -> IO (CSize, (CSize, CDouble))
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m (a, b)
withOut ((Out CSize -> IO (CSize, CDouble))
 -> IO (CSize, (CSize, CDouble)))
-> (Out CSize -> IO (CSize, CDouble))
-> IO (CSize, (CSize, CDouble))
forall a b. (a -> b) -> a -> b
$ \Out CSize
rdccNSlots ->
            (Out CSize -> IO CDouble) -> IO (CSize, CDouble)
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m (a, b)
withOut ((Out CSize -> IO CDouble) -> IO (CSize, CDouble))
-> (Out CSize -> IO CDouble) -> IO (CSize, CDouble)
forall a b. (a -> b) -> a -> b
$ \Out CSize
rdccNBytes ->
                (Out CDouble -> IO ()) -> IO CDouble
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CDouble -> IO ()) -> IO CDouble)
-> (Out CDouble -> IO ()) -> IO CDouble
forall a b. (a -> b) -> a -> b
$ \Out CDouble
rddcW0 ->
                    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (IO HErr_t -> IO ()) -> IO HErr_t -> IO ()
forall a b. (a -> b) -> a -> b
$
                        HId_t -> Out CSize -> Out CSize -> Out CDouble -> IO HErr_t
h5p_get_chunk_cache (dapl -> HId_t
forall t. HId t => t -> HId_t
hid dapl
dapl) Out CSize
rdccNSlots Out CSize
rdccNBytes Out CDouble
rddcW0