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

    , OCPL
    , ObjectCreationPropertyList

    , setAttrPhaseChange
    , getAttrPhaseChange

    , setAttrCreationOrder
    , getAttrCreationOrder

    , setObjTrackTimes
    , getObjTrackTimes

    , modifyFilter
    , setFilter

    , getNFilters

    , allFiltersAvail

    , removeFilter

    , setDeflate

    , setFletcher32
    ) where

import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5P
import Bindings.HDF5.Raw.H5Z
import Bindings.HDF5.Core
import Bindings.HDF5.Error
import Bindings.HDF5.PropertyList

import qualified Data.Vector.Storable as SV
import Foreign.C
import Foreign.Ptr.Conventions

class PropertyList t => ObjectCreationPropertyList t where
newtype OCPL = OCPL PropertyListID
    deriving (OCPL -> OCPL -> Bool
(OCPL -> OCPL -> Bool) -> (OCPL -> OCPL -> Bool) -> Eq OCPL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCPL -> OCPL -> Bool
== :: OCPL -> OCPL -> Bool
$c/= :: OCPL -> OCPL -> Bool
/= :: OCPL -> OCPL -> Bool
Eq, OCPL -> HId_t
(OCPL -> HId_t) -> HId OCPL
forall t. (t -> HId_t) -> HId t
$chid :: OCPL -> HId_t
hid :: OCPL -> HId_t
HId, HId_t -> OCPL
(HId_t -> OCPL) -> FromHId OCPL
forall t. (HId_t -> t) -> FromHId t
$cuncheckedFromHId :: HId_t -> OCPL
uncheckedFromHId :: HId_t -> OCPL
FromHId, OCPL -> Bool
(OCPL -> Bool) -> HDFResultType OCPL
forall t. (t -> Bool) -> HDFResultType t
$cisError :: OCPL -> Bool
isError :: OCPL -> Bool
HDFResultType, FromHId OCPL
HId OCPL
(HId OCPL, FromHId OCPL) => PropertyListOrClass OCPL
forall t. (HId t, FromHId t) => PropertyListOrClass t
PropertyListOrClass)
instance PropertyList OCPL where
    staticPlistClass :: Tagged OCPL PropertyListClassID
staticPlistClass = PropertyListClassID -> Tagged OCPL PropertyListClassID
forall {k} (s :: k) b. b -> Tagged s b
Tagged PropertyListClassID
objectCreate
instance ObjectCreationPropertyList OCPL

setAttrPhaseChange :: ObjectCreationPropertyList t => t -> CUInt -> CUInt -> IO ()
setAttrPhaseChange :: forall t.
ObjectCreationPropertyList t =>
t -> CUInt -> CUInt -> IO ()
setAttrPhaseChange t
plist CUInt
max_compact CUInt
min_dense =
    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_attr_phase_change (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) CUInt
max_compact CUInt
min_dense

getAttrPhaseChange :: ObjectCreationPropertyList t => t -> IO (CUInt, CUInt)
getAttrPhaseChange :: forall t. ObjectCreationPropertyList t => t -> IO (CUInt, CUInt)
getAttrPhaseChange t
plist =
    (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
max_compact ->
        (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
min_dense ->
            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_attr_phase_change (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) Out CUInt
max_compact Out CUInt
min_dense

setAttrCreationOrder :: ObjectCreationPropertyList t => t -> CUInt -> IO ()
setAttrCreationOrder :: forall t. ObjectCreationPropertyList t => t -> CUInt -> IO ()
setAttrCreationOrder t
plist CUInt
crt_order_flags =
    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_attr_creation_order (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) CUInt
crt_order_flags

getAttrCreationOrder :: ObjectCreationPropertyList t => t -> IO CUInt
getAttrCreationOrder :: forall t. ObjectCreationPropertyList t => t -> IO CUInt
getAttrCreationOrder t
plist =
    (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
crt_order_flags ->
        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_attr_creation_order (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) Out CUInt
crt_order_flags

setObjTrackTimes :: ObjectCreationPropertyList t => t -> Bool -> IO ()
setObjTrackTimes :: forall t. ObjectCreationPropertyList t => t -> Bool -> IO ()
setObjTrackTimes t
plist Bool
track_times =
    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 -> HBool_t -> IO HErr_t
h5p_set_obj_track_times (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) (Word8 -> HBool_t
HBool_t (Word8 -> HBool_t) -> Word8 -> HBool_t
forall a b. (a -> b) -> a -> b
$ if Bool
track_times then Word8
1 else Word8
0)

getObjTrackTimes :: ObjectCreationPropertyList t => t -> IO Bool
getObjTrackTimes :: forall t. ObjectCreationPropertyList t => t -> IO Bool
getObjTrackTimes t
plist =
    (HBool_t -> Bool) -> IO HBool_t -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HBool_t Word8
x) -> Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0) (IO HBool_t -> IO Bool) -> IO HBool_t -> IO Bool
forall a b. (a -> b) -> a -> b
$
        (Out HBool_t -> IO ()) -> IO HBool_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out HBool_t -> IO ()) -> IO HBool_t)
-> (Out HBool_t -> IO ()) -> IO HBool_t
forall a b. (a -> b) -> a -> b
$ \Out HBool_t
track_times ->
            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 HBool_t -> IO HErr_t
h5p_get_obj_track_times (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) Out HBool_t
track_times

modifyFilter :: ObjectCreationPropertyList t => t -> H5Z_filter_t -> Bool -> SV.Vector CUInt -> IO ()
modifyFilter :: forall t.
ObjectCreationPropertyList t =>
t -> H5Z_filter_t -> Bool -> Vector CUInt -> IO ()
modifyFilter t
plist H5Z_filter_t
filt Bool
optional Vector CUInt
cd_values =
    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
$
        Vector CUInt -> (InArray CUInt -> IO HErr_t) -> IO HErr_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m) =>
Vector a -> (InArray a -> m b) -> m b
withInVector Vector CUInt
cd_values ((InArray CUInt -> IO HErr_t) -> IO HErr_t)
-> (InArray CUInt -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \InArray CUInt
ccd_values ->
            HId_t
-> H5Z_filter_t -> CUInt -> CSize -> InArray CUInt -> IO HErr_t
h5p_modify_filter (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) H5Z_filter_t
filt CUInt
flags CSize
n_elmts InArray CUInt
ccd_values
    where
        flags :: CUInt
flags
            | Bool
optional  = CUInt
forall a. Num a => a
h5z_FLAG_OPTIONAL
            | Bool
otherwise = CUInt
0
        n_elmts :: CSize
n_elmts = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector CUInt -> Int
forall a. Storable a => Vector a -> Int
SV.length Vector CUInt
cd_values)

setFilter :: ObjectCreationPropertyList t => t -> H5Z_filter_t -> Bool -> SV.Vector CUInt -> IO ()
setFilter :: forall t.
ObjectCreationPropertyList t =>
t -> H5Z_filter_t -> Bool -> Vector CUInt -> IO ()
setFilter t
plist H5Z_filter_t
filt Bool
optional Vector CUInt
cd_values =
    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
$
        Vector CUInt -> (InArray CUInt -> IO HErr_t) -> IO HErr_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m) =>
Vector a -> (InArray a -> m b) -> m b
withInVector Vector CUInt
cd_values ((InArray CUInt -> IO HErr_t) -> IO HErr_t)
-> (InArray CUInt -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \InArray CUInt
ccd_values ->
            HId_t
-> H5Z_filter_t -> CUInt -> CSize -> InArray CUInt -> IO HErr_t
h5p_set_filter (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) H5Z_filter_t
filt CUInt
flags CSize
n_elmts InArray CUInt
ccd_values
    where
        flags :: CUInt
flags
            | Bool
optional  = CUInt
forall a. Num a => a
h5z_FLAG_OPTIONAL
            | Bool
otherwise = CUInt
0
        n_elmts :: CSize
n_elmts = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector CUInt -> Int
forall a. Storable a => Vector a -> Int
SV.length Vector CUInt
cd_values)

getNFilters :: ObjectCreationPropertyList t => t -> IO CInt
getNFilters :: forall t. ObjectCreationPropertyList t => t -> IO CInt
getNFilters t
plist =
    (CInt -> Bool) -> IO CInt -> IO CInt
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen (CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0) (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
        HId_t -> IO CInt
h5p_get_nfilters (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist)

-- getFilter :: ObjectCreationPropertyList t => t -> CUInt -> ...
-- getFilterById

allFiltersAvail :: ObjectCreationPropertyList t => t -> IO Bool
allFiltersAvail :: forall t. ObjectCreationPropertyList t => t -> IO Bool
allFiltersAvail t
plist =
    IO HTri_t -> IO Bool
htriToBool (IO HTri_t -> IO Bool) -> IO HTri_t -> IO Bool
forall a b. (a -> b) -> a -> b
$
        HId_t -> IO HTri_t
h5p_all_filters_avail (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist)

removeFilter :: ObjectCreationPropertyList t => t -> H5Z_filter_t -> IO ()
removeFilter :: forall t.
ObjectCreationPropertyList t =>
t -> H5Z_filter_t -> IO ()
removeFilter t
plist H5Z_filter_t
filt =
    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 -> H5Z_filter_t -> IO HErr_t
h5p_remove_filter (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) H5Z_filter_t
filt

setDeflate :: ObjectCreationPropertyList t => t -> CUInt -> IO ()
setDeflate :: forall t. ObjectCreationPropertyList t => t -> CUInt -> IO ()
setDeflate t
plist CUInt
aggression =
    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_deflate (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) CUInt
aggression

setFletcher32 :: ObjectCreationPropertyList t => t -> IO ()
setFletcher32 :: forall t. ObjectCreationPropertyList t => t -> IO ()
setFletcher32 t
plist =
    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 -> IO HErr_t
h5p_set_fletcher32 (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist)