{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- |
Typesafe wrappers around HDF5 functions from the H5G API.

Feature coverage is as follows:

  h5g_get_info                  	[  OK  ]
  h5g_get_objname_by_idx        	[ FAIL ] (deprecated)
  h5g_get_objinfo               	[ FAIL ] (deprecated)
  h5g_iterate                   	[ FAIL ] (deprecated)
  h5g_get_info_by_idx           	[ FAIL ]
  h5g_link                      	[ FAIL ] (deprecated)
  h5g_unlink                    	[ FAIL ] (deprecated)
  h5g_get_objtype_by_idx        	[ FAIL ] (deprecated)
  h5g_get_linkval               	[ FAIL ] (deprecated)
  h5g_create_anon               	[  OK  ]
  h5g_get_info_by_name          	[  OK  ]
  h5g_get_num_objs              	[ FAIL ] (deprecated)
  h5g_close                     	[  OK  ]
  h5g_move                      	[ FAIL ] (deprecated)
  h5g_open1                     	[ FAIL ] (deprecated)
  h5g_open2                     	[  OK  ]
  h5g_link2                     	[ FAIL ] (deprecated)
  h5g_set_comment               	[ FAIL ] (deprecated)
  h5g_get_comment               	[ FAIL ] (deprecated)
  h5g_get_create_plist          	[ FAIL ]
  h5g_move2                     	[ FAIL ] (deprecated)
  h5g_create2                   	[  OK  ]
  h5g_create1                   	[ FAIL ] (deprecated)


-}
module Bindings.HDF5.Group
    ( Group

    , createGroup
    , createAnonymousGroup
    , openGroup
    , closeGroup

    , GroupStorageType(..)
    , GroupInfo(..)

    , getGroupInfo
    , getGroupInfoByName
    ) where

import Bindings.HDF5.Core
import Bindings.HDF5.Error
import Bindings.HDF5.Object
import Bindings.HDF5.PropertyList.GAPL
import Bindings.HDF5.PropertyList.GCPL
import Bindings.HDF5.PropertyList.LCPL
import Bindings.HDF5.Raw.H5G
import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5P
import Bindings.HDF5.Raw.Util
import qualified Data.ByteString as BS
import Data.Int
import Foreign.Ptr.Conventions

-- * The Group type

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

instance Location Group
instance Object Group where
    staticObjectType :: Tagged Group (Maybe ObjectType)
staticObjectType = Maybe ObjectType -> Tagged Group (Maybe ObjectType)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (ObjectType -> Maybe ObjectType
forall a. a -> Maybe a
Just ObjectType
GroupObj)

-- * General group functions

-- | Create a group given name, location and properties

createGroup :: Location t =>
               t                 -- ^ Parent location for the group
               -> BS.ByteString  -- ^ Group name
               -> Maybe LCPL     -- ^ Link creation properties
               -> Maybe GCPL     -- ^ Group creation properties
               -> Maybe GAPL     -- ^ Group access properties
               -> IO Group       -- ^ Resulting group
createGroup :: forall t.
Location t =>
t
-> ByteString -> Maybe LCPL -> Maybe GCPL -> Maybe GAPL -> IO Group
createGroup t
loc ByteString
name Maybe LCPL
lcpl Maybe GCPL
gcpl Maybe GAPL
gapl =
    (HId_t -> Group) -> IO HId_t -> IO Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> Group
Group (IO HId_t -> IO Group) -> IO HId_t -> IO Group
forall a b. (a -> b) -> a -> 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 -> HId_t -> HId_t -> IO HId_t
h5g_create2 (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) CString
cname
                    (HId_t -> (LCPL -> HId_t) -> Maybe LCPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT LCPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe LCPL
lcpl)
                    (HId_t -> (GCPL -> HId_t) -> Maybe GCPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT GCPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe GCPL
gcpl)
                    (HId_t -> (GAPL -> HId_t) -> Maybe GAPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT GAPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe GAPL
gapl)

-- | Create an anonymous group without a name
createAnonymousGroup :: Location t =>
                        t              -- ^ Parent location for the group
                        -> Maybe GCPL  -- ^ Group creation properties
                        -> Maybe GAPL  -- ^ Group access properties
                        -> IO Group    -- ^ Resulting group
createAnonymousGroup :: forall t. Location t => t -> Maybe GCPL -> Maybe GAPL -> IO Group
createAnonymousGroup t
loc Maybe GCPL
gcpl Maybe GAPL
gapl =
    (HId_t -> Group) -> IO HId_t -> IO Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> Group
Group (IO HId_t -> IO Group) -> IO HId_t -> IO Group
forall a b. (a -> b) -> a -> 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 -> HId_t -> HId_t -> IO HId_t
h5g_create_anon (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) (HId_t -> (GCPL -> HId_t) -> Maybe GCPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT GCPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe GCPL
gcpl) (HId_t -> (GAPL -> HId_t) -> Maybe GAPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT GAPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe GAPL
gapl)

-- | Open an existing group
openGroup :: Location t =>
             t                 -- ^ Parent location
             -> BS.ByteString  -- ^ Group name
             -> Maybe GAPL     -- ^ Group access properties
             -> IO Group       -- ^ Resulting group
openGroup :: forall t. Location t => t -> ByteString -> Maybe GAPL -> IO Group
openGroup t
loc ByteString
name Maybe GAPL
gapl =
    (HId_t -> Group) -> IO HId_t -> IO Group
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> Group
Group (IO HId_t -> IO Group) -> IO HId_t -> IO Group
forall a b. (a -> b) -> a -> 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
h5g_open2 (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) CString
cname (HId_t -> (GAPL -> HId_t) -> Maybe GAPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT GAPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe GAPL
gapl)

-- | Close a group
closeGroup :: Group -> IO ()
closeGroup :: Group -> IO ()
closeGroup (Group HId_t
grp) =
    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
h5g_close HId_t
grp

-- * Group metadata

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

groupStorageTypeFromCode :: H5G_storage_type_t -> GroupStorageType
groupStorageTypeFromCode :: H5G_storage_type_t -> GroupStorageType
groupStorageTypeFromCode H5G_storage_type_t
c
    | H5G_storage_type_t
c H5G_storage_type_t -> H5G_storage_type_t -> Bool
forall a. Eq a => a -> a -> Bool
== H5G_storage_type_t
h5g_STORAGE_TYPE_COMPACT         = GroupStorageType
CompactStorage
    | H5G_storage_type_t
c H5G_storage_type_t -> H5G_storage_type_t -> Bool
forall a. Eq a => a -> a -> Bool
== H5G_storage_type_t
h5g_STORAGE_TYPE_DENSE           = GroupStorageType
DenseStorage
    | H5G_storage_type_t
c H5G_storage_type_t -> H5G_storage_type_t -> Bool
forall a. Eq a => a -> a -> Bool
== H5G_storage_type_t
h5g_STORAGE_TYPE_SYMBOL_TABLE    = GroupStorageType
SymbolTableStorage
    | Bool
otherwise                             = GroupStorageType
UnknownStorage

data GroupInfo = GroupInfo
    { GroupInfo -> GroupStorageType
groupStorageType  :: !GroupStorageType
    , GroupInfo -> HSize
groupNLinks       :: !HSize
    , GroupInfo -> Int64
groupMaxCOrder    :: !Int64
    , GroupInfo -> Bool
groupMounted      :: !Bool
    } deriving (GroupInfo -> GroupInfo -> Bool
(GroupInfo -> GroupInfo -> Bool)
-> (GroupInfo -> GroupInfo -> Bool) -> Eq GroupInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupInfo -> GroupInfo -> Bool
$c/= :: GroupInfo -> GroupInfo -> Bool
== :: GroupInfo -> GroupInfo -> Bool
$c== :: GroupInfo -> GroupInfo -> Bool
Eq, Eq GroupInfo
Eq GroupInfo
-> (GroupInfo -> GroupInfo -> Ordering)
-> (GroupInfo -> GroupInfo -> Bool)
-> (GroupInfo -> GroupInfo -> Bool)
-> (GroupInfo -> GroupInfo -> Bool)
-> (GroupInfo -> GroupInfo -> Bool)
-> (GroupInfo -> GroupInfo -> GroupInfo)
-> (GroupInfo -> GroupInfo -> GroupInfo)
-> Ord GroupInfo
GroupInfo -> GroupInfo -> Bool
GroupInfo -> GroupInfo -> Ordering
GroupInfo -> GroupInfo -> GroupInfo
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 :: GroupInfo -> GroupInfo -> GroupInfo
$cmin :: GroupInfo -> GroupInfo -> GroupInfo
max :: GroupInfo -> GroupInfo -> GroupInfo
$cmax :: GroupInfo -> GroupInfo -> GroupInfo
>= :: GroupInfo -> GroupInfo -> Bool
$c>= :: GroupInfo -> GroupInfo -> Bool
> :: GroupInfo -> GroupInfo -> Bool
$c> :: GroupInfo -> GroupInfo -> Bool
<= :: GroupInfo -> GroupInfo -> Bool
$c<= :: GroupInfo -> GroupInfo -> Bool
< :: GroupInfo -> GroupInfo -> Bool
$c< :: GroupInfo -> GroupInfo -> Bool
compare :: GroupInfo -> GroupInfo -> Ordering
$ccompare :: GroupInfo -> GroupInfo -> Ordering
Ord, ReadPrec [GroupInfo]
ReadPrec GroupInfo
Int -> ReadS GroupInfo
ReadS [GroupInfo]
(Int -> ReadS GroupInfo)
-> ReadS [GroupInfo]
-> ReadPrec GroupInfo
-> ReadPrec [GroupInfo]
-> Read GroupInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GroupInfo]
$creadListPrec :: ReadPrec [GroupInfo]
readPrec :: ReadPrec GroupInfo
$creadPrec :: ReadPrec GroupInfo
readList :: ReadS [GroupInfo]
$creadList :: ReadS [GroupInfo]
readsPrec :: Int -> ReadS GroupInfo
$creadsPrec :: Int -> ReadS GroupInfo
Read, Int -> GroupInfo -> ShowS
[GroupInfo] -> ShowS
GroupInfo -> String
(Int -> GroupInfo -> ShowS)
-> (GroupInfo -> String)
-> ([GroupInfo] -> ShowS)
-> Show GroupInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupInfo] -> ShowS
$cshowList :: [GroupInfo] -> ShowS
show :: GroupInfo -> String
$cshow :: GroupInfo -> String
showsPrec :: Int -> GroupInfo -> ShowS
$cshowsPrec :: Int -> GroupInfo -> ShowS
Show)

readGroupInfo :: H5G_info_t -> GroupInfo
readGroupInfo :: H5G_info_t -> GroupInfo
readGroupInfo (H5G_info_t H5G_storage_type_t
a HSize_t
b Int64
c HBool_t
d) = GroupStorageType -> HSize -> Int64 -> Bool -> GroupInfo
GroupInfo (H5G_storage_type_t -> GroupStorageType
groupStorageTypeFromCode H5G_storage_type_t
a) (HSize_t -> HSize
HSize HSize_t
b) Int64
c (HBool_t -> Bool
hboolToBool HBool_t
d)

getGroupInfo :: Group -> IO GroupInfo
getGroupInfo :: Group -> IO GroupInfo
getGroupInfo (Group HId_t
group_id) =
    (H5G_info_t -> GroupInfo) -> IO H5G_info_t -> IO GroupInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap H5G_info_t -> GroupInfo
readGroupInfo (IO H5G_info_t -> IO GroupInfo) -> IO H5G_info_t -> IO GroupInfo
forall a b. (a -> b) -> a -> b
$
        (Out H5G_info_t -> IO ()) -> IO H5G_info_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out H5G_info_t -> IO ()) -> IO H5G_info_t)
-> (Out H5G_info_t -> IO ()) -> IO H5G_info_t
forall a b. (a -> b) -> a -> b
$ \Out H5G_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 H5G_info_t -> IO HErr_t
h5g_get_info HId_t
group_id Out H5G_info_t
info

getGroupInfoByName :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO GroupInfo
getGroupInfoByName :: forall loc.
Location loc =>
loc -> ByteString -> Maybe LAPL -> IO GroupInfo
getGroupInfoByName loc
loc ByteString
name Maybe LAPL
lapl =
    (H5G_info_t -> GroupInfo) -> IO H5G_info_t -> IO GroupInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap H5G_info_t -> GroupInfo
readGroupInfo (IO H5G_info_t -> IO GroupInfo) -> IO H5G_info_t -> IO GroupInfo
forall a b. (a -> b) -> a -> b
$
        (Out H5G_info_t -> IO ()) -> IO H5G_info_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out H5G_info_t -> IO ()) -> IO H5G_info_t)
-> (Out H5G_info_t -> IO ()) -> IO H5G_info_t
forall a b. (a -> b) -> a -> b
$ \Out H5G_info_t
info ->
            ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
                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 -> CString -> Out H5G_info_t -> HId_t -> IO HErr_t
h5g_get_info_by_name (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cname Out H5G_info_t
info (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)