module Bindings.HDF5.Attribute
( Attribute
, openAttribute
, getAttributeType
, getAttributeInfo
, getAttributeSpace
, readAttribute
, readAttributeStringASCII
, doesAttributeExist
, closeAttribute
, iterateAttributes
, iterateAttributesByName
) where
import Control.Exception (SomeException, finally,
throwIO, try)
import qualified Data.ByteString as BS
import Data.IORef
import qualified Data.Vector.Storable as SV
import Foreign
import Foreign.C
import Bindings.HDF5.Core
import Bindings.HDF5.Dataspace
import Bindings.HDF5.Datatype
import Bindings.HDF5.Datatype.Internal
import Bindings.HDF5.Error
import Bindings.HDF5.Group
import Bindings.HDF5.Object
import Bindings.HDF5.PropertyList.LAPL
import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5A
import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5O
import Bindings.HDF5.Raw.H5P
import Bindings.HDF5.Raw.Util
import Foreign.Ptr.Conventions
newtype Attribute = Attribute HId_t
deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Attribute -> HId_t
(Attribute -> HId_t) -> HId Attribute
forall t. (t -> HId_t) -> HId t
hid :: Attribute -> HId_t
$chid :: Attribute -> HId_t
HId, HId_t -> Attribute
(HId_t -> Attribute) -> FromHId Attribute
forall t. (HId_t -> t) -> FromHId t
uncheckedFromHId :: HId_t -> Attribute
$cuncheckedFromHId :: HId_t -> Attribute
FromHId, Attribute -> Bool
(Attribute -> Bool) -> HDFResultType Attribute
forall t. (t -> Bool) -> HDFResultType t
isError :: Attribute -> Bool
$cisError :: Attribute -> Bool
HDFResultType)
openAttribute :: ObjectId
-> BS.ByteString
-> IO Attribute
openAttribute :: ObjectId -> ByteString -> IO Attribute
openAttribute ObjectId
obj ByteString
name =
HId_t -> Attribute
Attribute (HId_t -> Attribute) -> IO HId_t -> IO Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HId_t -> IO HId_t) -> IO HId_t -> IO HId_t
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO HId_t) -> IO HId_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
HId_t -> CString -> HId_t -> IO HId_t
h5a_open (ObjectId -> HId_t
forall t. HId t => t -> HId_t
hid ObjectId
obj) CString
cname HId_t
h5p_DEFAULT)
getAttributeType :: Attribute -> IO Datatype
getAttributeType :: Attribute -> IO Datatype
getAttributeType (Attribute HId_t
attr_id) =
HId_t -> Datatype
Datatype (HId_t -> Datatype) -> IO HId_t -> IO Datatype
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HId_t -> IO HId_t) -> IO HId_t -> IO HId_t
forall a b. (a -> b) -> a -> b
$
HId_t -> IO HId_t
h5a_get_type HId_t
attr_id)
closeAttribute :: Attribute -> IO ()
closeAttribute :: Attribute -> IO ()
closeAttribute (Attribute HId_t
attr) =
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
h5a_close HId_t
attr
getAttributeSpace :: Attribute -> IO Dataspace
getAttributeSpace :: Attribute -> IO Dataspace
getAttributeSpace (Attribute HId_t
attr_id) =
HId_t -> Dataspace
forall t. FromHId t => HId_t -> t
uncheckedFromHId
(HId_t -> Dataspace) -> IO HId_t -> IO Dataspace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO HId_t -> IO HId_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (HId_t -> IO HId_t
h5a_get_space HId_t
attr_id)
readAttribute :: NativeType t =>
Attribute
-> IO (SV.Vector t)
readAttribute :: forall t. NativeType t => Attribute -> IO (Vector t)
readAttribute attr :: Attribute
attr@(Attribute HId_t
attr_id) = do
Dataspace
space <- Attribute -> IO Dataspace
getAttributeSpace Attribute
attr
HSize
n <- Dataspace -> IO HSize
getSimpleDataspaceExtentNPoints Dataspace
space
Int -> (OutArray t -> IO ()) -> IO (Vector t)
forall a b.
Storable a =>
Int -> (OutArray a -> IO b) -> IO (Vector a)
withOutVector_ (HSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral HSize
n) ((OutArray t -> IO ()) -> IO (Vector t))
-> (OutArray t -> IO ()) -> IO (Vector t)
forall a b. (a -> b) -> a -> b
$ \OutArray t
buf ->
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 -> HId_t -> OutArray t -> IO HErr_t
forall a. HId_t -> HId_t -> OutArray a -> IO HErr_t
h5a_read HId_t
attr_id (OutArray t -> HId_t
forall t (f :: * -> *). NativeType t => f t -> HId_t
hdfTypeOf1 OutArray t
buf) OutArray t
buf
readAttributeStringASCII :: Attribute -> IO BS.ByteString
readAttributeStringASCII :: Attribute -> IO ByteString
readAttributeStringASCII attr :: Attribute
attr@(Attribute HId_t
attr_id) = do
Dataspace
space <- Attribute -> IO Dataspace
getAttributeSpace Attribute
attr
HSize
n <- Dataspace -> IO HSize
getSimpleDataspaceExtentNPoints Dataspace
space
Datatype
atype <- Attribute -> IO Datatype
getAttributeType Attribute
attr
CSize
ts <- Datatype -> IO CSize
getTypeSize Datatype
atype
let nbytes :: Int
nbytes = HSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral HSize
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
ts
Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
nbytes ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
buf -> do
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 -> HId_t -> OutArray CChar -> IO HErr_t
forall a. HId_t -> HId_t -> OutArray a -> IO HErr_t
h5a_read HId_t
attr_id (Datatype -> HId_t
forall t. HId t => t -> HId_t
hid Datatype
atype) (CString -> OutArray CChar
forall (p :: * -> *) a. WrappedPtr p => Ptr a -> p a
wrapPtr CString
buf)
CStringLen -> IO ByteString
BS.packCStringLen (CString
buf, Int
nbytes)
doesAttributeExist :: ObjectId
-> BS.ByteString
-> IO Bool
doesAttributeExist :: ObjectId -> ByteString -> IO Bool
doesAttributeExist ObjectId
obj ByteString
aname =
IO HTri_t -> IO Bool
htriToBool (IO HTri_t -> IO Bool) -> IO HTri_t -> IO Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO HTri_t) -> IO HTri_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
aname ((CString -> IO HTri_t) -> IO HTri_t)
-> (CString -> IO HTri_t) -> IO HTri_t
forall a b. (a -> b) -> a -> b
$ \CString
cname -> HId_t -> CString -> IO HTri_t
h5a_exists (ObjectId -> HId_t
forall t. HId t => t -> HId_t
hid ObjectId
obj) CString
cname
data AttributeInfo = AttributeInfo
{ AttributeInfo -> Bool
attributeCOrderValid :: Bool
, AttributeInfo -> H5O_msg_crt_idx_t
attributeCOrder :: H5O_msg_crt_idx_t
, AttributeInfo -> CSet
attributeCSet :: CSet
, AttributeInfo -> HSize
attributeDataSize :: HSize
} deriving (AttributeInfo -> AttributeInfo -> Bool
(AttributeInfo -> AttributeInfo -> Bool)
-> (AttributeInfo -> AttributeInfo -> Bool) -> Eq AttributeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeInfo -> AttributeInfo -> Bool
$c/= :: AttributeInfo -> AttributeInfo -> Bool
== :: AttributeInfo -> AttributeInfo -> Bool
$c== :: AttributeInfo -> AttributeInfo -> Bool
Eq, Eq AttributeInfo
Eq AttributeInfo
-> (AttributeInfo -> AttributeInfo -> Ordering)
-> (AttributeInfo -> AttributeInfo -> Bool)
-> (AttributeInfo -> AttributeInfo -> Bool)
-> (AttributeInfo -> AttributeInfo -> Bool)
-> (AttributeInfo -> AttributeInfo -> Bool)
-> (AttributeInfo -> AttributeInfo -> AttributeInfo)
-> (AttributeInfo -> AttributeInfo -> AttributeInfo)
-> Ord AttributeInfo
AttributeInfo -> AttributeInfo -> Bool
AttributeInfo -> AttributeInfo -> Ordering
AttributeInfo -> AttributeInfo -> AttributeInfo
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
min :: AttributeInfo -> AttributeInfo -> AttributeInfo
$cmin :: AttributeInfo -> AttributeInfo -> AttributeInfo
max :: AttributeInfo -> AttributeInfo -> AttributeInfo
$cmax :: AttributeInfo -> AttributeInfo -> AttributeInfo
>= :: AttributeInfo -> AttributeInfo -> Bool
$c>= :: AttributeInfo -> AttributeInfo -> Bool
> :: AttributeInfo -> AttributeInfo -> Bool
$c> :: AttributeInfo -> AttributeInfo -> Bool
<= :: AttributeInfo -> AttributeInfo -> Bool
$c<= :: AttributeInfo -> AttributeInfo -> Bool
< :: AttributeInfo -> AttributeInfo -> Bool
$c< :: AttributeInfo -> AttributeInfo -> Bool
compare :: AttributeInfo -> AttributeInfo -> Ordering
$ccompare :: AttributeInfo -> AttributeInfo -> Ordering
Ord, ReadPrec [AttributeInfo]
ReadPrec AttributeInfo
Int -> ReadS AttributeInfo
ReadS [AttributeInfo]
(Int -> ReadS AttributeInfo)
-> ReadS [AttributeInfo]
-> ReadPrec AttributeInfo
-> ReadPrec [AttributeInfo]
-> Read AttributeInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeInfo]
$creadListPrec :: ReadPrec [AttributeInfo]
readPrec :: ReadPrec AttributeInfo
$creadPrec :: ReadPrec AttributeInfo
readList :: ReadS [AttributeInfo]
$creadList :: ReadS [AttributeInfo]
readsPrec :: Int -> ReadS AttributeInfo
$creadsPrec :: Int -> ReadS AttributeInfo
Read, Int -> AttributeInfo -> ShowS
[AttributeInfo] -> ShowS
AttributeInfo -> String
(Int -> AttributeInfo -> ShowS)
-> (AttributeInfo -> String)
-> ([AttributeInfo] -> ShowS)
-> Show AttributeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeInfo] -> ShowS
$cshowList :: [AttributeInfo] -> ShowS
show :: AttributeInfo -> String
$cshow :: AttributeInfo -> String
showsPrec :: Int -> AttributeInfo -> ShowS
$cshowsPrec :: Int -> AttributeInfo -> ShowS
Show)
readAttributeInfo :: H5A_info_t -> AttributeInfo
readAttributeInfo :: H5A_info_t -> AttributeInfo
readAttributeInfo H5A_info_t
i = AttributeInfo :: Bool -> H5O_msg_crt_idx_t -> CSet -> HSize -> AttributeInfo
AttributeInfo
{ attributeCOrderValid :: Bool
attributeCOrderValid = HBool_t -> Bool
hboolToBool (H5A_info_t -> HBool_t
h5a_info_t'corder_valid H5A_info_t
i)
, attributeCOrder :: H5O_msg_crt_idx_t
attributeCOrder = H5A_info_t -> H5O_msg_crt_idx_t
h5a_info_t'corder H5A_info_t
i
, attributeCSet :: CSet
attributeCSet = H5T_cset_t -> CSet
cSetFromCode (H5A_info_t -> H5T_cset_t
h5a_info_t'cset H5A_info_t
i)
, attributeDataSize :: HSize
attributeDataSize = HSize_t -> HSize
HSize (H5A_info_t -> HSize_t
h5a_info_t'data_size H5A_info_t
i)
}
getAttributeInfo :: Attribute -> IO AttributeInfo
getAttributeInfo :: Attribute -> IO AttributeInfo
getAttributeInfo (Attribute HId_t
attr_id) =
(H5A_info_t -> AttributeInfo) -> IO H5A_info_t -> IO AttributeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap H5A_info_t -> AttributeInfo
readAttributeInfo (IO H5A_info_t -> IO AttributeInfo)
-> IO H5A_info_t -> IO AttributeInfo
forall a b. (a -> b) -> a -> b
$
(Out H5A_info_t -> IO ()) -> IO H5A_info_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out H5A_info_t -> IO ()) -> IO H5A_info_t)
-> (Out H5A_info_t -> IO ()) -> IO H5A_info_t
forall a b. (a -> b) -> a -> b
$ \Out H5A_info_t
info ->
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 H5A_info_t -> IO HErr_t
h5a_get_info HId_t
attr_id Out H5A_info_t
info
foreign import ccall "wrapper" wrap_H5A_operator2_t
:: (HId_t -> CString -> In H5A_info_t -> InOut a -> IO HErr_t)
-> IO (FunPtr (HId_t -> CString -> In H5A_info_t -> InOut a -> IO HErr_t))
with_operator2_t :: (Group -> BS.ByteString -> AttributeInfo -> IO HErr_t)
-> (H5A_operator2_t () -> InOut () -> IO HErr_t)
-> IO HErr_t
with_operator2_t :: (Group -> ByteString -> AttributeInfo -> IO HErr_t)
-> (H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_operator2_t Group -> ByteString -> AttributeInfo -> IO HErr_t
op H5A_operator2_t () -> InOut () -> IO HErr_t
f = do
IORef (Maybe SomeException)
exception1 <- Maybe SomeException -> IO (IORef (Maybe SomeException))
forall a. a -> IO (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing :: IO (IORef (Maybe SomeException))
H5A_operator2_t ()
op1 <- (HId_t -> CString -> In H5A_info_t -> InOut () -> IO HErr_t)
-> IO (H5A_operator2_t ())
forall a.
(HId_t -> CString -> In H5A_info_t -> InOut a -> IO HErr_t)
-> IO
(FunPtr
(HId_t -> CString -> In H5A_info_t -> InOut a -> IO HErr_t))
wrap_H5A_operator2_t ((HId_t -> CString -> In H5A_info_t -> InOut () -> IO HErr_t)
-> IO (H5A_operator2_t ()))
-> (HId_t -> CString -> In H5A_info_t -> InOut () -> IO HErr_t)
-> IO (H5A_operator2_t ())
forall a b. (a -> b) -> a -> b
$ \HId_t
grp CString
name (In Ptr H5A_info_t
attribute) InOut ()
_opData -> do
ByteString
name1 <- CString -> IO ByteString
BS.packCString CString
name
H5A_info_t
attribute1 <- Ptr H5A_info_t -> IO H5A_info_t
forall a. Storable a => Ptr a -> IO a
peek Ptr H5A_info_t
attribute
Either SomeException HErr_t
result <- IO HErr_t -> IO (Either SomeException HErr_t)
forall e a. Exception e => IO a -> IO (Either e a)
try (Group -> ByteString -> AttributeInfo -> IO HErr_t
op (HId_t -> Group
forall t. FromHId t => HId_t -> t
uncheckedFromHId HId_t
grp) ByteString
name1 (H5A_info_t -> AttributeInfo
readAttributeInfo H5A_info_t
attribute1))
case Either SomeException HErr_t
result of
Left SomeException
exc -> do
IORef (Maybe SomeException) -> Maybe SomeException -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SomeException)
exception1 (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
exc)
HErr_t -> IO HErr_t
forall (m :: * -> *) a. Monad m => a -> m a
return HErr_t
forall a. Bounded a => a
maxBound
Right HErr_t
x -> HErr_t -> IO HErr_t
forall (m :: * -> *) a. Monad m => a -> m a
return HErr_t
x
HErr_t
result <- H5A_operator2_t () -> InOut () -> IO HErr_t
f H5A_operator2_t ()
op1 (Ptr () -> InOut ()
forall a. Ptr a -> InOut a
InOut Ptr ()
forall a. Ptr a
nullPtr) IO HErr_t -> IO () -> IO HErr_t
forall a b. IO a -> IO b -> IO a
`finally` H5A_operator2_t () -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr H5A_operator2_t ()
op1
if HErr_t
result HErr_t -> HErr_t -> Bool
forall a. Eq a => a -> a -> Bool
== HErr_t
forall a. Bounded a => a
maxBound
then do
Maybe SomeException
exception2 <- IORef (Maybe SomeException) -> IO (Maybe SomeException)
forall a. IORef a -> IO a
readIORef IORef (Maybe SomeException)
exception1
IO HErr_t
-> (SomeException -> IO HErr_t) -> Maybe SomeException -> IO HErr_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HErr_t -> IO HErr_t
forall (m :: * -> *) a. Monad m => a -> m a
return HErr_t
result) SomeException -> IO HErr_t
forall e a. Exception e => e -> IO a
throwIO Maybe SomeException
exception2
else HErr_t -> IO HErr_t
forall (m :: * -> *) a. Monad m => a -> m a
return HErr_t
result
iterateAttributes :: ObjectId-> IndexType -> IterOrder -> Maybe HSize -> (Group -> BS.ByteString -> AttributeInfo -> IO HErr_t) -> IO HSize
iterateAttributes :: ObjectId
-> IndexType
-> IterOrder
-> Maybe HSize
-> (Group -> ByteString -> AttributeInfo -> IO HErr_t)
-> IO HSize
iterateAttributes ObjectId
obj IndexType
indexType IterOrder
order Maybe HSize
startIndex Group -> ByteString -> AttributeInfo -> IO HErr_t
op =
(HSize_t -> HSize) -> IO HSize_t -> IO HSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HSize_t -> HSize
HSize (IO HSize_t -> IO HSize) -> IO HSize_t -> IO HSize
forall a b. (a -> b) -> a -> b
$
HSize_t -> (InOut HSize_t -> IO ()) -> IO HSize_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
a -> (InOut a -> m b) -> m a
withInOut_ (HSize_t -> (HSize -> HSize_t) -> Maybe HSize -> HSize_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HSize_t
0 HSize -> HSize_t
hSize Maybe HSize
startIndex) ((InOut HSize_t -> IO ()) -> IO HSize_t)
-> (InOut HSize_t -> IO ()) -> IO HSize_t
forall a b. (a -> b) -> a -> b
$ \InOut HSize_t
ioStartIndex ->
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
$
(Group -> ByteString -> AttributeInfo -> IO HErr_t)
-> (H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_operator2_t Group -> ByteString -> AttributeInfo -> IO HErr_t
op ((H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t)
-> (H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \H5A_operator2_t ()
iop InOut ()
opData ->
HId_t
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5A_operator2_t ()
-> InOut ()
-> IO HErr_t
forall a.
HId_t
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5A_operator2_t a
-> InOut a
-> IO HErr_t
h5a_iterate2 (ObjectId -> HId_t
forall t. HId t => t -> HId_t
hid ObjectId
obj) (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) InOut HSize_t
ioStartIndex H5A_operator2_t ()
iop InOut ()
opData
iterateAttributesByName :: ObjectId -> BS.ByteString -> IndexType -> IterOrder -> Maybe HSize -> Maybe LAPL -> (Group -> BS.ByteString -> AttributeInfo -> IO HErr_t) -> IO HSize
iterateAttributesByName :: ObjectId
-> ByteString
-> IndexType
-> IterOrder
-> Maybe HSize
-> Maybe LAPL
-> (Group -> ByteString -> AttributeInfo -> IO HErr_t)
-> IO HSize
iterateAttributesByName ObjectId
obj ByteString
groupName IndexType
indexType IterOrder
order Maybe HSize
startIndex Maybe LAPL
lapl Group -> ByteString -> AttributeInfo -> IO HErr_t
op =
(HSize_t -> HSize) -> IO HSize_t -> IO HSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HSize_t -> HSize
HSize (IO HSize_t -> IO HSize) -> IO HSize_t -> IO HSize
forall a b. (a -> b) -> a -> b
$
HSize_t -> (InOut HSize_t -> IO ()) -> IO HSize_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
a -> (InOut a -> m b) -> m a
withInOut_ (HSize_t -> (HSize -> HSize_t) -> Maybe HSize -> HSize_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HSize_t
0 HSize -> HSize_t
hSize Maybe HSize
startIndex) ((InOut HSize_t -> IO ()) -> IO HSize_t)
-> (InOut HSize_t -> IO ()) -> IO HSize_t
forall a b. (a -> b) -> a -> b
$ \InOut HSize_t
ioStartIndex ->
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
$
(Group -> ByteString -> AttributeInfo -> IO HErr_t)
-> (H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_operator2_t Group -> ByteString -> AttributeInfo -> IO HErr_t
op ((H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t)
-> (H5A_operator2_t () -> InOut () -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \H5A_operator2_t ()
iop InOut ()
opData ->
ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
groupName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cgroupName ->
HId_t
-> CString
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5A_operator2_t ()
-> InOut ()
-> HId_t
-> IO HErr_t
forall a.
HId_t
-> CString
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5A_operator2_t a
-> InOut a
-> HId_t
-> IO HErr_t
h5a_iterate_by_name (ObjectId -> HId_t
forall t. HId t => t -> HId_t
hid ObjectId
obj) CString
cgroupName (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) InOut HSize_t
ioStartIndex H5A_operator2_t ()
iop InOut ()
opData (HId_t -> (LAPL -> HId_t) -> Maybe LAPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT LAPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe LAPL
lapl)