{-# LANGUAGE ForeignFunctionInterface #-} {- 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.H5I 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 src srcName dst dstName lcpl lapl = withErrorCheck_ $ BS.useAsCString srcName $ \csrcName -> BS.useAsCString dstName $ \cdstName -> h5l_create_hard (hid src) csrcName (hid dst) cdstName (maybe h5p_DEFAULT hid lcpl) (maybe h5p_DEFAULT hid lapl) createSoftLink :: Location dst => BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO () createSoftLink srcName dst dstName lcpl lapl = withErrorCheck_ $ BS.useAsCString srcName $ \csrcName -> BS.useAsCString dstName $ \cdstName -> h5l_create_soft csrcName (hid dst) cdstName (maybe h5p_DEFAULT hid lcpl) (maybe h5p_DEFAULT hid lapl) createExternalLink :: Location loc => BS.ByteString -> BS.ByteString -> loc -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO () createExternalLink file obj loc name lcpl lapl = withErrorCheck_ $ BS.useAsCString file $ \cfile -> BS.useAsCString obj $ \cobj -> BS.useAsCString name $ \cname -> h5l_create_external cfile cobj (hid loc) cname (maybe h5p_DEFAULT hid lcpl) (maybe h5p_DEFAULT hid lapl) getLinkNameByIdx :: Location loc => loc -> BS.ByteString -> IndexType -> IterOrder -> HSize -> Maybe LAPL -> IO BS.ByteString getLinkNameByIdx loc group indexType order idx lapl = withOutByteString' $ \cname nameSize -> BS.useAsCString group $ \cgroup -> h5l_get_name_by_idx (hid loc) cgroup (indexTypeCode indexType) (iterOrderCode order) (hSize idx) cname nameSize (maybe h5p_DEFAULT hid lapl) doesLinkExist :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO Bool doesLinkExist loc name lapl = htriToBool $ BS.useAsCString name $ \cname -> h5l_exists (hid loc) cname (maybe h5p_DEFAULT hid lapl) moveLink :: (Location src, Location dst) => src -> BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO () moveLink src srcName dst dstName lcpl lapl = withErrorCheck_ $ BS.useAsCString srcName $ \csrcName -> BS.useAsCString dstName $ \cdstName -> h5l_move (hid src) csrcName (hid dst) cdstName (maybe h5p_DEFAULT hid lcpl) (maybe h5p_DEFAULT hid lapl) copyLink :: (Location src, Location dst) => src -> BS.ByteString -> dst -> BS.ByteString -> Maybe LCPL -> Maybe LAPL -> IO () copyLink src srcName dst dstName lcpl lapl = withErrorCheck_ $ BS.useAsCString srcName $ \csrcName -> BS.useAsCString dstName $ \cdstName -> h5l_copy (hid src) csrcName (hid dst) cdstName (maybe h5p_DEFAULT hid lcpl) (maybe h5p_DEFAULT hid lapl) deleteLink :: Location t => t -> BS.ByteString -> Maybe LAPL -> IO () deleteLink loc name lapl = withErrorCheck_ $ BS.useAsCString name $ \cname -> h5l_delete (hid loc) cname (maybe h5p_DEFAULT hid lapl) data LinkType = External | Hard | Soft | OtherLinkType !H5L_type_t deriving (Eq, Ord, Read, Show) linkTypeFromCode :: H5L_type_t -> LinkType linkTypeFromCode c | c == h5l_TYPE_EXTERNAL = External | c == h5l_TYPE_HARD = Hard | c == h5l_TYPE_SOFT = Soft | c >= h5l_TYPE_UD_MIN = OtherLinkType c | otherwise = error ("Unknown link type: " ++ show c) data LinkInfo = LinkInfo { linkType :: LinkType , linkCOrderValid :: Bool , linkCOrder :: Int64 , linkCSet :: CSet , linkAddress :: HAddr , linkValSize :: CSize } deriving (Eq, Ord, Read, Show) readLinkInfo :: H5L_info_t -> LinkInfo readLinkInfo i = LinkInfo { linkType = linkTypeFromCode (h5l_info_t'type i) , linkCOrderValid = hboolToBool (h5l_info_t'corder_valid i) , linkCOrder = h5l_info_t'corder i , linkCSet = cSetFromCode (h5l_info_t'cset i) , linkAddress = HAddr (h5l_info_t'u'address i) , linkValSize = h5l_info_t'u'val_size i } getLinkInfo :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO LinkInfo getLinkInfo loc name lapl = fmap readLinkInfo $ withOut_ $ \info -> withErrorCheck_ $ BS.useAsCString name $ \cname -> h5l_get_info (hid loc) cname info (maybe h5p_DEFAULT hid lapl) getSymLinkVal :: Location loc => loc -> BS.ByteString -> Maybe LAPL -> IO BS.ByteString getSymLinkVal loc name mb_lapl = BS.useAsCString name $ \cname -> do let lapl = maybe h5p_DEFAULT hid mb_lapl info <- withOut_ $ \info -> withErrorCheck_ $ h5l_get_info (hid loc) cname info lapl let n = h5l_info_t'u'val_size info buf <- mallocBytes (fromIntegral n) withErrorCheck_ $ h5l_get_val (hid loc) cname (OutArray buf) n lapl -- TODO: this will leak memory if an exception is thrown BS.packCStringLen (buf, fromIntegral n) foreign import ccall "wrapper" wrap_H5L_iterate_t :: (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)) with_iterate_t :: (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> (H5L_iterate_t () -> InOut () -> IO HErr_t) -> IO HErr_t with_iterate_t op f = do exception1 <- newIORef Nothing :: IO (IORef (Maybe SomeException)) op1 <- wrap_H5L_iterate_t $ \grp name (In link) _opData -> do name1 <- BS.packCString name link1 <- peek link result <- try (op (uncheckedFromHId grp) name1 (readLinkInfo link1)) case result of Left exc -> do writeIORef exception1 (Just exc) return maxBound Right x -> return x result <- f op1 (InOut nullPtr) `finally` freeHaskellFunPtr op1 if result == maxBound then do exception2 <- readIORef exception1 maybe (return result) throwIO exception2 else return 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 loc indexType order startIndex op = fmap HSize $ withInOut_ (maybe 0 hSize startIndex) $ \ioStartIndex -> withErrorCheck_ $ with_iterate_t op $ \iop opData -> h5l_iterate (hid loc) (indexTypeCode indexType) (iterOrderCode order) ioStartIndex iop opData iterateLinksByName :: Location t => t -> BS.ByteString -> IndexType -> IterOrder -> Maybe HSize -> Maybe LAPL -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO HSize iterateLinksByName loc groupName indexType order startIndex lapl op = fmap HSize $ withInOut_ (maybe 0 hSize startIndex) $ \ioStartIndex -> withErrorCheck_ $ with_iterate_t op $ \iop opData -> BS.useAsCString groupName $ \cgroupName -> h5l_iterate_by_name (hid loc) cgroupName (indexTypeCode indexType) (iterOrderCode order) ioStartIndex iop opData (maybe h5p_DEFAULT hid lapl) visitLinks :: Location t => t -> IndexType -> IterOrder -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO () visitLinks loc indexType order op = withErrorCheck_ $ with_iterate_t op $ \iop opData -> h5l_visit (hid loc) (indexTypeCode indexType) (iterOrderCode order) iop opData visitLinksByName :: Location t => t -> BS.ByteString -> IndexType -> IterOrder -> Maybe LAPL -> (Group -> BS.ByteString -> LinkInfo -> IO HErr_t) -> IO () visitLinksByName loc groupName indexType order lapl op = withErrorCheck_ $ with_iterate_t op $ \iop opData -> BS.useAsCString groupName $ \cgroupName -> h5l_visit_by_name (hid loc) cgroupName (indexTypeCode indexType) (iterOrderCode order) iop opData (maybe h5p_DEFAULT hid lapl)