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



module Bindings.HDF5.Raw.H5R where

import Data.ByteString
import Data.Int
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable

import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5G
import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5O


import Foreign.Ptr.Conventions

-- |Reference types allowed
newtype H5R_type_t = H5R_type_t Int32 deriving (Ptr H5R_type_t -> IO H5R_type_t
Ptr H5R_type_t -> Int -> IO H5R_type_t
Ptr H5R_type_t -> Int -> H5R_type_t -> IO ()
Ptr H5R_type_t -> H5R_type_t -> IO ()
H5R_type_t -> Int
(H5R_type_t -> Int)
-> (H5R_type_t -> Int)
-> (Ptr H5R_type_t -> Int -> IO H5R_type_t)
-> (Ptr H5R_type_t -> Int -> H5R_type_t -> IO ())
-> (forall b. Ptr b -> Int -> IO H5R_type_t)
-> (forall b. Ptr b -> Int -> H5R_type_t -> IO ())
-> (Ptr H5R_type_t -> IO H5R_type_t)
-> (Ptr H5R_type_t -> H5R_type_t -> IO ())
-> Storable H5R_type_t
forall b. Ptr b -> Int -> IO H5R_type_t
forall b. Ptr b -> Int -> H5R_type_t -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: H5R_type_t -> Int
sizeOf :: H5R_type_t -> Int
$calignment :: H5R_type_t -> Int
alignment :: H5R_type_t -> Int
$cpeekElemOff :: Ptr H5R_type_t -> Int -> IO H5R_type_t
peekElemOff :: Ptr H5R_type_t -> Int -> IO H5R_type_t
$cpokeElemOff :: Ptr H5R_type_t -> Int -> H5R_type_t -> IO ()
pokeElemOff :: Ptr H5R_type_t -> Int -> H5R_type_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO H5R_type_t
peekByteOff :: forall b. Ptr b -> Int -> IO H5R_type_t
$cpokeByteOff :: forall b. Ptr b -> Int -> H5R_type_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> H5R_type_t -> IO ()
$cpeek :: Ptr H5R_type_t -> IO H5R_type_t
peek :: Ptr H5R_type_t -> IO H5R_type_t
$cpoke :: Ptr H5R_type_t -> H5R_type_t -> IO ()
poke :: Ptr H5R_type_t -> H5R_type_t -> IO ()
Storable, Int -> H5R_type_t -> ShowS
[H5R_type_t] -> ShowS
H5R_type_t -> String
(Int -> H5R_type_t -> ShowS)
-> (H5R_type_t -> String)
-> ([H5R_type_t] -> ShowS)
-> Show H5R_type_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H5R_type_t -> ShowS
showsPrec :: Int -> H5R_type_t -> ShowS
$cshow :: H5R_type_t -> String
show :: H5R_type_t -> String
$cshowList :: [H5R_type_t] -> ShowS
showList :: [H5R_type_t] -> ShowS
Show)

{-# LINE 24 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |invalid Reference Type
h5r_BADTYPE :: H5R_type_t
h5r_BADTYPE :: H5R_type_t
h5r_BADTYPE = Int32 -> H5R_type_t
H5R_type_t (-Int32
1)

{-# LINE 27 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Object reference
h5r_OBJECT :: H5R_type_t
h5r_OBJECT :: H5R_type_t
h5r_OBJECT = Int32 -> H5R_type_t
H5R_type_t (Int32
0)

{-# LINE 30 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Dataset Region Reference
h5r_DATASET_REGION :: H5R_type_t
h5r_DATASET_REGION :: H5R_type_t
h5r_DATASET_REGION = Int32 -> H5R_type_t
H5R_type_t (Int32
1)

{-# LINE 33 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Number of reference types
h5r_MAXTYPE = 5
h5r_MAXTYPE :: (Num a) => a

{-# LINE 36 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

h5r_OBJ_REF_BUF_SIZE
{-# LINE 38 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
  :: CSize
h5r_OBJ_REF_BUF_SIZE :: CSize
h5r_OBJ_REF_BUF_SIZE
{-# LINE 40 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
    = 8
{-# LINE 41 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

newtype HObj_ref_t = HObj_ref_t Word64 deriving (Ptr HObj_ref_t -> IO HObj_ref_t
Ptr HObj_ref_t -> Int -> IO HObj_ref_t
Ptr HObj_ref_t -> Int -> HObj_ref_t -> IO ()
Ptr HObj_ref_t -> HObj_ref_t -> IO ()
HObj_ref_t -> Int
(HObj_ref_t -> Int)
-> (HObj_ref_t -> Int)
-> (Ptr HObj_ref_t -> Int -> IO HObj_ref_t)
-> (Ptr HObj_ref_t -> Int -> HObj_ref_t -> IO ())
-> (forall b. Ptr b -> Int -> IO HObj_ref_t)
-> (forall b. Ptr b -> Int -> HObj_ref_t -> IO ())
-> (Ptr HObj_ref_t -> IO HObj_ref_t)
-> (Ptr HObj_ref_t -> HObj_ref_t -> IO ())
-> Storable HObj_ref_t
forall b. Ptr b -> Int -> IO HObj_ref_t
forall b. Ptr b -> Int -> HObj_ref_t -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: HObj_ref_t -> Int
sizeOf :: HObj_ref_t -> Int
$calignment :: HObj_ref_t -> Int
alignment :: HObj_ref_t -> Int
$cpeekElemOff :: Ptr HObj_ref_t -> Int -> IO HObj_ref_t
peekElemOff :: Ptr HObj_ref_t -> Int -> IO HObj_ref_t
$cpokeElemOff :: Ptr HObj_ref_t -> Int -> HObj_ref_t -> IO ()
pokeElemOff :: Ptr HObj_ref_t -> Int -> HObj_ref_t -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO HObj_ref_t
peekByteOff :: forall b. Ptr b -> Int -> IO HObj_ref_t
$cpokeByteOff :: forall b. Ptr b -> Int -> HObj_ref_t -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> HObj_ref_t -> IO ()
$cpeek :: Ptr HObj_ref_t -> IO HObj_ref_t
peek :: Ptr HObj_ref_t -> IO HObj_ref_t
$cpoke :: Ptr HObj_ref_t -> HObj_ref_t -> IO ()
poke :: Ptr HObj_ref_t -> HObj_ref_t -> IO ()
Storable, Int -> HObj_ref_t -> ShowS
[HObj_ref_t] -> ShowS
HObj_ref_t -> String
(Int -> HObj_ref_t -> ShowS)
-> (HObj_ref_t -> String)
-> ([HObj_ref_t] -> ShowS)
-> Show HObj_ref_t
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HObj_ref_t -> ShowS
showsPrec :: Int -> HObj_ref_t -> ShowS
$cshow :: HObj_ref_t -> String
show :: HObj_ref_t -> String
$cshowList :: [HObj_ref_t] -> ShowS
showList :: [HObj_ref_t] -> ShowS
Show)

{-# LINE 43 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

h5r_DSET_REG_REF_BUF_SIZE
{-# LINE 45 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
  :: CSize
h5r_DSET_REG_REF_BUF_SIZE :: CSize
h5r_DSET_REG_REF_BUF_SIZE
{-# LINE 47 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
    = 12
{-# LINE 48 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Buffer to store heap ID and index
--
-- > typedef unsigned char hdset_reg_ref_t[H5R_DSET_REG_REF_BUF_SIZE];
newtype HDset_reg_ref_t
{-# LINE 53 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
    =   HDset_reg_ref_t
{-# LINE 54 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
    ByteString


-- |Creates a particular type of reference specified with 'ref_type', in the
-- space pointed to by 'ref'.  The 'loc_id' and 'name' are used to locate the object
-- pointed to and the 'space_id' is used to choose the region pointed to (for
-- Dataset Region references).
--
-- Parameters:
--
-- [@ ref      :: 'Out' a      @] Reference created
--
-- [@ loc_id   :: 'HId_t'      @] Location ID used to locate object pointed to
--
-- [@ name     :: 'CString'    @] Name of object at location LOC_ID of object pointed to
--
-- [@ ref_type :: 'H5R_type_t' @] Type of reference to create
--
-- [@ space_id :: 'HId_t'      @] Dataspace ID with selection, used for Dataset Region references.
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Rcreate(void *ref, hid_t loc_id, const char *name,
-- >        H5R_type_t ref_type, hid_t space_id);
foreign import ccall "H5Rcreate" h5r_create
  :: Out a -> HId_t -> CString -> H5R_type_t -> HId_t -> IO HErr_t
foreign import ccall "&H5Rcreate" p_H5Rcreate
  :: FunPtr (Out a -> HId_t -> CString -> H5R_type_t -> HId_t -> IO HErr_t)

{-# LINE 79 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Retrieves a dataspace with the region pointed to selected.
-- Given a reference to some object, creates a copy of the dataset pointed
-- to's dataspace and defines a selection in the copy which is the region
-- pointed to.
--
-- Parameters:
--
-- [@ id       :: 'HId_t'      @]   Dataset reference object is in or location ID of object that the dataset is located within.
--
-- [@ ref_type :: 'H5R_type_t' @]   Type of reference to get region of
--
-- [@ ref      :: 'In' a       @]   Reference to open.
--
-- Returns a valid ID on success, negative on failure.
--
-- > hid_t H5Rget_region(hid_t dataset, H5R_type_t ref_type, const void *ref);
foreign import ccall "H5Rget_region" h5r_get_region
  :: HId_t -> H5R_type_t -> In a -> IO HId_t
foreign import ccall "&H5Rget_region" p_H5Rget_region
  :: FunPtr (HId_t -> H5R_type_t -> In a -> IO HId_t)

{-# LINE 97 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Given a reference to some object, this function retrieves the type of
-- object pointed to.
--
-- Parameters:
--
-- [@ id       :: 'HId_t'            @] Dataset reference object is in or location ID of object that the dataset is located within.
--
-- [@ ref_type :: 'H5R_type_t'       @] Type of reference to query
--
-- [@ ref      :: 'In' a             @] Reference to query.
--
-- [@ obj_type :: 'Out' 'H5O_type_t' @] Type of object reference points to
--
-- Returns non-negative on success, negative on failure.
--
-- > herr_t H5Rget_obj_type2(hid_t id, H5R_type_t ref_type, const void *_ref,
-- >     H5O_type_t *obj_type);
foreign import ccall "H5Rget_obj_type2" h5r_get_obj_type2
  :: HId_t -> H5R_type_t -> In a -> Out H5O_type_t -> IO HErr_t
foreign import ccall "&H5Rget_obj_type2" p_H5Rget_obj_type2
  :: FunPtr (HId_t -> H5R_type_t -> In a -> Out H5O_type_t -> IO HErr_t)

{-# LINE 116 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Given a reference to some object, determine a path to the object
-- referenced in the file.
--
-- Note:  This may not be the only path to that object.
--
-- Parameters:
--
-- [@ loc_id   :: 'HId_t'       @]  Dataset reference object is in or location ID of object that the dataset is located within.
--
-- [@ ref_type :: 'H5R_type_t'  @]  Type of reference
--
-- [@ ref      :: 'In' a        @]  Reference to query.
--
-- [@ name     :: 'Out' 'CChar' @]  Buffer to place name of object referenced
--
-- [@ size     :: 'CSize'       @]  Size of name buffer
--
-- Returns non-negative length of the path on success, Negative on failure
--
-- > ssize_t H5Rget_name(hid_t loc_id, H5R_type_t ref_type, const void *ref,
-- >     char *name/*out*/, size_t size);
foreign import ccall "H5Rget_name" h5r_get_name
  :: HId_t -> H5R_type_t -> In a -> OutArray CChar -> CSize -> IO CSSize
foreign import ccall "&H5Rget_name" p_H5Rget_name
  :: FunPtr (HId_t -> H5R_type_t -> In a -> OutArray CChar -> CSize -> IO CSSize)

{-# LINE 139 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

--------------------------
-- Compatibility Macros --
--------------------------

-- H5Rdereference

-- |Opens the HDF5 object referenced.  Given a reference to some object,
-- open that object and return an ID for that object.
--
-- Parameters:
--
-- [@ id       :: 'HId_t'      @]   Dataset reference object is in or location ID of object that the dataset is located within.
--
-- [@ ref_type :: 'H5R_type_t' @]   Type of reference to create
--
-- [@ ref      :: 'In' a       @]   Reference to open.
--
-- Returns a valid ID on success, negative on failure
--
-- > hid_t H5Rdereference(hid_t dataset, H5R_type_t ref_type, const void *ref);

-- > hid_t H5Rdereference2(hid_t obj_id, hid_t oapl_id, H5R_type_t ref_type, const void *ref);


{-# LINE 164 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
foreign import ccall "H5Rdereference1" h5r_dereference1
  :: HId_t -> H5R_type_t -> In a -> IO HId_t
foreign import ccall "&H5Rdereference1" p_H5Rdereference1
  :: FunPtr (HId_t -> H5R_type_t -> In a -> IO HId_t)

{-# LINE 165 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
foreign import ccall "H5Rdereference2" h5r_dereference2
  :: HId_t -> HId_t -> H5R_type_t -> In a -> IO HId_t
foreign import ccall "&H5Rdereference2" p_H5Rdereference2
  :: FunPtr (HId_t -> HId_t -> H5R_type_t -> In a -> IO HId_t)

{-# LINE 166 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

{-# LINE 167 "src/Bindings/HDF5/Raw/H5R.hsc" #-}
h5r_dereference :: HId_t -> H5R_type_t -> In a -> IO HId_t
h5r_dereference = h5r_dereference1

{-# LINE 175 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

{-# LINE 178 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

------------------------
-- Deprecated symbols --
------------------------


{-# LINE 184 "src/Bindings/HDF5/Raw/H5R.hsc" #-}

-- |Retrieves the type of object that an object reference points to
-- Given a reference to some object, this function returns the type of object
-- pointed to.
--
-- Parameters:
--
-- [@ id       :: 'HId_t'      @]   Dataset reference object is in or location ID of object that the dataset is located within.
--
-- [@ ref_type :: 'H5R_type_t' @]   Type of reference to query
--
-- [@ ref      :: 'In' a       @]   Reference to query.
--
-- On success, returns an object type defined in "Bindings.HDF5.Raw.H5G"
-- On failure, returns 'h5g_UNKNOWN'
--
-- > H5G_obj_t H5Rget_obj_type1(hid_t id, H5R_type_t ref_type, const void *_ref);
foreign import ccall "H5Rget_obj_type1" h5r_get_obj_type1
  :: HId_t -> H5R_type_t -> In a -> IO H5G_obj_t
foreign import ccall "&H5Rget_obj_type1" p_H5Rget_obj_type1
  :: FunPtr (HId_t -> H5R_type_t -> In a -> IO H5G_obj_t)

{-# LINE 202 "src/Bindings/HDF5/Raw/H5R.hsc" #-}


{-# LINE 204 "src/Bindings/HDF5/Raw/H5R.hsc" #-}