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


{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
module Bindings.HDF5.File
    ( AccFlags(..)
    , ObjType(..)
    , Scope(..)

    , isHDF5

    , File
    , createFile
    , openFile
    , reopenFile
    , flushFile
    , closeFile

    , mountFile
    , unmountFile

    , getFileSize
    , getFileCreatePlist
    , getFileAccessPlist

    , FileInfo(..)
    , getFileInfo
    , getFileIntent
    , getFileName
    , getFileObjCount

    , getOpenObjects
    , getFileFreespace
--    , get_mdc_config
--    , get_mdc_hit_rate
--    , get_mdc_size
--    , clear_elink_file_cache
--    , reset_mdc_hit_rate_stats
--    , set_mdc_config
    ) where

import Bindings.HDF5.Core
import Bindings.HDF5.Error
import Bindings.HDF5.Object
import Bindings.HDF5.PropertyList.FAPL
import Bindings.HDF5.PropertyList.FCPL
import Bindings.HDF5.PropertyList.FMPL
import Bindings.HDF5.Raw.H5
import Bindings.HDF5.Raw.H5F
import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5P
import Data.Bits
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.Vector.Storable as SV
import Foreign.C
import Foreign.Ptr
import Foreign.Ptr.Conventions
import Foreign.Storable

-- TODO: determine whether all of these are valid for _both_ create and open.
-- any that are not should be converted to Bool inputs to the corresponding function.
-- It very well may be best to separate several of them out like that anyway.
data AccFlags
    = ReadOnly
    | ReadWrite
    | Truncate
    | FailIfExists
    | Debug
    | Create
    deriving (AccFlags -> AccFlags -> Bool
(AccFlags -> AccFlags -> Bool)
-> (AccFlags -> AccFlags -> Bool) -> Eq AccFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccFlags -> AccFlags -> Bool
== :: AccFlags -> AccFlags -> Bool
$c/= :: AccFlags -> AccFlags -> Bool
/= :: AccFlags -> AccFlags -> Bool
Eq, Eq AccFlags
Eq AccFlags =>
(AccFlags -> AccFlags -> Ordering)
-> (AccFlags -> AccFlags -> Bool)
-> (AccFlags -> AccFlags -> Bool)
-> (AccFlags -> AccFlags -> Bool)
-> (AccFlags -> AccFlags -> Bool)
-> (AccFlags -> AccFlags -> AccFlags)
-> (AccFlags -> AccFlags -> AccFlags)
-> Ord AccFlags
AccFlags -> AccFlags -> Bool
AccFlags -> AccFlags -> Ordering
AccFlags -> AccFlags -> AccFlags
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 :: AccFlags -> AccFlags -> Ordering
compare :: AccFlags -> AccFlags -> Ordering
$c< :: AccFlags -> AccFlags -> Bool
< :: AccFlags -> AccFlags -> Bool
$c<= :: AccFlags -> AccFlags -> Bool
<= :: AccFlags -> AccFlags -> Bool
$c> :: AccFlags -> AccFlags -> Bool
> :: AccFlags -> AccFlags -> Bool
$c>= :: AccFlags -> AccFlags -> Bool
>= :: AccFlags -> AccFlags -> Bool
$cmax :: AccFlags -> AccFlags -> AccFlags
max :: AccFlags -> AccFlags -> AccFlags
$cmin :: AccFlags -> AccFlags -> AccFlags
min :: AccFlags -> AccFlags -> AccFlags
Ord, Int -> AccFlags
AccFlags -> Int
AccFlags -> [AccFlags]
AccFlags -> AccFlags
AccFlags -> AccFlags -> [AccFlags]
AccFlags -> AccFlags -> AccFlags -> [AccFlags]
(AccFlags -> AccFlags)
-> (AccFlags -> AccFlags)
-> (Int -> AccFlags)
-> (AccFlags -> Int)
-> (AccFlags -> [AccFlags])
-> (AccFlags -> AccFlags -> [AccFlags])
-> (AccFlags -> AccFlags -> [AccFlags])
-> (AccFlags -> AccFlags -> AccFlags -> [AccFlags])
-> Enum AccFlags
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AccFlags -> AccFlags
succ :: AccFlags -> AccFlags
$cpred :: AccFlags -> AccFlags
pred :: AccFlags -> AccFlags
$ctoEnum :: Int -> AccFlags
toEnum :: Int -> AccFlags
$cfromEnum :: AccFlags -> Int
fromEnum :: AccFlags -> Int
$cenumFrom :: AccFlags -> [AccFlags]
enumFrom :: AccFlags -> [AccFlags]
$cenumFromThen :: AccFlags -> AccFlags -> [AccFlags]
enumFromThen :: AccFlags -> AccFlags -> [AccFlags]
$cenumFromTo :: AccFlags -> AccFlags -> [AccFlags]
enumFromTo :: AccFlags -> AccFlags -> [AccFlags]
$cenumFromThenTo :: AccFlags -> AccFlags -> AccFlags -> [AccFlags]
enumFromThenTo :: AccFlags -> AccFlags -> AccFlags -> [AccFlags]
Enum, AccFlags
AccFlags -> AccFlags -> Bounded AccFlags
forall a. a -> a -> Bounded a
$cminBound :: AccFlags
minBound :: AccFlags
$cmaxBound :: AccFlags
maxBound :: AccFlags
Bounded, ReadPrec [AccFlags]
ReadPrec AccFlags
Int -> ReadS AccFlags
ReadS [AccFlags]
(Int -> ReadS AccFlags)
-> ReadS [AccFlags]
-> ReadPrec AccFlags
-> ReadPrec [AccFlags]
-> Read AccFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AccFlags
readsPrec :: Int -> ReadS AccFlags
$creadList :: ReadS [AccFlags]
readList :: ReadS [AccFlags]
$creadPrec :: ReadPrec AccFlags
readPrec :: ReadPrec AccFlags
$creadListPrec :: ReadPrec [AccFlags]
readListPrec :: ReadPrec [AccFlags]
Read, Int -> AccFlags -> ShowS
[AccFlags] -> ShowS
AccFlags -> String
(Int -> AccFlags -> ShowS)
-> (AccFlags -> String) -> ([AccFlags] -> ShowS) -> Show AccFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccFlags -> ShowS
showsPrec :: Int -> AccFlags -> ShowS
$cshow :: AccFlags -> String
show :: AccFlags -> String
$cshowList :: [AccFlags] -> ShowS
showList :: [AccFlags] -> ShowS
Show)

accFlagToInt :: AccFlags -> CUInt
accFlagToInt :: AccFlags -> CUInt
accFlagToInt AccFlags
ReadOnly       = CUInt
forall a. Num a => a
h5f_ACC_RDONLY
accFlagToInt AccFlags
ReadWrite      = CUInt
forall a. Num a => a
h5f_ACC_RDWR
accFlagToInt AccFlags
Truncate       = CUInt
forall a. Num a => a
h5f_ACC_TRUNC
accFlagToInt AccFlags
FailIfExists   = CUInt
forall a. Num a => a
h5f_ACC_EXCL
accFlagToInt AccFlags
Debug          = CUInt
forall a. Num a => a
h5f_ACC_DEBUG
accFlagToInt AccFlags
Create         = CUInt
forall a. Num a => a
h5f_ACC_CREAT

accFlagsToInt :: [AccFlags] -> CUInt
accFlagsToInt :: [AccFlags] -> CUInt
accFlagsToInt = (CUInt -> CUInt -> CUInt) -> CUInt -> [CUInt] -> CUInt
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
(.|.) CUInt
0 ([CUInt] -> CUInt)
-> ([AccFlags] -> [CUInt]) -> [AccFlags] -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccFlags -> CUInt) -> [AccFlags] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map AccFlags -> CUInt
accFlagToInt

intToAccFlags :: CUInt -> [AccFlags]
intToAccFlags :: CUInt -> [AccFlags]
intToAccFlags CUInt
x =
    [ AccFlags
f
    | AccFlags
f <- [AccFlags
forall a. Bounded a => a
minBound .. AccFlags
forall a. Bounded a => a
maxBound]
    , AccFlags -> CUInt
accFlagToInt AccFlags
f CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0
    ]

instance Storable [AccFlags] where
    sizeOf :: [AccFlags] -> Int
sizeOf    [AccFlags]
_ = CUInt -> Int
forall a. Storable a => a -> Int
sizeOf (CUInt
0 :: CUInt)
    alignment :: [AccFlags] -> Int
alignment [AccFlags]
_ = CUInt -> Int
forall a. Storable a => a -> Int
alignment (CUInt
0 :: CUInt)
    peek :: Ptr [AccFlags] -> IO [AccFlags]
peek        = (CUInt -> [AccFlags]) -> IO CUInt -> IO [AccFlags]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> [AccFlags]
intToAccFlags (IO CUInt -> IO [AccFlags])
-> (Ptr [AccFlags] -> IO CUInt) -> Ptr [AccFlags] -> IO [AccFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CUInt -> IO CUInt)
-> (Ptr [AccFlags] -> Ptr CUInt) -> Ptr [AccFlags] -> IO CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr [AccFlags] -> Ptr CUInt
forall a b. Ptr a -> Ptr b
castPtr
    poke :: Ptr [AccFlags] -> [AccFlags] -> IO ()
poke Ptr [AccFlags]
p      = Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr [AccFlags] -> Ptr CUInt
forall a b. Ptr a -> Ptr b
castPtr Ptr [AccFlags]
p) (CUInt -> IO ()) -> ([AccFlags] -> CUInt) -> [AccFlags] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccFlags] -> CUInt
accFlagsToInt

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

objTypeToInt :: ObjType -> CUInt
objTypeToInt :: ObjType -> CUInt
objTypeToInt ObjType
Files      = CUInt
forall a. Num a => a
h5f_OBJ_FILE
objTypeToInt ObjType
Datasets   = CUInt
forall a. Num a => a
h5f_OBJ_DATASET
objTypeToInt ObjType
Groups     = CUInt
forall a. Num a => a
h5f_OBJ_GROUP
objTypeToInt ObjType
Datatypes  = CUInt
forall a. Num a => a
h5f_OBJ_DATATYPE
objTypeToInt ObjType
Attrs      = CUInt
forall a. Num a => a
h5f_OBJ_ATTR
objTypeToInt ObjType
All        = CUInt
forall a. Num a => a
h5f_OBJ_ALL

objTypesToInt :: [ObjType] -> CUInt
objTypesToInt :: [ObjType] -> CUInt
objTypesToInt = (CUInt -> CUInt -> CUInt) -> CUInt -> [CUInt] -> CUInt
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
(.|.) CUInt
0 ([CUInt] -> CUInt) -> ([ObjType] -> [CUInt]) -> [ObjType] -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ObjType -> CUInt) -> [ObjType] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map ObjType -> CUInt
objTypeToInt

intToObjTypes :: CUInt -> [ObjType]
intToObjTypes :: CUInt -> [ObjType]
intToObjTypes CUInt
x =
    [ ObjType
f
    | ObjType
f <- [ObjType
forall a. Bounded a => a
minBound .. ObjType
forall a. Bounded a => a
maxBound]
    , ObjType -> CUInt
objTypeToInt ObjType
f CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
x CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CUInt
0
    ]

instance Storable [ObjType] where
    sizeOf :: [ObjType] -> Int
sizeOf    [ObjType]
_ = CUInt -> Int
forall a. Storable a => a -> Int
sizeOf (CUInt
0 :: CUInt)
    alignment :: [ObjType] -> Int
alignment [ObjType]
_ = CUInt -> Int
forall a. Storable a => a -> Int
alignment (CUInt
0 :: CUInt)
    peek :: Ptr [ObjType] -> IO [ObjType]
peek        = (CUInt -> [ObjType]) -> IO CUInt -> IO [ObjType]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> [ObjType]
intToObjTypes (IO CUInt -> IO [ObjType])
-> (Ptr [ObjType] -> IO CUInt) -> Ptr [ObjType] -> IO [ObjType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CUInt -> IO CUInt)
-> (Ptr [ObjType] -> Ptr CUInt) -> Ptr [ObjType] -> IO CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr [ObjType] -> Ptr CUInt
forall a b. Ptr a -> Ptr b
castPtr
    poke :: Ptr [ObjType] -> [ObjType] -> IO ()
poke Ptr [ObjType]
p      = Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr [ObjType] -> Ptr CUInt
forall a b. Ptr a -> Ptr b
castPtr Ptr [ObjType]
p) (CUInt -> IO ()) -> ([ObjType] -> CUInt) -> [ObjType] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ObjType] -> CUInt
objTypesToInt

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

scopeCode :: Scope -> H5F_scope_t
scopeCode :: Scope -> H5F_scope_t
scopeCode Scope
Local  = H5F_scope_t
h5f_SCOPE_LOCAL
scopeCode Scope
Global = H5F_scope_t
h5f_SCOPE_GLOBAL

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

rawCloseDegreesInv :: [(H5F_close_degree_t, Maybe CloseDegree)]
rawCloseDegreesInv :: [(H5F_close_degree_t, Maybe CloseDegree)]
rawCloseDegreesInv = [(H5F_close_degree_t
a,Maybe CloseDegree
b) | (Maybe CloseDegree
b,H5F_close_degree_t
a) <- [(Maybe CloseDegree, H5F_close_degree_t)]
rawCloseDegrees]
rawCloseDegrees :: [(Maybe CloseDegree, H5F_close_degree_t)]
rawCloseDegrees :: [(Maybe CloseDegree, H5F_close_degree_t)]
rawCloseDegrees =
    [ (Maybe CloseDegree
forall a. Maybe a
Nothing,     H5F_close_degree_t
h5f_CLOSE_DEFAULT)
    , (CloseDegree -> Maybe CloseDegree
forall a. a -> Maybe a
Just CloseDegree
Weak,   H5F_close_degree_t
h5f_CLOSE_WEAK)
    , (CloseDegree -> Maybe CloseDegree
forall a. a -> Maybe a
Just CloseDegree
Semi,   H5F_close_degree_t
h5f_CLOSE_SEMI)
    , (CloseDegree -> Maybe CloseDegree
forall a. a -> Maybe a
Just CloseDegree
Strong, H5F_close_degree_t
h5f_CLOSE_STRONG)
    ]

closeDegreeFromCode :: H5F_close_degree_t -> Maybe CloseDegree
closeDegreeFromCode :: H5F_close_degree_t -> Maybe CloseDegree
closeDegreeFromCode H5F_close_degree_t
c = Maybe CloseDegree -> Maybe (Maybe CloseDegree) -> Maybe CloseDegree
forall a. a -> Maybe a -> a
fromMaybe Maybe CloseDegree
forall a. Maybe a
Nothing (H5F_close_degree_t
-> [(H5F_close_degree_t, Maybe CloseDegree)]
-> Maybe (Maybe CloseDegree)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup H5F_close_degree_t
c [(H5F_close_degree_t, Maybe CloseDegree)]
rawCloseDegreesInv)

closeDegreeToCode :: Maybe CloseDegree -> H5F_close_degree_t
closeDegreeToCode :: Maybe CloseDegree -> H5F_close_degree_t
closeDegreeToCode Maybe CloseDegree
c =
    H5F_close_degree_t
-> Maybe H5F_close_degree_t -> H5F_close_degree_t
forall a. a -> Maybe a -> a
fromMaybe (String -> H5F_close_degree_t
forall a. HasCallStack => String -> a
error (String
"closeDegreeToCode: unrecognized H5F_close_degree_t: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe CloseDegree -> String
forall a. Show a => a -> String
show Maybe CloseDegree
c))
                  (Maybe CloseDegree
-> [(Maybe CloseDegree, H5F_close_degree_t)]
-> Maybe H5F_close_degree_t
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Maybe CloseDegree
c [(Maybe CloseDegree, H5F_close_degree_t)]
rawCloseDegrees)

instance Storable (Maybe CloseDegree) where
    sizeOf :: Maybe CloseDegree -> Int
sizeOf Maybe CloseDegree
_    = H5F_close_degree_t -> Int
forall a. Storable a => a -> Int
sizeOf    (H5F_close_degree_t
forall a. HasCallStack => a
undefined :: H5F_close_degree_t)
    alignment :: Maybe CloseDegree -> Int
alignment Maybe CloseDegree
_ = H5F_close_degree_t -> Int
forall a. Storable a => a -> Int
alignment (H5F_close_degree_t
forall a. HasCallStack => a
undefined :: H5F_close_degree_t)
    peek :: Ptr (Maybe CloseDegree) -> IO (Maybe CloseDegree)
peek        = (H5F_close_degree_t -> Maybe CloseDegree)
-> IO H5F_close_degree_t -> IO (Maybe CloseDegree)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap H5F_close_degree_t -> Maybe CloseDegree
closeDegreeFromCode (IO H5F_close_degree_t -> IO (Maybe CloseDegree))
-> (Ptr (Maybe CloseDegree) -> IO H5F_close_degree_t)
-> Ptr (Maybe CloseDegree)
-> IO (Maybe CloseDegree)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr H5F_close_degree_t -> IO H5F_close_degree_t
forall a. Storable a => Ptr a -> IO a
peek (Ptr H5F_close_degree_t -> IO H5F_close_degree_t)
-> (Ptr (Maybe CloseDegree) -> Ptr H5F_close_degree_t)
-> Ptr (Maybe CloseDegree)
-> IO H5F_close_degree_t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Maybe CloseDegree) -> Ptr H5F_close_degree_t
forall a b. Ptr a -> Ptr b
castPtr
    poke :: Ptr (Maybe CloseDegree) -> Maybe CloseDegree -> IO ()
poke Ptr (Maybe CloseDegree)
p      = Ptr H5F_close_degree_t -> H5F_close_degree_t -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Maybe CloseDegree) -> Ptr H5F_close_degree_t
forall a b. Ptr a -> Ptr b
castPtr Ptr (Maybe CloseDegree)
p) (H5F_close_degree_t -> IO ())
-> (Maybe CloseDegree -> H5F_close_degree_t)
-> Maybe CloseDegree
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CloseDegree -> H5F_close_degree_t
closeDegreeToCode

isHDF5 :: BS.ByteString -> IO Bool
isHDF5 :: ByteString -> IO Bool
isHDF5 ByteString
filename = IO HTri_t -> IO Bool
htriToBool (ByteString -> (CString -> IO HTri_t) -> IO HTri_t
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
filename CString -> IO HTri_t
h5f_is_hdf5)

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

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

createFile :: BS.ByteString -> [AccFlags] -> Maybe FCPL -> Maybe FAPL -> IO File
createFile :: ByteString -> [AccFlags] -> Maybe FCPL -> Maybe FAPL -> IO File
createFile ByteString
filename [AccFlags]
flags Maybe FCPL
create_plist Maybe FAPL
access_plist =
    (HId_t -> File) -> IO HId_t -> IO File
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> File
File (IO HId_t -> IO File) -> IO HId_t -> IO File
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
filename ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cfilename ->
                CString -> CUInt -> HId_t -> HId_t -> IO HId_t
h5f_create CString
cfilename ([AccFlags] -> CUInt
accFlagsToInt [AccFlags]
flags) (HId_t -> (FCPL -> HId_t) -> Maybe FCPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT FCPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe FCPL
create_plist) (HId_t -> (FAPL -> HId_t) -> Maybe FAPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT FAPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe FAPL
access_plist)

openFile :: BS.ByteString -> [AccFlags] -> Maybe FAPL -> IO File
openFile :: ByteString -> [AccFlags] -> Maybe FAPL -> IO File
openFile ByteString
filename [AccFlags]
flags Maybe FAPL
access_plist =
    (HId_t -> File) -> IO HId_t -> IO File
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> File
File (IO HId_t -> IO File) -> IO HId_t -> IO File
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
filename ((CString -> IO HId_t) -> IO HId_t)
-> (CString -> IO HId_t) -> IO HId_t
forall a b. (a -> b) -> a -> b
$ \CString
cfilename ->
                CString -> CUInt -> HId_t -> IO HId_t
h5f_open CString
cfilename ([AccFlags] -> CUInt
accFlagsToInt [AccFlags]
flags) (HId_t -> (FAPL -> HId_t) -> Maybe FAPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT FAPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe FAPL
access_plist)

reopenFile :: File -> IO File
reopenFile :: File -> IO File
reopenFile (File HId_t
file_id) =
    (HId_t -> File) -> IO HId_t -> IO File
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> File
File (IO HId_t -> IO File) -> IO HId_t -> IO File
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 -> IO HId_t
h5f_reopen HId_t
file_id

flushFile :: File -> Scope -> IO ()
flushFile :: File -> Scope -> IO ()
flushFile (File HId_t
file_id) Scope
scope =
    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 -> H5F_scope_t -> IO HErr_t
h5f_flush HId_t
file_id (Scope -> H5F_scope_t
scopeCode Scope
scope)

closeFile :: File -> IO ()
closeFile :: File -> IO ()
closeFile (File HId_t
file_id) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (HId_t -> IO HErr_t
h5f_close HId_t
file_id)

mountFile :: Location loc => loc -> BS.ByteString -> File -> Maybe FMPL -> IO ()
mountFile :: forall loc.
Location loc =>
loc -> ByteString -> File -> Maybe FMPL -> IO ()
mountFile loc
loc ByteString
groupname (File HId_t
file_id) Maybe FMPL
mount_plist =
    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
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 -> HId_t -> HId_t -> IO HErr_t
h5f_mount (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cgroupname HId_t
file_id (HId_t -> (FMPL -> HId_t) -> Maybe FMPL -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HId_t
h5p_DEFAULT FMPL -> HId_t
forall t. HId t => t -> HId_t
hid Maybe FMPL
mount_plist)

unmountFile :: Location loc => loc -> BS.ByteString -> IO ()
unmountFile :: forall loc. Location loc => loc -> ByteString -> IO ()
unmountFile loc
loc ByteString
groupname =
    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
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 -> IO HErr_t
h5f_unmount (loc -> HId_t
forall t. HId t => t -> HId_t
hid loc
loc) CString
cgroupname

getFileSize :: File -> IO HSize
getFileSize :: File -> IO HSize
getFileSize (File HId_t
file_id) =
    (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
$
        (Out HSize_t -> IO HErr_t) -> IO HSize_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out HSize_t -> IO HErr_t) -> IO HSize_t)
-> (Out HSize_t -> IO HErr_t) -> IO HSize_t
forall a b. (a -> b) -> a -> b
$ \Out HSize_t
sz ->
            IO HErr_t -> IO HErr_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HErr_t -> IO HErr_t) -> IO HErr_t -> IO HErr_t
forall a b. (a -> b) -> a -> b
$
                HId_t -> Out HSize_t -> IO HErr_t
h5f_get_filesize HId_t
file_id Out HSize_t
sz

getFileCreatePlist :: File -> IO FCPL
getFileCreatePlist :: File -> IO FCPL
getFileCreatePlist (File HId_t
file_id) =
    (HId_t -> FCPL) -> IO HId_t -> IO FCPL
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> FCPL
forall t. FromHId t => HId_t -> t
uncheckedFromHId (IO HId_t -> IO FCPL) -> IO HId_t -> IO FCPL
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 -> IO HId_t
h5f_get_create_plist HId_t
file_id

getFileAccessPlist :: File -> IO FAPL
getFileAccessPlist :: File -> IO FAPL
getFileAccessPlist (File HId_t
file_id) =
    (HId_t -> FAPL) -> IO HId_t -> IO FAPL
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> FAPL
forall t. FromHId t => HId_t -> t
uncheckedFromHId (IO HId_t -> IO FAPL) -> IO HId_t -> IO FAPL
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 -> IO HId_t
h5f_get_access_plist HId_t
file_id

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

readFileInfo1 :: H5F_info1_t -> FileInfo
readFileInfo1 :: H5F_info1_t -> FileInfo
readFileInfo1 (H5F_info1_t HSize_t
a HSize_t
b (H5_ih_info_t HSize_t
c HSize_t
d)) = HSize -> HSize -> IH_Info -> FileInfo
FileInfo (HSize_t -> HSize
HSize HSize_t
a) (HSize_t -> HSize
HSize HSize_t
b) (HSize -> HSize -> IH_Info
IH_Info (HSize_t -> HSize
HSize HSize_t
c) (HSize_t -> HSize
HSize HSize_t
d))

getFileInfo :: Object obj => obj -> IO FileInfo
getFileInfo :: forall obj. Object obj => obj -> IO FileInfo
getFileInfo obj
obj =
    (H5F_info1_t -> FileInfo) -> IO H5F_info1_t -> IO FileInfo
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap H5F_info1_t -> FileInfo
readFileInfo1 (IO H5F_info1_t -> IO FileInfo) -> IO H5F_info1_t -> IO FileInfo
forall a b. (a -> b) -> a -> b
$
        (Out H5F_info1_t -> IO HErr_t) -> IO H5F_info1_t
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out H5F_info1_t -> IO HErr_t) -> IO H5F_info1_t)
-> (Out H5F_info1_t -> IO HErr_t) -> IO H5F_info1_t
forall a b. (a -> b) -> a -> b
$ \Out H5F_info1_t
info ->
            IO HErr_t -> IO HErr_t
forall t. HDFResultType t => IO t -> IO t
withErrorCheck (IO HErr_t -> IO HErr_t) -> IO HErr_t -> IO HErr_t
forall a b. (a -> b) -> a -> b
$
                HId_t -> Out H5F_info1_t -> IO HErr_t
h5f_get_info1 (obj -> HId_t
forall t. HId t => t -> HId_t
hid obj
obj) Out H5F_info1_t
info

getFileIntent :: File -> IO [AccFlags]
getFileIntent :: File -> IO [AccFlags]
getFileIntent (File HId_t
file_id) =
    (CUInt -> [AccFlags]) -> IO CUInt -> IO [AccFlags]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> [AccFlags]
intToAccFlags (IO CUInt -> IO [AccFlags]) -> IO CUInt -> IO [AccFlags]
forall a b. (a -> b) -> a -> b
$
        (Out CUInt -> IO ()) -> IO CUInt
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CUInt -> IO ()) -> IO CUInt)
-> (Out CUInt -> IO ()) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Out CUInt
intent ->
            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 CUInt -> IO HErr_t
h5f_get_intent HId_t
file_id Out CUInt
intent

getFileName :: File -> IO BS.ByteString
getFileName :: File -> IO ByteString
getFileName (File HId_t
file_id) =
    (OutArray CChar -> CSize -> 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 -> CSize -> IO CSSize) -> IO ByteString)
-> (OutArray CChar -> CSize -> IO CSSize) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \OutArray CChar
buf CSize
bufSz ->
        (CSSize -> Bool) -> IO CSSize -> IO CSSize
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen (CSSize -> CSSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSSize
0) (IO CSSize -> IO CSSize) -> IO CSSize -> IO CSSize
forall a b. (a -> b) -> a -> b
$
            HId_t -> OutArray CChar -> CSize -> IO CSSize
h5f_get_name HId_t
file_id OutArray CChar
buf CSize
bufSz

getFileObjCount :: Maybe File -> Bool -> [ObjType] -> IO CSize
getFileObjCount :: Maybe File -> Bool -> [ObjType] -> IO CSize
getFileObjCount Maybe File
mbFile Bool
local [ObjType]
objTypes =
    (CSSize -> CSize) -> IO CSSize -> IO CSize
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CSSize -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CSSize -> IO CSize) -> IO CSSize -> IO CSize
forall a b. (a -> b) -> a -> b
$
        (CSSize -> Bool) -> IO CSSize -> IO CSSize
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen (CSSize -> CSSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSSize
0) (IO CSSize -> IO CSSize) -> IO CSSize -> IO CSSize
forall a b. (a -> b) -> a -> b
$
            HId_t -> CUInt -> IO CSSize
h5f_get_obj_count (HId_t -> (File -> HId_t) -> Maybe File -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64 -> HId_t
HId_t Int64
forall a. Num a => a
h5f_OBJ_ALL) File -> HId_t
forall t. HId t => t -> HId_t
hid Maybe File
mbFile) ([ObjType] -> CUInt
objTypesToInt [ObjType]
objTypes CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. if Bool
local then CUInt
0 else CUInt
forall a. Num a => a
h5f_OBJ_LOCAL)

getOpenObjects :: Maybe File -> Bool -> [ObjType] -> IO (SV.Vector ObjectId)
getOpenObjects :: Maybe File -> Bool -> [ObjType] -> IO (Vector ObjectId)
getOpenObjects Maybe File
mbFile Bool
local [ObjType]
objTypes = do
    CSize
n <- Maybe File -> Bool -> [ObjType] -> IO CSize
getFileObjCount Maybe File
mbFile Bool
local [ObjType]
objTypes

    Int -> (OutArray ObjectId -> IO CSSize) -> IO (Vector ObjectId)
forall a b.
(Storable a, Integral b) =>
Int -> (OutArray a -> IO b) -> IO (Vector a)
withOutVector' (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
n) ((OutArray ObjectId -> IO CSSize) -> IO (Vector ObjectId))
-> (OutArray ObjectId -> IO CSSize) -> IO (Vector ObjectId)
forall a b. (a -> b) -> a -> b
$ \OutArray ObjectId
objects ->
        (CSSize -> Bool) -> IO CSSize -> IO CSSize
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen (CSSize -> CSSize -> Bool
forall a. Ord a => a -> a -> Bool
< CSSize
0) (IO CSSize -> IO CSSize) -> IO CSSize -> IO CSSize
forall a b. (a -> b) -> a -> b
$
            HId_t -> CUInt -> CSize -> OutArray HId_t -> IO CSSize
h5f_get_obj_ids (HId_t -> (File -> HId_t) -> Maybe File -> HId_t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64 -> HId_t
HId_t Int64
forall a. Num a => a
h5f_OBJ_ALL) File -> HId_t
forall t. HId t => t -> HId_t
hid Maybe File
mbFile) ([ObjType] -> CUInt
objTypesToInt [ObjType]
objTypes CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. if Bool
local then CUInt
0 else CUInt
forall a. Num a => a
h5f_OBJ_LOCAL) CSize
n (OutArray ObjectId -> OutArray HId_t
forall a b. OutArray a -> OutArray b
forall (p :: * -> *) a b. WrappedPtr p => p a -> p b
castWrappedPtr OutArray ObjectId
objects)

getFileFreespace :: File -> IO HSize
getFileFreespace :: File -> IO HSize
getFileFreespace (File HId_t
file_id) =
    (HSSize_t -> HSize) -> IO HSSize_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 HSSize_t -> HSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO HSSize_t -> IO HSize) -> IO HSSize_t -> IO HSize
forall a b. (a -> b) -> a -> b
$
        (HSSize_t -> Bool) -> IO HSSize_t -> IO HSSize_t
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen (HSSize_t -> HSSize_t -> Bool
forall a. Ord a => a -> a -> Bool
< HSSize_t
0) (IO HSSize_t -> IO HSSize_t) -> IO HSSize_t -> IO HSSize_t
forall a b. (a -> b) -> a -> b
$
            HId_t -> IO HSSize_t
h5f_get_freespace HId_t
file_id