{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A GParamSpec derived structure for arrays of values.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gst.Structs.ParamSpecArray
    ( 

-- * Exported types
    ParamSpecArray(..)                      ,
    newZeroParamSpecArray                   ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveParamSpecArrayMethod             ,
#endif




 -- * Properties
-- ** elementSpec #attr:elementSpec#
-- | the t'GI.GObject.Objects.ParamSpec.ParamSpec' of the type of values in the array

    clearParamSpecArrayElementSpec          ,
    getParamSpecArrayElementSpec            ,
#if defined(ENABLE_OVERLOADING)
    paramSpecArray_elementSpec              ,
#endif
    setParamSpecArrayElementSpec            ,


-- ** parentInstance #attr:parentInstance#
-- | super class

    clearParamSpecArrayParentInstance       ,
    getParamSpecArrayParentInstance         ,
#if defined(ENABLE_OVERLOADING)
    paramSpecArray_parentInstance           ,
#endif
    setParamSpecArrayParentInstance         ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL


-- | Memory-managed wrapper type.
newtype ParamSpecArray = ParamSpecArray (SP.ManagedPtr ParamSpecArray)
    deriving (ParamSpecArray -> ParamSpecArray -> Bool
(ParamSpecArray -> ParamSpecArray -> Bool)
-> (ParamSpecArray -> ParamSpecArray -> Bool) -> Eq ParamSpecArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamSpecArray -> ParamSpecArray -> Bool
$c/= :: ParamSpecArray -> ParamSpecArray -> Bool
== :: ParamSpecArray -> ParamSpecArray -> Bool
$c== :: ParamSpecArray -> ParamSpecArray -> Bool
Eq)

instance SP.ManagedPtrNewtype ParamSpecArray where
    toManagedPtr :: ParamSpecArray -> ManagedPtr ParamSpecArray
toManagedPtr (ParamSpecArray ManagedPtr ParamSpecArray
p) = ManagedPtr ParamSpecArray
p

instance BoxedPtr ParamSpecArray where
    boxedPtrCopy :: ParamSpecArray -> IO ParamSpecArray
boxedPtrCopy = \ParamSpecArray
p -> ParamSpecArray
-> (Ptr ParamSpecArray -> IO ParamSpecArray) -> IO ParamSpecArray
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ParamSpecArray
p (Int -> Ptr ParamSpecArray -> IO (Ptr ParamSpecArray)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
80 (Ptr ParamSpecArray -> IO (Ptr ParamSpecArray))
-> (Ptr ParamSpecArray -> IO ParamSpecArray)
-> Ptr ParamSpecArray
-> IO ParamSpecArray
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ParamSpecArray -> ParamSpecArray)
-> Ptr ParamSpecArray -> IO ParamSpecArray
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ParamSpecArray -> ParamSpecArray
ParamSpecArray)
    boxedPtrFree :: ParamSpecArray -> IO ()
boxedPtrFree = \ParamSpecArray
x -> ParamSpecArray -> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ParamSpecArray
x Ptr ParamSpecArray -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ParamSpecArray where
    boxedPtrCalloc :: IO (Ptr ParamSpecArray)
boxedPtrCalloc = Int -> IO (Ptr ParamSpecArray)
forall a. Int -> IO (Ptr a)
callocBytes Int
80


-- | Construct a `ParamSpecArray` struct initialized to zero.
newZeroParamSpecArray :: MonadIO m => m ParamSpecArray
newZeroParamSpecArray :: m ParamSpecArray
newZeroParamSpecArray = IO ParamSpecArray -> m ParamSpecArray
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ParamSpecArray -> m ParamSpecArray)
-> IO ParamSpecArray -> m ParamSpecArray
forall a b. (a -> b) -> a -> b
$ IO (Ptr ParamSpecArray)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ParamSpecArray)
-> (Ptr ParamSpecArray -> IO ParamSpecArray) -> IO ParamSpecArray
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ParamSpecArray -> ParamSpecArray)
-> Ptr ParamSpecArray -> IO ParamSpecArray
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ParamSpecArray -> ParamSpecArray
ParamSpecArray

instance tag ~ 'AttrSet => Constructible ParamSpecArray tag where
    new :: (ManagedPtr ParamSpecArray -> ParamSpecArray)
-> [AttrOp ParamSpecArray tag] -> m ParamSpecArray
new ManagedPtr ParamSpecArray -> ParamSpecArray
_ [AttrOp ParamSpecArray tag]
attrs = do
        ParamSpecArray
o <- m ParamSpecArray
forall (m :: * -> *). MonadIO m => m ParamSpecArray
newZeroParamSpecArray
        ParamSpecArray -> [AttrOp ParamSpecArray 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ParamSpecArray
o [AttrOp ParamSpecArray tag]
[AttrOp ParamSpecArray 'AttrSet]
attrs
        ParamSpecArray -> m ParamSpecArray
forall (m :: * -> *) a. Monad m => a -> m a
return ParamSpecArray
o


-- | Get the value of the “@parent_instance@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' paramSpecArray #parentInstance
-- @
getParamSpecArrayParentInstance :: MonadIO m => ParamSpecArray -> m (Maybe GParamSpec)
getParamSpecArrayParentInstance :: ParamSpecArray -> m (Maybe GParamSpec)
getParamSpecArrayParentInstance ParamSpecArray
s = IO (Maybe GParamSpec) -> m (Maybe GParamSpec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GParamSpec) -> m (Maybe GParamSpec))
-> IO (Maybe GParamSpec) -> m (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ ParamSpecArray
-> (Ptr ParamSpecArray -> IO (Maybe GParamSpec))
-> IO (Maybe GParamSpec)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParamSpecArray
s ((Ptr ParamSpecArray -> IO (Maybe GParamSpec))
 -> IO (Maybe GParamSpec))
-> (Ptr ParamSpecArray -> IO (Maybe GParamSpec))
-> IO (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr ParamSpecArray
ptr -> do
    Ptr GParamSpec
val <- Ptr (Ptr GParamSpec) -> IO (Ptr GParamSpec)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParamSpecArray
ptr Ptr ParamSpecArray -> Int -> Ptr (Ptr GParamSpec)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr GParamSpec)
    Maybe GParamSpec
result <- Ptr GParamSpec
-> (Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr GParamSpec
val ((Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec))
-> (Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr GParamSpec
val' -> do
        GParamSpec
val'' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
val'
        GParamSpec -> IO GParamSpec
forall (m :: * -> *) a. Monad m => a -> m a
return GParamSpec
val''
    Maybe GParamSpec -> IO (Maybe GParamSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GParamSpec
result

-- | Set the value of the “@parent_instance@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' paramSpecArray [ #parentInstance 'Data.GI.Base.Attributes.:=' value ]
-- @
setParamSpecArrayParentInstance :: MonadIO m => ParamSpecArray -> Ptr GParamSpec -> m ()
setParamSpecArrayParentInstance :: ParamSpecArray -> Ptr GParamSpec -> m ()
setParamSpecArrayParentInstance ParamSpecArray
s Ptr GParamSpec
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ParamSpecArray -> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParamSpecArray
s ((Ptr ParamSpecArray -> IO ()) -> IO ())
-> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParamSpecArray
ptr -> do
    Ptr (Ptr GParamSpec) -> Ptr GParamSpec -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParamSpecArray
ptr Ptr ParamSpecArray -> Int -> Ptr (Ptr GParamSpec)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr GParamSpec
val :: Ptr GParamSpec)

-- | Set the value of the “@parent_instance@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #parentInstance
-- @
clearParamSpecArrayParentInstance :: MonadIO m => ParamSpecArray -> m ()
clearParamSpecArrayParentInstance :: ParamSpecArray -> m ()
clearParamSpecArrayParentInstance ParamSpecArray
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ParamSpecArray -> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParamSpecArray
s ((Ptr ParamSpecArray -> IO ()) -> IO ())
-> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParamSpecArray
ptr -> do
    Ptr (Ptr GParamSpec) -> Ptr GParamSpec -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParamSpecArray
ptr Ptr ParamSpecArray -> Int -> Ptr (Ptr GParamSpec)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr GParamSpec
forall a. Ptr a
FP.nullPtr :: Ptr GParamSpec)

#if defined(ENABLE_OVERLOADING)
data ParamSpecArrayParentInstanceFieldInfo
instance AttrInfo ParamSpecArrayParentInstanceFieldInfo where
    type AttrBaseTypeConstraint ParamSpecArrayParentInstanceFieldInfo = (~) ParamSpecArray
    type AttrAllowedOps ParamSpecArrayParentInstanceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ParamSpecArrayParentInstanceFieldInfo = (~) (Ptr GParamSpec)
    type AttrTransferTypeConstraint ParamSpecArrayParentInstanceFieldInfo = (~)(Ptr GParamSpec)
    type AttrTransferType ParamSpecArrayParentInstanceFieldInfo = (Ptr GParamSpec)
    type AttrGetType ParamSpecArrayParentInstanceFieldInfo = Maybe GParamSpec
    type AttrLabel ParamSpecArrayParentInstanceFieldInfo = "parent_instance"
    type AttrOrigin ParamSpecArrayParentInstanceFieldInfo = ParamSpecArray
    attrGet = getParamSpecArrayParentInstance
    attrSet = setParamSpecArrayParentInstance
    attrConstruct = undefined
    attrClear = clearParamSpecArrayParentInstance
    attrTransfer _ v = do
        return v

paramSpecArray_parentInstance :: AttrLabelProxy "parentInstance"
paramSpecArray_parentInstance = AttrLabelProxy

#endif


-- | Get the value of the “@element_spec@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' paramSpecArray #elementSpec
-- @
getParamSpecArrayElementSpec :: MonadIO m => ParamSpecArray -> m (Maybe GParamSpec)
getParamSpecArrayElementSpec :: ParamSpecArray -> m (Maybe GParamSpec)
getParamSpecArrayElementSpec ParamSpecArray
s = IO (Maybe GParamSpec) -> m (Maybe GParamSpec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GParamSpec) -> m (Maybe GParamSpec))
-> IO (Maybe GParamSpec) -> m (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ ParamSpecArray
-> (Ptr ParamSpecArray -> IO (Maybe GParamSpec))
-> IO (Maybe GParamSpec)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParamSpecArray
s ((Ptr ParamSpecArray -> IO (Maybe GParamSpec))
 -> IO (Maybe GParamSpec))
-> (Ptr ParamSpecArray -> IO (Maybe GParamSpec))
-> IO (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr ParamSpecArray
ptr -> do
    Ptr GParamSpec
val <- Ptr (Ptr GParamSpec) -> IO (Ptr GParamSpec)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ParamSpecArray
ptr Ptr ParamSpecArray -> Int -> Ptr (Ptr GParamSpec)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) :: IO (Ptr GParamSpec)
    Maybe GParamSpec
result <- Ptr GParamSpec
-> (Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr GParamSpec
val ((Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec))
-> (Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr GParamSpec
val' -> do
        GParamSpec
val'' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
val'
        GParamSpec -> IO GParamSpec
forall (m :: * -> *) a. Monad m => a -> m a
return GParamSpec
val''
    Maybe GParamSpec -> IO (Maybe GParamSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GParamSpec
result

-- | Set the value of the “@element_spec@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' paramSpecArray [ #elementSpec 'Data.GI.Base.Attributes.:=' value ]
-- @
setParamSpecArrayElementSpec :: MonadIO m => ParamSpecArray -> Ptr GParamSpec -> m ()
setParamSpecArrayElementSpec :: ParamSpecArray -> Ptr GParamSpec -> m ()
setParamSpecArrayElementSpec ParamSpecArray
s Ptr GParamSpec
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ParamSpecArray -> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParamSpecArray
s ((Ptr ParamSpecArray -> IO ()) -> IO ())
-> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParamSpecArray
ptr -> do
    Ptr (Ptr GParamSpec) -> Ptr GParamSpec -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParamSpecArray
ptr Ptr ParamSpecArray -> Int -> Ptr (Ptr GParamSpec)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (Ptr GParamSpec
val :: Ptr GParamSpec)

-- | Set the value of the “@element_spec@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #elementSpec
-- @
clearParamSpecArrayElementSpec :: MonadIO m => ParamSpecArray -> m ()
clearParamSpecArrayElementSpec :: ParamSpecArray -> m ()
clearParamSpecArrayElementSpec ParamSpecArray
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ParamSpecArray -> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ParamSpecArray
s ((Ptr ParamSpecArray -> IO ()) -> IO ())
-> (Ptr ParamSpecArray -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ParamSpecArray
ptr -> do
    Ptr (Ptr GParamSpec) -> Ptr GParamSpec -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ParamSpecArray
ptr Ptr ParamSpecArray -> Int -> Ptr (Ptr GParamSpec)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (Ptr GParamSpec
forall a. Ptr a
FP.nullPtr :: Ptr GParamSpec)

#if defined(ENABLE_OVERLOADING)
data ParamSpecArrayElementSpecFieldInfo
instance AttrInfo ParamSpecArrayElementSpecFieldInfo where
    type AttrBaseTypeConstraint ParamSpecArrayElementSpecFieldInfo = (~) ParamSpecArray
    type AttrAllowedOps ParamSpecArrayElementSpecFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ParamSpecArrayElementSpecFieldInfo = (~) (Ptr GParamSpec)
    type AttrTransferTypeConstraint ParamSpecArrayElementSpecFieldInfo = (~)(Ptr GParamSpec)
    type AttrTransferType ParamSpecArrayElementSpecFieldInfo = (Ptr GParamSpec)
    type AttrGetType ParamSpecArrayElementSpecFieldInfo = Maybe GParamSpec
    type AttrLabel ParamSpecArrayElementSpecFieldInfo = "element_spec"
    type AttrOrigin ParamSpecArrayElementSpecFieldInfo = ParamSpecArray
    attrGet = getParamSpecArrayElementSpec
    attrSet = setParamSpecArrayElementSpec
    attrConstruct = undefined
    attrClear = clearParamSpecArrayElementSpec
    attrTransfer _ v = do
        return v

paramSpecArray_elementSpec :: AttrLabelProxy "elementSpec"
paramSpecArray_elementSpec = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ParamSpecArray
type instance O.AttributeList ParamSpecArray = ParamSpecArrayAttributeList
type ParamSpecArrayAttributeList = ('[ '("parentInstance", ParamSpecArrayParentInstanceFieldInfo), '("elementSpec", ParamSpecArrayElementSpecFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveParamSpecArrayMethod (t :: Symbol) (o :: *) :: * where
    ResolveParamSpecArrayMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveParamSpecArrayMethod t ParamSpecArray, O.MethodInfo info ParamSpecArray p) => OL.IsLabel t (ParamSpecArray -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif