{-# LINE 1 "src/Bindings/HDF5/Link.hsc" #-}




{-# LINE 5 "src/Bindings/HDF5/Link.hsc" #-}


{-# LINE 7 "src/Bindings/HDF5/Link.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
{-

  h5l_get_info_by_idx           	[ FAIL ]
  h5l_iterate                   	[  OK  ]
  h5l_register                  	[ FAIL ]
  h5l_iterate_by_name           	[  OK  ]
  h5l_unpack_elink_val          	[ FAIL ]
  h5l_get_val_by_idx            	[ FAIL ]
  h5l_create_external           	[  OK  ]
  h5l_exists                    	[  OK  ]
  h5l_move                      	[  OK  ]
  h5l_create_ud                 	[ FAIL ]
  h5l_create_hard               	[  OK  ]
  h5l_is_registered             	[ FAIL ]
  h5l_get_name_by_idx           	[  OK  ]
  h5l_create_soft               	[  OK  ]
  h5l_copy                      	[  OK  ]
  h5l_get_val                   	[  OK  ]
  h5l_visit                     	[  OK  ]
  h5l_get_info                  	[  OK  ]
  h5l_delete_by_idx             	[ FAIL ]
  h5l_visit_by_name             	[  OK  ]
  h5l_delete                    	[  OK  ]
  h5l_unregister                	[ FAIL ]

-}
module Bindings.HDF5.Link
    ( createHardLink
    , createSoftLink
    , createExternalLink

    , getLinkNameByIdx

    , doesLinkExist

    , moveLink
    , copyLink
    , deleteLink

    , LinkType(..)
    , LinkInfo(..)
    , getLinkInfo

    , getSymLinkVal

    , iterateLinks
    , iterateLinksByName

    , visitLinks
    , visitLinksByName
    ) where

import           Bindings.HDF5.Core
import           Bindings.HDF5.Datatype.Internal
import           Bindings.HDF5.Error
import           Bindings.HDF5.Group
import           Bindings.HDF5.PropertyList.LAPL
import           Bindings.HDF5.PropertyList.LCPL
import           Bindings.HDF5.Raw.H5
import           Bindings.HDF5.Raw.H5L
import           Bindings.HDF5.Raw.H5P
import           Bindings.HDF5.Raw.Util
import           Control.Exception               (SomeException, finally,
                                                  throwIO, try)
import qualified Data.ByteString                 as BS
import           Data.IORef
import           Foreign
import           Foreign.C
import           Foreign.Ptr.Conventions

{-# ANN module "HLint: ignore Use camelCase" #-}

createHardLink :: (Location src, Location dst) => src -> BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO ()
createHardLink :: forall src dst.
(Location src, Location dst) =>
src
-> ByteString
-> dst
-> ByteString
-> Maybe LCPL
-> Maybe LAPL
-> IO ()
createHardLink src
src ByteString
srcName dst
dst ByteString
dstName Maybe LCPL
lcpl Maybe LAPL
lapl =
    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
$
        ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
srcName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
csrcName ->
            ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
dstName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cdstName ->
                HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
h5l_create_hard (src -> HId_t
forall t. HId t => t -> HId_t
hid src
src) CString
csrcName (dst -> HId_t
forall t. HId t => t -> HId_t
hid dst
dst) CString
cdstName
                    (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 -> (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)

createSoftLink :: Location dst => BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO ()
createSoftLink :: forall dst.
Location dst =>
ByteString
-> dst -> ByteString -> Maybe LCPL -> Maybe LAPL -> IO ()
createSoftLink ByteString
srcName dst
dst ByteString
dstName Maybe LCPL
lcpl Maybe LAPL
lapl =
    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
$
        ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
srcName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
csrcName ->
            ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
dstName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cdstName ->
                CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
h5l_create_soft CString
csrcName (dst -> HId_t
forall t. HId t => t -> HId_t
hid dst
dst) CString
cdstName
                    (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 -> (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)

createExternalLink :: Location loc => BS.ByteString -> BS.ByteString -> loc -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO ()
createExternalLink :: forall loc.
Location loc =>
ByteString
-> ByteString
-> loc
-> ByteString
-> Maybe LCPL
-> Maybe LAPL
-> IO ()
createExternalLink ByteString
file ByteString
obj loc
loc ByteString
name Maybe LCPL
lcpl Maybe LAPL
lapl =
    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
$
        ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
file ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cfile ->
            ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
obj ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cobj ->
                ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
                    CString
-> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
h5l_create_external CString
cfile CString
cobj (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
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 -> (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)

getLinkNameByIdx :: Location loc =>  loc -> BS.ByteString -> IndexType -> IterOrder -> HSize -> Maybe LAPL -> IO BS.ByteString
getLinkNameByIdx :: forall loc.
Location loc =>
loc
-> ByteString
-> IndexType
-> IterOrder
-> HSize
-> Maybe LAPL
-> IO ByteString
getLinkNameByIdx loc
loc ByteString
group IndexType
indexType IterOrder
order HSize
idx Maybe LAPL
lapl =
  (OutArray CChar -> CSSize -> IO CSSize) -> IO ByteString
forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m, Integral a, Integral b) =>
(OutArray CChar -> a -> m b) -> m ByteString
withOutByteString' ((OutArray CChar -> CSSize -> IO CSSize) -> IO ByteString)
-> (OutArray CChar -> CSSize -> IO CSSize) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \OutArray CChar
cname CSSize
nameSize ->
  ByteString -> (CString -> IO CSSize) -> IO CSSize
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
group ((CString -> IO CSSize) -> IO CSSize)
-> (CString -> IO CSSize) -> IO CSSize
forall a b. (a -> b) -> a -> b
$ \CString
cgroup ->
  HId_t
-> CString
-> H5_index_t
-> H5_iter_order_t
-> HSize_t
-> OutArray CChar
-> CSSize
-> HId_t
-> IO CSSize
h5l_get_name_by_idx (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cgroup (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) (HSize -> HSize_t
hSize HSize
idx) OutArray CChar
cname CSSize
nameSize (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)

doesLinkExist :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO Bool
doesLinkExist :: forall loc.
Location loc =>
loc -> ByteString -> Maybe LAPL -> IO Bool
doesLinkExist loc
loc ByteString
name Maybe LAPL
lapl =
    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
name ((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 -> HId_t -> IO HTri_t
h5l_exists (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cname (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)

moveLink :: (Location src, Location dst) => src -> BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO ()
moveLink :: forall src dst.
(Location src, Location dst) =>
src
-> ByteString
-> dst
-> ByteString
-> Maybe LCPL
-> Maybe LAPL
-> IO ()
moveLink  src
src ByteString
srcName dst
dst ByteString
dstName Maybe LCPL
lcpl Maybe LAPL
lapl =
    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
$
        ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
srcName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
csrcName ->
            ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
dstName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cdstName ->
                HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
h5l_move (src -> HId_t
forall t. HId t => t -> HId_t
hid src
src) CString
csrcName (dst -> HId_t
forall t. HId t => t -> HId_t
hid dst
dst) CString
cdstName
                    (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 -> (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)

copyLink :: (Location src, Location dst) => src -> BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO ()
copyLink :: forall src dst.
(Location src, Location dst) =>
src
-> ByteString
-> dst
-> ByteString
-> Maybe LCPL
-> Maybe LAPL
-> IO ()
copyLink  src
src ByteString
srcName dst
dst ByteString
dstName Maybe LCPL
lcpl Maybe LAPL
lapl =
    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
$
        ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
srcName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
csrcName ->
            ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
dstName ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cdstName ->
                HId_t -> CString -> HId_t -> CString -> HId_t -> HId_t -> IO HErr_t
h5l_copy (src -> HId_t
forall t. HId t => t -> HId_t
hid src
src) CString
csrcName (dst -> HId_t
forall t. HId t => t -> HId_t
hid dst
dst) CString
cdstName
                    (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 -> (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)

deleteLink :: Location t => t -> BS.ByteString -> Maybe LAPL -> IO ()
deleteLink :: forall t. Location t => t -> ByteString -> Maybe LAPL -> IO ()
deleteLink t
loc ByteString
name Maybe LAPL
lapl =
    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
$
        ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
            HId_t -> CString -> HId_t -> IO HErr_t
h5l_delete (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) CString
cname (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)

data LinkType
    = External
    | Hard
    | Soft
    | OtherLinkType !H5L_type_t
    deriving (LinkType -> LinkType -> Bool
(LinkType -> LinkType -> Bool)
-> (LinkType -> LinkType -> Bool) -> Eq LinkType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkType -> LinkType -> Bool
== :: LinkType -> LinkType -> Bool
$c/= :: LinkType -> LinkType -> Bool
/= :: LinkType -> LinkType -> Bool
Eq, Eq LinkType
Eq LinkType =>
(LinkType -> LinkType -> Ordering)
-> (LinkType -> LinkType -> Bool)
-> (LinkType -> LinkType -> Bool)
-> (LinkType -> LinkType -> Bool)
-> (LinkType -> LinkType -> Bool)
-> (LinkType -> LinkType -> LinkType)
-> (LinkType -> LinkType -> LinkType)
-> Ord LinkType
LinkType -> LinkType -> Bool
LinkType -> LinkType -> Ordering
LinkType -> LinkType -> LinkType
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 :: LinkType -> LinkType -> Ordering
compare :: LinkType -> LinkType -> Ordering
$c< :: LinkType -> LinkType -> Bool
< :: LinkType -> LinkType -> Bool
$c<= :: LinkType -> LinkType -> Bool
<= :: LinkType -> LinkType -> Bool
$c> :: LinkType -> LinkType -> Bool
> :: LinkType -> LinkType -> Bool
$c>= :: LinkType -> LinkType -> Bool
>= :: LinkType -> LinkType -> Bool
$cmax :: LinkType -> LinkType -> LinkType
max :: LinkType -> LinkType -> LinkType
$cmin :: LinkType -> LinkType -> LinkType
min :: LinkType -> LinkType -> LinkType
Ord, ReadPrec [LinkType]
ReadPrec LinkType
Int -> ReadS LinkType
ReadS [LinkType]
(Int -> ReadS LinkType)
-> ReadS [LinkType]
-> ReadPrec LinkType
-> ReadPrec [LinkType]
-> Read LinkType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LinkType
readsPrec :: Int -> ReadS LinkType
$creadList :: ReadS [LinkType]
readList :: ReadS [LinkType]
$creadPrec :: ReadPrec LinkType
readPrec :: ReadPrec LinkType
$creadListPrec :: ReadPrec [LinkType]
readListPrec :: ReadPrec [LinkType]
Read, Int -> LinkType -> ShowS
[LinkType] -> ShowS
LinkType -> String
(Int -> LinkType -> ShowS)
-> (LinkType -> String) -> ([LinkType] -> ShowS) -> Show LinkType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkType -> ShowS
showsPrec :: Int -> LinkType -> ShowS
$cshow :: LinkType -> String
show :: LinkType -> String
$cshowList :: [LinkType] -> ShowS
showList :: [LinkType] -> ShowS
Show)

linkTypeFromCode :: H5L_type_t -> LinkType
linkTypeFromCode :: H5L_type_t -> LinkType
linkTypeFromCode H5L_type_t
c
    | H5L_type_t
c H5L_type_t -> H5L_type_t -> Bool
forall a. Eq a => a -> a -> Bool
== H5L_type_t
h5l_TYPE_EXTERNAL    = LinkType
External
    | H5L_type_t
c H5L_type_t -> H5L_type_t -> Bool
forall a. Eq a => a -> a -> Bool
== H5L_type_t
h5l_TYPE_HARD        = LinkType
Hard
    | H5L_type_t
c H5L_type_t -> H5L_type_t -> Bool
forall a. Eq a => a -> a -> Bool
== H5L_type_t
h5l_TYPE_SOFT        = LinkType
Soft
    | H5L_type_t
c H5L_type_t -> H5L_type_t -> Bool
forall a. Ord a => a -> a -> Bool
>= H5L_type_t
h5l_TYPE_UD_MIN      = H5L_type_t -> LinkType
OtherLinkType H5L_type_t
c
    | Bool
otherwise                 = String -> LinkType
forall a. HasCallStack => String -> a
error (String
"Unknown link type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ H5L_type_t -> String
forall a. Show a => a -> String
show H5L_type_t
c)


data LinkInfo = LinkInfo
    { LinkInfo -> LinkType
linkType        :: LinkType
    , LinkInfo -> Bool
linkCOrderValid :: Bool
    , LinkInfo -> Int64
linkCOrder      :: Int64
    , LinkInfo -> CSet
linkCSet        :: CSet
    , LinkInfo -> CSize
linkValSize     :: CSize
    } deriving (LinkInfo -> LinkInfo -> Bool
(LinkInfo -> LinkInfo -> Bool)
-> (LinkInfo -> LinkInfo -> Bool) -> Eq LinkInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkInfo -> LinkInfo -> Bool
== :: LinkInfo -> LinkInfo -> Bool
$c/= :: LinkInfo -> LinkInfo -> Bool
/= :: LinkInfo -> LinkInfo -> Bool
Eq, Eq LinkInfo
Eq LinkInfo =>
(LinkInfo -> LinkInfo -> Ordering)
-> (LinkInfo -> LinkInfo -> Bool)
-> (LinkInfo -> LinkInfo -> Bool)
-> (LinkInfo -> LinkInfo -> Bool)
-> (LinkInfo -> LinkInfo -> Bool)
-> (LinkInfo -> LinkInfo -> LinkInfo)
-> (LinkInfo -> LinkInfo -> LinkInfo)
-> Ord LinkInfo
LinkInfo -> LinkInfo -> Bool
LinkInfo -> LinkInfo -> Ordering
LinkInfo -> LinkInfo -> LinkInfo
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 :: LinkInfo -> LinkInfo -> Ordering
compare :: LinkInfo -> LinkInfo -> Ordering
$c< :: LinkInfo -> LinkInfo -> Bool
< :: LinkInfo -> LinkInfo -> Bool
$c<= :: LinkInfo -> LinkInfo -> Bool
<= :: LinkInfo -> LinkInfo -> Bool
$c> :: LinkInfo -> LinkInfo -> Bool
> :: LinkInfo -> LinkInfo -> Bool
$c>= :: LinkInfo -> LinkInfo -> Bool
>= :: LinkInfo -> LinkInfo -> Bool
$cmax :: LinkInfo -> LinkInfo -> LinkInfo
max :: LinkInfo -> LinkInfo -> LinkInfo
$cmin :: LinkInfo -> LinkInfo -> LinkInfo
min :: LinkInfo -> LinkInfo -> LinkInfo
Ord, ReadPrec [LinkInfo]
ReadPrec LinkInfo
Int -> ReadS LinkInfo
ReadS [LinkInfo]
(Int -> ReadS LinkInfo)
-> ReadS [LinkInfo]
-> ReadPrec LinkInfo
-> ReadPrec [LinkInfo]
-> Read LinkInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LinkInfo
readsPrec :: Int -> ReadS LinkInfo
$creadList :: ReadS [LinkInfo]
readList :: ReadS [LinkInfo]
$creadPrec :: ReadPrec LinkInfo
readPrec :: ReadPrec LinkInfo
$creadListPrec :: ReadPrec [LinkInfo]
readListPrec :: ReadPrec [LinkInfo]
Read, Int -> LinkInfo -> ShowS
[LinkInfo] -> ShowS
LinkInfo -> String
(Int -> LinkInfo -> ShowS)
-> (LinkInfo -> String) -> ([LinkInfo] -> ShowS) -> Show LinkInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkInfo -> ShowS
showsPrec :: Int -> LinkInfo -> ShowS
$cshow :: LinkInfo -> String
show :: LinkInfo -> String
$cshowList :: [LinkInfo] -> ShowS
showList :: [LinkInfo] -> ShowS
Show)


{-# LINE 168 "src/Bindings/HDF5/Link.hsc" #-}


{-# LINE 170 "src/Bindings/HDF5/Link.hsc" #-}

readLinkInfo :: H5L_info_t -> LinkInfo
readLinkInfo :: H5L_info_t -> LinkInfo
readLinkInfo H5L_info_t
i  = LinkInfo
    { linkType :: LinkType
linkType          = H5L_type_t -> LinkType
linkTypeFromCode (H5L_info_t -> H5L_type_t
h5l_info1_t'type H5L_info_t
i)
    , linkCOrderValid :: Bool
linkCOrderValid   = HBool_t -> Bool
hboolToBool (H5L_info_t -> HBool_t
h5l_info1_t'corder_valid H5L_info_t
i)
    , linkCOrder :: Int64
linkCOrder        = H5L_info_t -> Int64
h5l_info1_t'corder H5L_info_t
i
    , linkCSet :: CSet
linkCSet          = H5T_cset_t -> CSet
cSetFromCode (H5L_info_t -> H5T_cset_t
h5l_info1_t'cset H5L_info_t
i)
    , linkValSize :: CSize
linkValSize       = H5L_info_t -> CSize
h5l_info1_t'u'val_size H5L_info_t
i
    }


{-# LINE 192 "src/Bindings/HDF5/Link.hsc" #-}


{-# LINE 205 "src/Bindings/HDF5/Link.hsc" #-}

getLinkInfo :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO LinkInfo
getLinkInfo :: forall loc.
Location loc =>
loc -> ByteString -> Maybe LAPL -> IO LinkInfo
getLinkInfo loc
loc ByteString
name Maybe LAPL
lapl =
    (H5L_info_t -> LinkInfo) -> IO H5L_info_t -> IO LinkInfo
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap H5L_info_t -> LinkInfo
readLinkInfo (IO H5L_info_t -> IO LinkInfo) -> IO H5L_info_t -> IO LinkInfo
forall a b. (a -> b) -> a -> b
$
        (Out H5L_info_t -> IO ()) -> IO H5L_info_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out H5L_info_t -> IO ()) -> IO H5L_info_t)
-> (Out H5L_info_t -> IO ()) -> IO H5L_info_t
forall a b. (a -> b) -> a -> b
$ \Out H5L_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
$
                ByteString -> (CString -> IO HErr_t) -> IO HErr_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO HErr_t) -> IO HErr_t)
-> (CString -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
                    HId_t -> CString -> Out H5L_info_t -> HId_t -> IO HErr_t
h5l_get_info (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cname Out H5L_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)

getSymLinkVal :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO BS.ByteString
getSymLinkVal :: forall loc.
Location loc =>
loc -> ByteString -> Maybe LAPL -> IO ByteString
getSymLinkVal loc
loc ByteString
name Maybe LAPL
mb_lapl =
    ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
cname -> do
        let lapl :: HId_t
lapl = 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
mb_lapl
        H5L_info_t
info <- (Out H5L_info_t -> IO ()) -> IO H5L_info_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out H5L_info_t -> IO ()) -> IO H5L_info_t)
-> (Out H5L_info_t -> IO ()) -> IO H5L_info_t
forall a b. (a -> b) -> a -> b
$ \Out H5L_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 -> CString -> Out H5L_info_t -> HId_t -> IO HErr_t
h5l_get_info (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cname Out H5L_info_t
info HId_t
lapl
        let n :: CSize
n = LinkInfo -> CSize
linkValSize (LinkInfo -> CSize)
-> (H5L_info_t -> LinkInfo) -> H5L_info_t -> CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H5L_info_t -> LinkInfo
readLinkInfo (H5L_info_t -> CSize) -> H5L_info_t -> CSize
forall a b. (a -> b) -> a -> b
$ H5L_info_t
info

        CString
buf <- Int -> IO CString
forall a. Int -> IO (Ptr a)
mallocBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
n)

        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 -> OutArray CChar -> CSize -> HId_t -> IO HErr_t
forall a.
HId_t -> CString -> OutArray a -> CSize -> HId_t -> IO HErr_t
h5l_get_val (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cname (CString -> OutArray CChar
forall a. Ptr a -> OutArray a
OutArray CString
buf) CSize
n HId_t
lapl
        -- TODO: this will leak memory if an exception is thrown

        CStringLen -> IO ByteString
BS.packCStringLen (CString
buf, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
n)

with_iterate_t :: (Group -> BS.ByteString -> LinkInfo -> IO HErr_t)
     -> (H5L_iterate_t () -> InOut () -> IO HErr_t)
     -> IO HErr_t
with_iterate_t :: (Group -> ByteString -> LinkInfo -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_iterate_t Group -> ByteString -> LinkInfo -> IO HErr_t
op H5L_iterate_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))

    H5L_iterate_t ()
op1 <- (HId_t -> CString -> In H5L_info_t -> InOut () -> IO HErr_t)
-> IO (H5L_iterate_t ())
forall a.
(HId_t -> CString -> In H5L_info_t -> InOut a -> IO HErr_t)
-> IO
     (FunPtr
        (HId_t -> CString -> In H5L_info_t -> InOut a -> IO HErr_t))
mk'H5L_iterate_t ((HId_t -> CString -> In H5L_info_t -> InOut () -> IO HErr_t)
 -> IO (H5L_iterate_t ()))
-> (HId_t -> CString -> In H5L_info_t -> InOut () -> IO HErr_t)
-> IO (H5L_iterate_t ())
forall a b. (a -> b) -> a -> b
$ \HId_t
grp CString
name (In Ptr H5L_info_t
link) InOut ()
_opData -> do
        ByteString
name1 <- CString -> IO ByteString
BS.packCString CString
name
        H5L_info_t
link1 <- Ptr H5L_info_t -> IO H5L_info_t
forall a. Storable a => Ptr a -> IO a
peek Ptr H5L_info_t
link
        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 -> LinkInfo -> IO HErr_t
op (HId_t -> Group
forall t. FromHId t => HId_t -> t
uncheckedFromHId HId_t
grp) ByteString
name1 (H5L_info_t -> LinkInfo
readLinkInfo H5L_info_t
link1))
        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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HErr_t
x

    HErr_t
result <- H5L_iterate_t () -> InOut () -> IO HErr_t
f H5L_iterate_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` H5L_iterate_t () -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr H5L_iterate_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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HErr_t
result

-- TODO : It would be nice if we didn't expose HErr_t in these callback functions.
--        Decide whether we want Either or Exceptions.
iterateLinks :: Location t => t -> IndexType -> IterOrder -> Maybe HSize -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO HSize
iterateLinks :: forall t.
Location t =>
t
-> IndexType
-> IterOrder
-> Maybe HSize
-> (Group -> ByteString -> LinkInfo -> IO HErr_t)
-> IO HSize
iterateLinks t
loc IndexType
indexType IterOrder
order Maybe HSize
startIndex Group -> ByteString -> LinkInfo -> IO HErr_t
op =
    (HSize_t -> HSize) -> IO HSize_t -> IO HSize
forall a b. (a -> b) -> IO a -> IO b
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 -> LinkInfo -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_iterate_t Group -> ByteString -> LinkInfo -> IO HErr_t
op ((H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \H5L_iterate_t ()
iop InOut ()
opData ->
                    HId_t
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5L_iterate_t ()
-> InOut ()
-> IO HErr_t
forall a.
HId_t
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5L_iterate_t a
-> InOut a
-> IO HErr_t
h5l_iterate (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) InOut HSize_t
ioStartIndex H5L_iterate_t ()
iop InOut ()
opData

iterateLinksByName :: Location t => t -> BS.ByteString -> IndexType -> IterOrder -> Maybe HSize -> Maybe LAPL -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO HSize
iterateLinksByName :: forall t.
Location t =>
t
-> ByteString
-> IndexType
-> IterOrder
-> Maybe HSize
-> Maybe LAPL
-> (Group -> ByteString -> LinkInfo -> IO HErr_t)
-> IO HSize
iterateLinksByName t
loc ByteString
groupName IndexType
indexType IterOrder
order Maybe HSize
startIndex Maybe LAPL
lapl Group -> ByteString -> LinkInfo -> IO HErr_t
op =
    (HSize_t -> HSize) -> IO HSize_t -> IO HSize
forall a b. (a -> b) -> IO a -> IO b
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 -> LinkInfo -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_iterate_t Group -> ByteString -> LinkInfo -> IO HErr_t
op ((H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \H5L_iterate_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
-> H5L_iterate_t ()
-> InOut ()
-> HId_t
-> IO HErr_t
forall a.
HId_t
-> CString
-> H5_index_t
-> H5_iter_order_t
-> InOut HSize_t
-> H5L_iterate_t a
-> InOut a
-> HId_t
-> IO HErr_t
h5l_iterate_by_name (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) CString
cgroupName (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) InOut HSize_t
ioStartIndex H5L_iterate_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)

visitLinks :: Location t => t -> IndexType -> IterOrder -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO ()
visitLinks :: forall t.
Location t =>
t
-> IndexType
-> IterOrder
-> (Group -> ByteString -> LinkInfo -> IO HErr_t)
-> IO ()
visitLinks t
loc IndexType
indexType IterOrder
order Group -> ByteString -> LinkInfo -> IO HErr_t
op =
    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 -> LinkInfo -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_iterate_t Group -> ByteString -> LinkInfo -> IO HErr_t
op ((H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \H5L_iterate_t ()
iop InOut ()
opData ->
            HId_t
-> H5_index_t
-> H5_iter_order_t
-> H5L_iterate_t ()
-> InOut ()
-> IO HErr_t
forall a.
HId_t
-> H5_index_t
-> H5_iter_order_t
-> H5L_iterate_t a
-> InOut a
-> IO HErr_t
h5l_visit (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) H5L_iterate_t ()
iop InOut ()
opData

visitLinksByName :: Location t => t -> BS.ByteString -> IndexType -> IterOrder -> Maybe LAPL -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO ()
visitLinksByName :: forall t.
Location t =>
t
-> ByteString
-> IndexType
-> IterOrder
-> Maybe LAPL
-> (Group -> ByteString -> LinkInfo -> IO HErr_t)
-> IO ()
visitLinksByName t
loc ByteString
groupName IndexType
indexType IterOrder
order Maybe LAPL
lapl Group -> ByteString -> LinkInfo -> IO HErr_t
op =
    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 -> LinkInfo -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
with_iterate_t Group -> ByteString -> LinkInfo -> IO HErr_t
op ((H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t)
-> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t
forall a b. (a -> b) -> a -> b
$ \H5L_iterate_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
-> H5L_iterate_t ()
-> InOut ()
-> HId_t
-> IO HErr_t
forall a.
HId_t
-> CString
-> H5_index_t
-> H5_iter_order_t
-> H5L_iterate_t a
-> InOut a
-> HId_t
-> IO HErr_t
h5l_visit_by_name (t -> HId_t
forall t. HId t => t -> HId_t
hid t
loc) CString
cgroupName (IndexType -> H5_index_t
indexTypeCode IndexType
indexType) (IterOrder -> H5_iter_order_t
iterOrderCode IterOrder
order) H5L_iterate_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)