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

Parameters to control the allocation of memory
-}

module GI.Gst.Structs.AllocationParams
    ( 

-- * Exported types
    AllocationParams(..)                    ,
    newZeroAllocationParams                 ,
    noAllocationParams                      ,


 -- * Methods
-- ** copy #method:copy#
    AllocationParamsCopyMethodInfo          ,
    allocationParamsCopy                    ,


-- ** free #method:free#
    AllocationParamsFreeMethodInfo          ,
    allocationParamsFree                    ,


-- ** init #method:init#
    AllocationParamsInitMethodInfo          ,
    allocationParamsInit                    ,




 -- * Properties
-- ** align #attr:align#
    allocationParams_align                  ,
    getAllocationParamsAlign                ,
    setAllocationParamsAlign                ,


-- ** flags #attr:flags#
    allocationParams_flags                  ,
    getAllocationParamsFlags                ,
    setAllocationParamsFlags                ,


-- ** padding #attr:padding#
    allocationParams_padding                ,
    getAllocationParamsPadding              ,
    setAllocationParamsPadding              ,


-- ** prefix #attr:prefix#
    allocationParams_prefix                 ,
    getAllocationParamsPrefix               ,
    setAllocationParamsPrefix               ,




    ) 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.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

import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags

newtype AllocationParams = AllocationParams (ManagedPtr AllocationParams)
foreign import ccall "gst_allocation_params_get_type" c_gst_allocation_params_get_type :: 
    IO GType

instance BoxedObject AllocationParams where
    boxedType _ = c_gst_allocation_params_get_type

-- | Construct a `AllocationParams` struct initialized to zero.
newZeroAllocationParams :: MonadIO m => m AllocationParams
newZeroAllocationParams = liftIO $ callocBoxedBytes 64 >>= wrapBoxed AllocationParams

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


noAllocationParams :: Maybe AllocationParams
noAllocationParams = Nothing

getAllocationParamsFlags :: MonadIO m => AllocationParams -> m [Gst.Flags.MemoryFlags]
getAllocationParamsFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setAllocationParamsFlags :: MonadIO m => AllocationParams -> [Gst.Flags.MemoryFlags] -> m ()
setAllocationParamsFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

data AllocationParamsFlagsFieldInfo
instance AttrInfo AllocationParamsFlagsFieldInfo where
    type AttrAllowedOps AllocationParamsFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsFlagsFieldInfo = (~) [Gst.Flags.MemoryFlags]
    type AttrBaseTypeConstraint AllocationParamsFlagsFieldInfo = (~) AllocationParams
    type AttrGetType AllocationParamsFlagsFieldInfo = [Gst.Flags.MemoryFlags]
    type AttrLabel AllocationParamsFlagsFieldInfo = "flags"
    type AttrOrigin AllocationParamsFlagsFieldInfo = AllocationParams
    attrGet _ = getAllocationParamsFlags
    attrSet _ = setAllocationParamsFlags
    attrConstruct = undefined
    attrClear _ = undefined

allocationParams_flags :: AttrLabelProxy "flags"
allocationParams_flags = AttrLabelProxy


getAllocationParamsAlign :: MonadIO m => AllocationParams -> m Word64
getAllocationParamsAlign s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Word64
    return val

setAllocationParamsAlign :: MonadIO m => AllocationParams -> Word64 -> m ()
setAllocationParamsAlign s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Word64)

data AllocationParamsAlignFieldInfo
instance AttrInfo AllocationParamsAlignFieldInfo where
    type AttrAllowedOps AllocationParamsAlignFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsAlignFieldInfo = (~) Word64
    type AttrBaseTypeConstraint AllocationParamsAlignFieldInfo = (~) AllocationParams
    type AttrGetType AllocationParamsAlignFieldInfo = Word64
    type AttrLabel AllocationParamsAlignFieldInfo = "align"
    type AttrOrigin AllocationParamsAlignFieldInfo = AllocationParams
    attrGet _ = getAllocationParamsAlign
    attrSet _ = setAllocationParamsAlign
    attrConstruct = undefined
    attrClear _ = undefined

allocationParams_align :: AttrLabelProxy "align"
allocationParams_align = AttrLabelProxy


getAllocationParamsPrefix :: MonadIO m => AllocationParams -> m Word64
getAllocationParamsPrefix s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Word64
    return val

setAllocationParamsPrefix :: MonadIO m => AllocationParams -> Word64 -> m ()
setAllocationParamsPrefix s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Word64)

data AllocationParamsPrefixFieldInfo
instance AttrInfo AllocationParamsPrefixFieldInfo where
    type AttrAllowedOps AllocationParamsPrefixFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsPrefixFieldInfo = (~) Word64
    type AttrBaseTypeConstraint AllocationParamsPrefixFieldInfo = (~) AllocationParams
    type AttrGetType AllocationParamsPrefixFieldInfo = Word64
    type AttrLabel AllocationParamsPrefixFieldInfo = "prefix"
    type AttrOrigin AllocationParamsPrefixFieldInfo = AllocationParams
    attrGet _ = getAllocationParamsPrefix
    attrSet _ = setAllocationParamsPrefix
    attrConstruct = undefined
    attrClear _ = undefined

allocationParams_prefix :: AttrLabelProxy "prefix"
allocationParams_prefix = AttrLabelProxy


getAllocationParamsPadding :: MonadIO m => AllocationParams -> m Word64
getAllocationParamsPadding s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO Word64
    return val

setAllocationParamsPadding :: MonadIO m => AllocationParams -> Word64 -> m ()
setAllocationParamsPadding s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: Word64)

data AllocationParamsPaddingFieldInfo
instance AttrInfo AllocationParamsPaddingFieldInfo where
    type AttrAllowedOps AllocationParamsPaddingFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsPaddingFieldInfo = (~) Word64
    type AttrBaseTypeConstraint AllocationParamsPaddingFieldInfo = (~) AllocationParams
    type AttrGetType AllocationParamsPaddingFieldInfo = Word64
    type AttrLabel AllocationParamsPaddingFieldInfo = "padding"
    type AttrOrigin AllocationParamsPaddingFieldInfo = AllocationParams
    attrGet _ = getAllocationParamsPadding
    attrSet _ = setAllocationParamsPadding
    attrConstruct = undefined
    attrClear _ = undefined

allocationParams_padding :: AttrLabelProxy "padding"
allocationParams_padding = AttrLabelProxy



instance O.HasAttributeList AllocationParams
type instance O.AttributeList AllocationParams = AllocationParamsAttributeList
type AllocationParamsAttributeList = ('[ '("flags", AllocationParamsFlagsFieldInfo), '("align", AllocationParamsAlignFieldInfo), '("prefix", AllocationParamsPrefixFieldInfo), '("padding", AllocationParamsPaddingFieldInfo)] :: [(Symbol, *)])

-- method AllocationParams::copy
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "params", argType = TInterface (Name {namespace = "Gst", name = "AllocationParams"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstAllocationParams", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "AllocationParams"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_allocation_params_copy" gst_allocation_params_copy :: 
    Ptr AllocationParams ->                 -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO (Ptr AllocationParams)

{- |
Create a copy of /@params@/.

Free-function: gst_allocation_params_free
-}
allocationParamsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AllocationParams
    {- ^ /@params@/: a 'GI.Gst.Structs.AllocationParams.AllocationParams' -}
    -> m AllocationParams
    {- ^ __Returns:__ a new #'GI.Gst.Structs.AllocationParams.AllocationParams', free with
'GI.Gst.Structs.AllocationParams.allocationParamsFree'. -}
allocationParamsCopy params = liftIO $ do
    params' <- unsafeManagedPtrGetPtr params
    result <- gst_allocation_params_copy params'
    checkUnexpectedReturnNULL "allocationParamsCopy" result
    result' <- (wrapBoxed AllocationParams) result
    touchManagedPtr params
    return result'

data AllocationParamsCopyMethodInfo
instance (signature ~ (m AllocationParams), MonadIO m) => O.MethodInfo AllocationParamsCopyMethodInfo AllocationParams signature where
    overloadedMethod _ = allocationParamsCopy

-- method AllocationParams::free
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "params", argType = TInterface (Name {namespace = "Gst", name = "AllocationParams"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstAllocationParams", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_allocation_params_free" gst_allocation_params_free :: 
    Ptr AllocationParams ->                 -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

{- |
Free /@params@/
-}
allocationParamsFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AllocationParams
    {- ^ /@params@/: a 'GI.Gst.Structs.AllocationParams.AllocationParams' -}
    -> m ()
allocationParamsFree params = liftIO $ do
    params' <- B.ManagedPtr.disownBoxed params
    gst_allocation_params_free params'
    touchManagedPtr params
    return ()

data AllocationParamsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AllocationParamsFreeMethodInfo AllocationParams signature where
    overloadedMethod _ = allocationParamsFree

-- method AllocationParams::init
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "params", argType = TInterface (Name {namespace = "Gst", name = "AllocationParams"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstAllocationParams", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_allocation_params_init" gst_allocation_params_init :: 
    Ptr AllocationParams ->                 -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

{- |
Initialize /@params@/ to its default values
-}
allocationParamsInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AllocationParams
    {- ^ /@params@/: a 'GI.Gst.Structs.AllocationParams.AllocationParams' -}
    -> m ()
allocationParamsInit params = liftIO $ do
    params' <- unsafeManagedPtrGetPtr params
    gst_allocation_params_init params'
    touchManagedPtr params
    return ()

data AllocationParamsInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AllocationParamsInitMethodInfo AllocationParams signature where
    overloadedMethod _ = allocationParamsInit

type family ResolveAllocationParamsMethod (t :: Symbol) (o :: *) :: * where
    ResolveAllocationParamsMethod "copy" o = AllocationParamsCopyMethodInfo
    ResolveAllocationParamsMethod "free" o = AllocationParamsFreeMethodInfo
    ResolveAllocationParamsMethod "init" o = AllocationParamsInitMethodInfo
    ResolveAllocationParamsMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAllocationParamsMethod t AllocationParams, O.MethodInfo info AllocationParams p) => O.IsLabelProxy t (AllocationParams -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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