{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Bindings.HDF5.PropertyList.GCPL
    ( module Bindings.HDF5.PropertyList.OCPL

    , GCPL
    , GroupCreationPropertyList

    , setLocalHeapSizeHint
    , getLocalHeapSizeHint

    , setLinkPhaseChange
    , getLinkPhaseChange

    , getEstLinkInfo
    , setEstLinkInfo

    , CreationOrder(..)
    , setLinkCreationOrder
    , getLinkCreationOrder
    ) where

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

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

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

class ObjectCreationPropertyList t => GroupCreationPropertyList t where
instance GroupCreationPropertyList GCPL

setLocalHeapSizeHint :: GroupCreationPropertyList gcpl => gcpl -> CSize -> IO ()
setLocalHeapSizeHint :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> CSize -> IO ()
setLocalHeapSizeHint gcpl
gcpl CSize
sz =
    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 -> IO HErr_t
h5p_set_local_heap_size_hint (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) CSize
sz

getLocalHeapSizeHint :: GroupCreationPropertyList gcpl => gcpl -> IO CSize
getLocalHeapSizeHint :: forall gcpl. GroupCreationPropertyList gcpl => gcpl -> IO CSize
getLocalHeapSizeHint gcpl
gcpl =
    (Out CSize -> IO ()) -> IO CSize
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CSize -> IO ()) -> IO CSize)
-> (Out CSize -> IO ()) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Out CSize
sz ->
        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 -> IO HErr_t
h5p_get_local_heap_size_hint (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) Out CSize
sz

setLinkPhaseChange :: GroupCreationPropertyList gcpl => gcpl -> CUInt -> CUInt -> IO ()
setLinkPhaseChange :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> CUInt -> CUInt -> IO ()
setLinkPhaseChange gcpl
gcpl CUInt
maxCompact CUInt
minDense =
    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 -> CUInt -> CUInt -> IO HErr_t
h5p_set_link_phase_change (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) CUInt
maxCompact CUInt
minDense

getLinkPhaseChange :: GroupCreationPropertyList gcpl => gcpl -> IO (CUInt, CUInt)
getLinkPhaseChange :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> IO (CUInt, CUInt)
getLinkPhaseChange gcpl
gcpl =
    (Out CUInt -> IO CUInt) -> IO (CUInt, CUInt)
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m (a, b)
withOut ((Out CUInt -> IO CUInt) -> IO (CUInt, CUInt))
-> (Out CUInt -> IO CUInt) -> IO (CUInt, CUInt)
forall a b. (a -> b) -> a -> b
$ \Out CUInt
maxCompact ->
        (Out CUInt -> IO ()) -> IO CUInt
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CUInt -> IO ()) -> IO CUInt)
-> (Out CUInt -> IO ()) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Out CUInt
minDense ->
            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 CUInt -> Out CUInt -> IO HErr_t
h5p_get_link_phase_change (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) Out CUInt
maxCompact Out CUInt
minDense

setEstLinkInfo :: GroupCreationPropertyList gcpl => gcpl -> CUInt -> CUInt -> IO ()
setEstLinkInfo :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> CUInt -> CUInt -> IO ()
setEstLinkInfo gcpl
gcpl CUInt
estNumEntries CUInt
estNameLen =
    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 -> CUInt -> CUInt -> IO HErr_t
h5p_set_est_link_info (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) CUInt
estNumEntries CUInt
estNameLen

getEstLinkInfo :: GroupCreationPropertyList gcpl => gcpl -> IO (CUInt, CUInt)
getEstLinkInfo :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> IO (CUInt, CUInt)
getEstLinkInfo gcpl
gcpl =
    (Out CUInt -> IO CUInt) -> IO (CUInt, CUInt)
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m (a, b)
withOut ((Out CUInt -> IO CUInt) -> IO (CUInt, CUInt))
-> (Out CUInt -> IO CUInt) -> IO (CUInt, CUInt)
forall a b. (a -> b) -> a -> b
$ \Out CUInt
estNumEntries ->
        (Out CUInt -> IO ()) -> IO CUInt
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CUInt -> IO ()) -> IO CUInt)
-> (Out CUInt -> IO ()) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Out CUInt
estNameLen ->
            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 CUInt -> Out CUInt -> IO HErr_t
h5p_get_est_link_info (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) Out CUInt
estNumEntries Out CUInt
estNameLen

data CreationOrder
    = Tracked
    | Indexed
    deriving (CreationOrder -> CreationOrder -> Bool
(CreationOrder -> CreationOrder -> Bool)
-> (CreationOrder -> CreationOrder -> Bool) -> Eq CreationOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreationOrder -> CreationOrder -> Bool
== :: CreationOrder -> CreationOrder -> Bool
$c/= :: CreationOrder -> CreationOrder -> Bool
/= :: CreationOrder -> CreationOrder -> Bool
Eq, Eq CreationOrder
Eq CreationOrder
-> (CreationOrder -> CreationOrder -> Ordering)
-> (CreationOrder -> CreationOrder -> Bool)
-> (CreationOrder -> CreationOrder -> Bool)
-> (CreationOrder -> CreationOrder -> Bool)
-> (CreationOrder -> CreationOrder -> Bool)
-> (CreationOrder -> CreationOrder -> CreationOrder)
-> (CreationOrder -> CreationOrder -> CreationOrder)
-> Ord CreationOrder
CreationOrder -> CreationOrder -> Bool
CreationOrder -> CreationOrder -> Ordering
CreationOrder -> CreationOrder -> CreationOrder
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
$ccompare :: CreationOrder -> CreationOrder -> Ordering
compare :: CreationOrder -> CreationOrder -> Ordering
$c< :: CreationOrder -> CreationOrder -> Bool
< :: CreationOrder -> CreationOrder -> Bool
$c<= :: CreationOrder -> CreationOrder -> Bool
<= :: CreationOrder -> CreationOrder -> Bool
$c> :: CreationOrder -> CreationOrder -> Bool
> :: CreationOrder -> CreationOrder -> Bool
$c>= :: CreationOrder -> CreationOrder -> Bool
>= :: CreationOrder -> CreationOrder -> Bool
$cmax :: CreationOrder -> CreationOrder -> CreationOrder
max :: CreationOrder -> CreationOrder -> CreationOrder
$cmin :: CreationOrder -> CreationOrder -> CreationOrder
min :: CreationOrder -> CreationOrder -> CreationOrder
Ord, CreationOrder
CreationOrder -> CreationOrder -> Bounded CreationOrder
forall a. a -> a -> Bounded a
$cminBound :: CreationOrder
minBound :: CreationOrder
$cmaxBound :: CreationOrder
maxBound :: CreationOrder
Bounded, Int -> CreationOrder
CreationOrder -> Int
CreationOrder -> [CreationOrder]
CreationOrder -> CreationOrder
CreationOrder -> CreationOrder -> [CreationOrder]
CreationOrder -> CreationOrder -> CreationOrder -> [CreationOrder]
(CreationOrder -> CreationOrder)
-> (CreationOrder -> CreationOrder)
-> (Int -> CreationOrder)
-> (CreationOrder -> Int)
-> (CreationOrder -> [CreationOrder])
-> (CreationOrder -> CreationOrder -> [CreationOrder])
-> (CreationOrder -> CreationOrder -> [CreationOrder])
-> (CreationOrder
    -> CreationOrder -> CreationOrder -> [CreationOrder])
-> Enum CreationOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CreationOrder -> CreationOrder
succ :: CreationOrder -> CreationOrder
$cpred :: CreationOrder -> CreationOrder
pred :: CreationOrder -> CreationOrder
$ctoEnum :: Int -> CreationOrder
toEnum :: Int -> CreationOrder
$cfromEnum :: CreationOrder -> Int
fromEnum :: CreationOrder -> Int
$cenumFrom :: CreationOrder -> [CreationOrder]
enumFrom :: CreationOrder -> [CreationOrder]
$cenumFromThen :: CreationOrder -> CreationOrder -> [CreationOrder]
enumFromThen :: CreationOrder -> CreationOrder -> [CreationOrder]
$cenumFromTo :: CreationOrder -> CreationOrder -> [CreationOrder]
enumFromTo :: CreationOrder -> CreationOrder -> [CreationOrder]
$cenumFromThenTo :: CreationOrder -> CreationOrder -> CreationOrder -> [CreationOrder]
enumFromThenTo :: CreationOrder -> CreationOrder -> CreationOrder -> [CreationOrder]
Enum, ReadPrec [CreationOrder]
ReadPrec CreationOrder
Int -> ReadS CreationOrder
ReadS [CreationOrder]
(Int -> ReadS CreationOrder)
-> ReadS [CreationOrder]
-> ReadPrec CreationOrder
-> ReadPrec [CreationOrder]
-> Read CreationOrder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CreationOrder
readsPrec :: Int -> ReadS CreationOrder
$creadList :: ReadS [CreationOrder]
readList :: ReadS [CreationOrder]
$creadPrec :: ReadPrec CreationOrder
readPrec :: ReadPrec CreationOrder
$creadListPrec :: ReadPrec [CreationOrder]
readListPrec :: ReadPrec [CreationOrder]
Read, Int -> CreationOrder -> ShowS
[CreationOrder] -> ShowS
CreationOrder -> String
(Int -> CreationOrder -> ShowS)
-> (CreationOrder -> String)
-> ([CreationOrder] -> ShowS)
-> Show CreationOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreationOrder -> ShowS
showsPrec :: Int -> CreationOrder -> ShowS
$cshow :: CreationOrder -> String
show :: CreationOrder -> String
$cshowList :: [CreationOrder] -> ShowS
showList :: [CreationOrder] -> ShowS
Show)

creationOrderCode :: Num a => CreationOrder -> a
creationOrderCode :: forall a. Num a => CreationOrder -> a
creationOrderCode CreationOrder
Tracked = a
forall a. Num a => a
h5p_CRT_ORDER_TRACKED
creationOrderCode CreationOrder
Indexed = a
forall a. Num a => a
h5p_CRT_ORDER_INDEXED

creationOrder :: (Eq a, Num a, Show a) => a -> CreationOrder
creationOrder :: forall a. (Eq a, Num a, Show a) => a -> CreationOrder
creationOrder a
c
    | a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Num a => a
h5p_CRT_ORDER_TRACKED    = CreationOrder
Tracked
    | a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Num a => a
h5p_CRT_ORDER_INDEXED    = CreationOrder
Indexed
    | Bool
otherwise = String -> CreationOrder
forall a. HasCallStack => String -> a
error (String
"Unknown CreationOrder code: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c)

setLinkCreationOrder :: GroupCreationPropertyList gcpl => gcpl -> CreationOrder -> IO ()
setLinkCreationOrder :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> CreationOrder -> IO ()
setLinkCreationOrder gcpl
gcpl CreationOrder
crtOrderFlags =
    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 -> CUInt -> IO HErr_t
h5p_set_link_creation_order (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) (CreationOrder -> CUInt
forall a. Num a => CreationOrder -> a
creationOrderCode CreationOrder
crtOrderFlags)

getLinkCreationOrder :: GroupCreationPropertyList gcpl => gcpl -> IO CreationOrder
getLinkCreationOrder :: forall gcpl.
GroupCreationPropertyList gcpl =>
gcpl -> IO CreationOrder
getLinkCreationOrder gcpl
gcpl =
    (CUInt -> CreationOrder) -> IO CUInt -> IO CreationOrder
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> CreationOrder
forall a. (Eq a, Num a, Show a) => a -> CreationOrder
creationOrder (IO CUInt -> IO CreationOrder) -> IO CUInt -> IO CreationOrder
forall a b. (a -> b) -> a -> b
$
        (Out CUInt -> IO ()) -> IO CUInt
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CUInt -> IO ()) -> IO CUInt)
-> (Out CUInt -> IO ()) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Out CUInt
crtOrderFlags ->
            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 CUInt -> IO HErr_t
h5p_get_link_creation_order (gcpl -> HId_t
forall t. HId t => t -> HId_t
hid gcpl
gcpl) Out CUInt
crtOrderFlags