{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A GParamSpec derived structure that contains the meta data for fractional
properties.
-}

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

module GI.Gst.Structs.ParamSpecArray
    (

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


 -- * Properties
-- ** elementSpec #attr:elementSpec#
{- | /No description available in the introspection data./
-}
    clearParamSpecArrayElementSpec          ,
    getParamSpecArrayElementSpec            ,
#if ENABLE_OVERLOADING
    paramSpecArray_elementSpec              ,
#endif
    setParamSpecArrayElementSpec            ,


-- ** parentInstance #attr:parentInstance#
{- | super class
-}
    clearParamSpecArrayParentInstance       ,
    getParamSpecArrayParentInstance         ,
#if 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.ManagedPtr as B.ManagedPtr
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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP


-- | Memory-managed wrapper type.
newtype ParamSpecArray = ParamSpecArray (ManagedPtr ParamSpecArray)
instance WrappedPtr ParamSpecArray where
    wrappedPtrCalloc = callocBytes 80
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 80 >=> wrapPtr ParamSpecArray)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `ParamSpecArray` struct initialized to zero.
newZeroParamSpecArray :: MonadIO m => m ParamSpecArray
newZeroParamSpecArray = liftIO $ wrappedPtrCalloc >>= wrapPtr ParamSpecArray

instance tag ~ 'AttrSet => Constructible ParamSpecArray tag where
    new _ attrs = do
        o <- newZeroParamSpecArray
        GI.Attributes.set o attrs
        return o


-- | A convenience alias for `Nothing` :: `Maybe` `ParamSpecArray`.
noParamSpecArray :: Maybe ParamSpecArray
noParamSpecArray = Nothing

{- |
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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr GParamSpec)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- B.GParamSpec.newGParamSpecFromPtr val'
        return val''
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (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 s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: Ptr GParamSpec)

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

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 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 72) :: IO (Ptr GParamSpec)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- B.GParamSpec.newGParamSpecFromPtr val'
        return val''
    return 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 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 72) (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 s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 72) (FP.nullPtr :: Ptr GParamSpec)

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

paramSpecArray_elementSpec :: AttrLabelProxy "elementSpec"
paramSpecArray_elementSpec = AttrLabelProxy

#endif



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

#if 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) => O.IsLabelProxy t (ParamSpecArray -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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

#endif