{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Bindings.HDF5.PropertyList
    ( PropertyListClassID
    , root
    , objectCreate
    , fileCreate
    , fileAccess
    , datasetCreate
    , datasetAccess
    , datasetXfer
    , fileMount
    , groupCreate
    , groupAccess
    , datatypeCreate
    , datatypeAccess
    , stringCreate
    , attributeCreate
    , objectCopy
    , linkCreate
    , linkAccess

    , getClassName

    , PropertyListID
    , PropertyListOrClass
    , PropertyList(..)
    , Tagged(..)
    , castPropertyList

    , createPropertyList
    , createPropertyListWithClass

    , propertyExists
    , getPropertySize
    , getNProps

    , getPropertyListClass
    , getPropertyListClassParent

    , propertyListsEqual

    , propertyListIsA

    , closePropertyListClass
    , closePropertyList
    ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif

import Bindings.HDF5.Raw.H5I
import Bindings.HDF5.Raw.H5P
import Bindings.HDF5.Core
import Bindings.HDF5.Error

import qualified Data.ByteString as BS
import Data.Tagged
import Foreign
import Foreign.C
import Foreign.Ptr.Conventions

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

root, fileCreate, fileAccess, fileMount:: PropertyListClassID
datasetCreate, datasetAccess, datasetXfer :: PropertyListClassID
objectCreate, groupCreate, groupAccess :: PropertyListClassID
datatypeCreate, datatypeAccess :: PropertyListClassID
stringCreate, attributeCreate :: PropertyListClassID
objectCopy, linkCreate, linkAccess :: PropertyListClassID

root :: PropertyListClassID
root                = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_ROOT              -- no parent
objectCreate :: PropertyListClassID
objectCreate        = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_OBJECT_CREATE     -- parent:  root
fileCreate :: PropertyListClassID
fileCreate          = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_FILE_CREATE       -- parent:  groupCreate
fileAccess :: PropertyListClassID
fileAccess          = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_FILE_ACCESS       -- parent:  root
datasetCreate :: PropertyListClassID
datasetCreate       = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_DATASET_CREATE    -- parent:  objectCreate
datasetAccess :: PropertyListClassID
datasetAccess       = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_DATASET_ACCESS    -- parent:  linkAccess
datasetXfer :: PropertyListClassID
datasetXfer         = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_DATASET_XFER      -- parent:  root
fileMount :: PropertyListClassID
fileMount           = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_FILE_MOUNT        -- parent:  root
groupCreate :: PropertyListClassID
groupCreate         = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_GROUP_CREATE      -- parent:  objectCreate
groupAccess :: PropertyListClassID
groupAccess         = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_GROUP_ACCESS      -- parent:  linkAccess
datatypeCreate :: PropertyListClassID
datatypeCreate      = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_DATATYPE_CREATE   -- parent:  objectCreate
datatypeAccess :: PropertyListClassID
datatypeAccess      = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_DATATYPE_ACCESS   -- parent:  linkAccess
stringCreate :: PropertyListClassID
stringCreate        = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_STRING_CREATE     -- parent:  root
attributeCreate :: PropertyListClassID
attributeCreate     = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_ATTRIBUTE_CREATE  -- parent:  stringCreate
objectCopy :: PropertyListClassID
objectCopy          = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_OBJECT_COPY       -- parent:  root
linkCreate :: PropertyListClassID
linkCreate          = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_LINK_CREATE       -- parent:  stringCreate
linkAccess :: PropertyListClassID
linkAccess          = HId_t -> PropertyListClassID
PropertyListClassID HId_t
h5p_LINK_ACCESS       -- parent:  root

getClassName :: PropertyListClassID -> IO BS.ByteString
getClassName :: PropertyListClassID -> IO ByteString
getClassName (PropertyListClassID HId_t
cls) = do
    CString
name <- (CString -> Bool) -> IO CString -> IO CString
forall t. (t -> Bool) -> IO t -> IO t
withErrorWhen (CString
forall a. Ptr a
nullPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
==) (IO CString -> IO CString) -> IO CString -> IO CString
forall a b. (a -> b) -> a -> b
$
        HId_t -> IO CString
h5p_get_class_name HId_t
cls

    ByteString
nameStr <- CString -> IO ByteString
BS.packCString CString
name
    CString -> IO ()
forall a. Ptr a -> IO ()
free CString
name

    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
nameStr

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

class (HId t, FromHId t) => PropertyListOrClass t where
class PropertyListOrClass t => PropertyList t where
    staticPlistClass :: Tagged t PropertyListClassID

instance PropertyListOrClass PropertyListID
instance PropertyListOrClass PropertyListClassID

instance PropertyList PropertyListID where
    staticPlistClass :: Tagged PropertyListID PropertyListClassID
staticPlistClass = PropertyListClassID -> Tagged PropertyListID PropertyListClassID
forall {k} (s :: k) b. b -> Tagged s b
Tagged PropertyListClassID
root

uncheckedCastPlist :: (PropertyList a, PropertyList b) => a -> b
uncheckedCastPlist :: forall a b. (PropertyList a, PropertyList b) => a -> b
uncheckedCastPlist = HId_t -> b
forall t. FromHId t => HId_t -> t
uncheckedFromHId (HId_t -> b) -> (a -> HId_t) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HId_t
forall t. HId t => t -> HId_t
hid

castPropertyList :: (PropertyList a, PropertyList b) => a -> IO (Maybe b)
castPropertyList :: forall a b. (PropertyList a, PropertyList b) => a -> IO (Maybe b)
castPropertyList = Tagged b PropertyListClassID -> a -> IO (Maybe b)
forall a b.
(PropertyList a, PropertyList b) =>
Tagged b PropertyListClassID -> a -> IO (Maybe b)
castTo Tagged b PropertyListClassID
forall t. PropertyList t => Tagged t PropertyListClassID
staticPlistClass
    where
        castTo :: (PropertyList a, PropertyList b)
               => Tagged b PropertyListClassID -> a -> IO (Maybe b)
        castTo :: forall a b.
(PropertyList a, PropertyList b) =>
Tagged b PropertyListClassID -> a -> IO (Maybe b)
castTo (Tagged PropertyListClassID
cls) a
plist = do
            Bool
ok <- a -> PropertyListClassID -> IO Bool
forall t. PropertyList t => t -> PropertyListClassID -> IO Bool
propertyListIsA a
plist PropertyListClassID
cls
            if Bool
ok
                then Maybe b -> IO (Maybe b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (PropertyList a, PropertyList b) => a -> b
uncheckedCastPlist (a -> Maybe b) -> a -> Maybe b
forall a b. (a -> b) -> a -> b
$ a
plist)
                else Maybe b -> IO (Maybe b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing

createPropertyList :: PropertyList t => IO t
createPropertyList :: forall t. PropertyList t => IO t
createPropertyList = Tagged t PropertyListClassID -> IO t
forall t. PropertyList t => Tagged t PropertyListClassID -> IO t
create Tagged t PropertyListClassID
forall t. PropertyList t => Tagged t PropertyListClassID
staticPlistClass
    where
        create :: PropertyList t => Tagged t PropertyListClassID -> IO t
        create :: forall t. PropertyList t => Tagged t PropertyListClassID -> IO t
create (Tagged PropertyListClassID
cls)
            = PropertyListID -> t
forall a b. (PropertyList a, PropertyList b) => a -> b
uncheckedCastPlist
              (PropertyListID -> t) -> IO PropertyListID -> IO t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropertyListClassID -> IO PropertyListID
createPropertyListWithClass PropertyListClassID
cls

createPropertyListWithClass :: PropertyListClassID -> IO PropertyListID
createPropertyListWithClass :: PropertyListClassID -> IO PropertyListID
createPropertyListWithClass (PropertyListClassID HId_t
cls) =
    (HId_t -> PropertyListID) -> IO HId_t -> IO PropertyListID
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> PropertyListID
PropertyListID (IO HId_t -> IO PropertyListID) -> IO HId_t -> IO PropertyListID
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
h5p_create HId_t
cls

propertyExists :: PropertyList t => t -> BS.ByteString -> IO Bool
propertyExists :: forall t. PropertyList t => t -> ByteString -> IO Bool
propertyExists t
plist ByteString
name =
    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 -> IO HTri_t
h5p_exist (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) CString
cname

getPropertySize :: PropertyListOrClass t => t -> BS.ByteString -> IO CSize
getPropertySize :: forall t. PropertyListOrClass t => t -> ByteString -> IO CSize
getPropertySize t
plist ByteString
name =
    (Out CSize -> IO ()) -> IO CSize
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CSize -> IO ()) -> IO CSize)
-> (Out CSize -> IO ()) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Out CSize
sz ->
        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 CSize -> IO HErr_t
h5p_get_size (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) CString
cname Out CSize
sz

getNProps :: PropertyListOrClass t => t -> IO CSize
getNProps :: forall t. PropertyListOrClass t => t -> IO CSize
getNProps t
plist =
    (Out CSize -> IO ()) -> IO CSize
forall a (m :: * -> *) b.
(Storable a, MonadBaseControl IO m, MonadIO m) =>
(Out a -> m b) -> m a
withOut_ ((Out CSize -> IO ()) -> IO CSize)
-> (Out CSize -> IO ()) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \Out CSize
sz ->
        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 CSize -> IO HErr_t
h5p_get_nprops (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) Out CSize
sz

getPropertyListClass :: PropertyList t => t -> IO PropertyListClassID
getPropertyListClass :: forall t. PropertyList t => t -> IO PropertyListClassID
getPropertyListClass t
plist =
    (HId_t -> PropertyListClassID)
-> IO HId_t -> IO PropertyListClassID
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> PropertyListClassID
PropertyListClassID (IO HId_t -> IO PropertyListClassID)
-> IO HId_t -> IO PropertyListClassID
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
h5p_get_class (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist)

getPropertyListClassParent :: PropertyListClassID -> IO PropertyListClassID
getPropertyListClassParent :: PropertyListClassID -> IO PropertyListClassID
getPropertyListClassParent (PropertyListClassID HId_t
cls) =
    (HId_t -> PropertyListClassID)
-> IO HId_t -> IO PropertyListClassID
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HId_t -> PropertyListClassID
PropertyListClassID (IO HId_t -> IO PropertyListClassID)
-> IO HId_t -> IO PropertyListClassID
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
h5p_get_class_parent HId_t
cls

propertyListsEqual :: (PropertyListOrClass a, PropertyListOrClass b) => a -> b -> IO Bool
propertyListsEqual :: forall a b.
(PropertyListOrClass a, PropertyListOrClass b) =>
a -> b -> IO Bool
propertyListsEqual a
pl1 b
pl2 =
    IO HTri_t -> IO Bool
htriToBool (IO HTri_t -> IO Bool) -> IO HTri_t -> IO Bool
forall a b. (a -> b) -> a -> b
$
        HId_t -> HId_t -> IO HTri_t
h5p_equal (a -> HId_t
forall t. HId t => t -> HId_t
hid a
pl1) (b -> HId_t
forall t. HId t => t -> HId_t
hid b
pl2)

propertyListIsA :: PropertyList t => t -> PropertyListClassID -> IO Bool
propertyListIsA :: forall t. PropertyList t => t -> PropertyListClassID -> IO Bool
propertyListIsA t
plist (PropertyListClassID HId_t
cls) =
    IO HTri_t -> IO Bool
htriToBool (IO HTri_t -> IO Bool) -> IO HTri_t -> IO Bool
forall a b. (a -> b) -> a -> b
$
        HId_t -> HId_t -> IO HTri_t
h5p_isa_class (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist) HId_t
cls

closePropertyListClass :: PropertyListClassID -> IO ()
closePropertyListClass :: PropertyListClassID -> IO ()
closePropertyListClass (PropertyListClassID HId_t
cls) =
    IO HErr_t -> IO ()
forall t. HDFResultType t => IO t -> IO ()
withErrorCheck_ (IO HErr_t -> IO ()) -> IO HErr_t -> IO ()
forall a b. (a -> b) -> a -> b
$
        HId_t -> IO HErr_t
h5p_close_class HId_t
cls

closePropertyList :: PropertyList t => t -> IO ()
closePropertyList :: forall t. PropertyList t => t -> IO ()
closePropertyList t
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
$
        HId_t -> IO HErr_t
h5p_close (t -> HId_t
forall t. HId t => t -> HId_t
hid t
plist)