{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Parameters to control the allocation of memory

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

module GI.Gst.Structs.AllocationParams
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gst.Structs.AllocationParams#g:method:copy"), [free]("GI.Gst.Structs.AllocationParams#g:method:free"), [init]("GI.Gst.Structs.AllocationParams#g:method:init").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveAllocationParamsMethod           ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    AllocationParamsCopyMethodInfo          ,
#endif
    allocationParamsCopy                    ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    AllocationParamsFreeMethodInfo          ,
#endif
    allocationParamsFree                    ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    AllocationParamsInitMethodInfo          ,
#endif
    allocationParamsInit                    ,


-- ** new #method:new#

    allocationParamsNew                     ,




 -- * Properties


-- ** align #attr:align#
-- | the desired alignment of the memory

#if defined(ENABLE_OVERLOADING)
    allocationParams_align                  ,
#endif
    getAllocationParamsAlign                ,
    setAllocationParamsAlign                ,


-- ** flags #attr:flags#
-- | flags to control allocation

#if defined(ENABLE_OVERLOADING)
    allocationParams_flags                  ,
#endif
    getAllocationParamsFlags                ,
    setAllocationParamsFlags                ,


-- ** padding #attr:padding#
-- | the desired padding

#if defined(ENABLE_OVERLOADING)
    allocationParams_padding                ,
#endif
    getAllocationParamsPadding              ,
    setAllocationParamsPadding              ,


-- ** prefix #attr:prefix#
-- | the desired prefix

#if defined(ENABLE_OVERLOADING)
    allocationParams_prefix                 ,
#endif
    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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
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
import qualified GHC.Records as R

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

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

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

foreign import ccall "gst_allocation_params_get_type" c_gst_allocation_params_get_type :: 
    IO GType

type instance O.ParentTypes AllocationParams = '[]
instance O.HasParentTypes AllocationParams

instance B.Types.TypedObject AllocationParams where
    glibType :: IO GType
glibType = IO GType
c_gst_allocation_params_get_type

instance B.Types.GBoxed AllocationParams

-- | Convert 'AllocationParams' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe AllocationParams) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_allocation_params_get_type
    gvalueSet_ :: Ptr GValue -> Maybe AllocationParams -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AllocationParams
P.Nothing = Ptr GValue -> Ptr AllocationParams -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr AllocationParams
forall a. Ptr a
FP.nullPtr :: FP.Ptr AllocationParams)
    gvalueSet_ Ptr GValue
gv (P.Just AllocationParams
obj) = AllocationParams -> (Ptr AllocationParams -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AllocationParams
obj (Ptr GValue -> Ptr AllocationParams -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe AllocationParams)
gvalueGet_ Ptr GValue
gv = do
        Ptr AllocationParams
ptr <- Ptr GValue -> IO (Ptr AllocationParams)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr AllocationParams)
        if Ptr AllocationParams
ptr Ptr AllocationParams -> Ptr AllocationParams -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AllocationParams
forall a. Ptr a
FP.nullPtr
        then AllocationParams -> Maybe AllocationParams
forall a. a -> Maybe a
P.Just (AllocationParams -> Maybe AllocationParams)
-> IO AllocationParams -> IO (Maybe AllocationParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr AllocationParams -> AllocationParams
AllocationParams Ptr AllocationParams
ptr
        else Maybe AllocationParams -> IO (Maybe AllocationParams)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AllocationParams
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `AllocationParams` struct initialized to zero.
newZeroAllocationParams :: MonadIO m => m AllocationParams
newZeroAllocationParams :: forall (m :: * -> *). MonadIO m => m AllocationParams
newZeroAllocationParams = IO AllocationParams -> m AllocationParams
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AllocationParams -> m AllocationParams)
-> IO AllocationParams -> m AllocationParams
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr AllocationParams)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
64 IO (Ptr AllocationParams)
-> (Ptr AllocationParams -> IO AllocationParams)
-> IO AllocationParams
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
AllocationParams

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


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' allocationParams #flags
-- @
getAllocationParamsFlags :: MonadIO m => AllocationParams -> m [Gst.Flags.MemoryFlags]
getAllocationParamsFlags :: forall (m :: * -> *).
MonadIO m =>
AllocationParams -> m [MemoryFlags]
getAllocationParamsFlags AllocationParams
s = IO [MemoryFlags] -> m [MemoryFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MemoryFlags] -> m [MemoryFlags])
-> IO [MemoryFlags] -> m [MemoryFlags]
forall a b. (a -> b) -> a -> b
$ AllocationParams
-> (Ptr AllocationParams -> IO [MemoryFlags]) -> IO [MemoryFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AllocationParams
s ((Ptr AllocationParams -> IO [MemoryFlags]) -> IO [MemoryFlags])
-> (Ptr AllocationParams -> IO [MemoryFlags]) -> IO [MemoryFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationParams
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr AllocationParams
ptr Ptr AllocationParams -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: [MemoryFlags]
val' = CUInt -> [MemoryFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [MemoryFlags] -> IO [MemoryFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [MemoryFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' allocationParams [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setAllocationParamsFlags :: MonadIO m => AllocationParams -> [Gst.Flags.MemoryFlags] -> m ()
setAllocationParamsFlags :: forall (m :: * -> *).
MonadIO m =>
AllocationParams -> [MemoryFlags] -> m ()
setAllocationParamsFlags AllocationParams
s [MemoryFlags]
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AllocationParams -> (Ptr AllocationParams -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AllocationParams
s ((Ptr AllocationParams -> IO ()) -> IO ())
-> (Ptr AllocationParams -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationParams
ptr -> do
    let val' :: CUInt
val' = [MemoryFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MemoryFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AllocationParams
ptr Ptr AllocationParams -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data AllocationParamsFlagsFieldInfo
instance AttrInfo AllocationParamsFlagsFieldInfo where
    type AttrBaseTypeConstraint AllocationParamsFlagsFieldInfo = (~) AllocationParams
    type AttrAllowedOps AllocationParamsFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsFlagsFieldInfo = (~) [Gst.Flags.MemoryFlags]
    type AttrTransferTypeConstraint AllocationParamsFlagsFieldInfo = (~)[Gst.Flags.MemoryFlags]
    type AttrTransferType AllocationParamsFlagsFieldInfo = [Gst.Flags.MemoryFlags]
    type AttrGetType AllocationParamsFlagsFieldInfo = [Gst.Flags.MemoryFlags]
    type AttrLabel AllocationParamsFlagsFieldInfo = "flags"
    type AttrOrigin AllocationParamsFlagsFieldInfo = AllocationParams
    attrGet = getAllocationParamsFlags
    attrSet = setAllocationParamsFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#g:attr:flags"
        })

allocationParams_flags :: AttrLabelProxy "flags"
allocationParams_flags = AttrLabelProxy

#endif


-- | Get the value of the “@align@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' allocationParams #align
-- @
getAllocationParamsAlign :: MonadIO m => AllocationParams -> m Word64
getAllocationParamsAlign :: forall (m :: * -> *). MonadIO m => AllocationParams -> m Word64
getAllocationParamsAlign AllocationParams
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ AllocationParams
-> (Ptr AllocationParams -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AllocationParams
s ((Ptr AllocationParams -> IO Word64) -> IO Word64)
-> (Ptr AllocationParams -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationParams
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr AllocationParams
ptr Ptr AllocationParams -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

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

#if defined(ENABLE_OVERLOADING)
data AllocationParamsAlignFieldInfo
instance AttrInfo AllocationParamsAlignFieldInfo where
    type AttrBaseTypeConstraint AllocationParamsAlignFieldInfo = (~) AllocationParams
    type AttrAllowedOps AllocationParamsAlignFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsAlignFieldInfo = (~) Word64
    type AttrTransferTypeConstraint AllocationParamsAlignFieldInfo = (~)Word64
    type AttrTransferType AllocationParamsAlignFieldInfo = Word64
    type AttrGetType AllocationParamsAlignFieldInfo = Word64
    type AttrLabel AllocationParamsAlignFieldInfo = "align"
    type AttrOrigin AllocationParamsAlignFieldInfo = AllocationParams
    attrGet = getAllocationParamsAlign
    attrSet = setAllocationParamsAlign
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.align"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#g:attr:align"
        })

allocationParams_align :: AttrLabelProxy "align"
allocationParams_align = AttrLabelProxy

#endif


-- | Get the value of the “@prefix@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' allocationParams #prefix
-- @
getAllocationParamsPrefix :: MonadIO m => AllocationParams -> m Word64
getAllocationParamsPrefix :: forall (m :: * -> *). MonadIO m => AllocationParams -> m Word64
getAllocationParamsPrefix AllocationParams
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ AllocationParams
-> (Ptr AllocationParams -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AllocationParams
s ((Ptr AllocationParams -> IO Word64) -> IO Word64)
-> (Ptr AllocationParams -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationParams
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr AllocationParams
ptr Ptr AllocationParams -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

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

#if defined(ENABLE_OVERLOADING)
data AllocationParamsPrefixFieldInfo
instance AttrInfo AllocationParamsPrefixFieldInfo where
    type AttrBaseTypeConstraint AllocationParamsPrefixFieldInfo = (~) AllocationParams
    type AttrAllowedOps AllocationParamsPrefixFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsPrefixFieldInfo = (~) Word64
    type AttrTransferTypeConstraint AllocationParamsPrefixFieldInfo = (~)Word64
    type AttrTransferType AllocationParamsPrefixFieldInfo = Word64
    type AttrGetType AllocationParamsPrefixFieldInfo = Word64
    type AttrLabel AllocationParamsPrefixFieldInfo = "prefix"
    type AttrOrigin AllocationParamsPrefixFieldInfo = AllocationParams
    attrGet = getAllocationParamsPrefix
    attrSet = setAllocationParamsPrefix
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.prefix"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#g:attr:prefix"
        })

allocationParams_prefix :: AttrLabelProxy "prefix"
allocationParams_prefix = AttrLabelProxy

#endif


-- | Get the value of the “@padding@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' allocationParams #padding
-- @
getAllocationParamsPadding :: MonadIO m => AllocationParams -> m Word64
getAllocationParamsPadding :: forall (m :: * -> *). MonadIO m => AllocationParams -> m Word64
getAllocationParamsPadding AllocationParams
s = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ AllocationParams
-> (Ptr AllocationParams -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AllocationParams
s ((Ptr AllocationParams -> IO Word64) -> IO Word64)
-> (Ptr AllocationParams -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationParams
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr AllocationParams
ptr Ptr AllocationParams -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Word64
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

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

#if defined(ENABLE_OVERLOADING)
data AllocationParamsPaddingFieldInfo
instance AttrInfo AllocationParamsPaddingFieldInfo where
    type AttrBaseTypeConstraint AllocationParamsPaddingFieldInfo = (~) AllocationParams
    type AttrAllowedOps AllocationParamsPaddingFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AllocationParamsPaddingFieldInfo = (~) Word64
    type AttrTransferTypeConstraint AllocationParamsPaddingFieldInfo = (~)Word64
    type AttrTransferType AllocationParamsPaddingFieldInfo = Word64
    type AttrGetType AllocationParamsPaddingFieldInfo = Word64
    type AttrLabel AllocationParamsPaddingFieldInfo = "padding"
    type AttrOrigin AllocationParamsPaddingFieldInfo = AllocationParams
    attrGet = getAllocationParamsPadding
    attrSet = setAllocationParamsPadding
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.padding"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#g:attr:padding"
        })

allocationParams_padding :: AttrLabelProxy "padding"
allocationParams_padding = AttrLabelProxy

#endif



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

-- method AllocationParams::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "AllocationParams" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_allocation_params_new" gst_allocation_params_new :: 
    IO (Ptr AllocationParams)

-- | Create a new t'GI.Gst.Structs.AllocationParams.AllocationParams' on the heap.  This function is for
-- use in GStreamer language bindings.  In your own code, you can just
-- declare a t'GI.Gst.Structs.AllocationParams.AllocationParams' on the stack or in a struct, and
-- call 'GI.Gst.Structs.AllocationParams.allocationParamsInit' to initialize it.
-- 
-- You do not need to call 'GI.Gst.Structs.AllocationParams.allocationParamsInit' on the instance
-- returned by this function.
-- 
-- /Since: 1.20/
allocationParamsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m AllocationParams
    -- ^ __Returns:__ a new t'GI.Gst.Structs.AllocationParams.AllocationParams'
allocationParamsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m AllocationParams
allocationParamsNew  = IO AllocationParams -> m AllocationParams
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AllocationParams -> m AllocationParams)
-> IO AllocationParams -> m AllocationParams
forall a b. (a -> b) -> a -> b
$ do
    Ptr AllocationParams
result <- IO (Ptr AllocationParams)
gst_allocation_params_new
    Text -> Ptr AllocationParams -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"allocationParamsNew" Ptr AllocationParams
result
    AllocationParams
result' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
AllocationParams) Ptr AllocationParams
result
    AllocationParams -> IO AllocationParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AllocationParams
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- 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@/.
allocationParamsCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AllocationParams
    -- ^ /@params@/: a t'GI.Gst.Structs.AllocationParams.AllocationParams'
    -> m (Maybe AllocationParams)
    -- ^ __Returns:__ a new t'GI.Gst.Structs.AllocationParams.AllocationParams'.
allocationParamsCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AllocationParams -> m (Maybe AllocationParams)
allocationParamsCopy AllocationParams
params = IO (Maybe AllocationParams) -> m (Maybe AllocationParams)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AllocationParams) -> m (Maybe AllocationParams))
-> IO (Maybe AllocationParams) -> m (Maybe AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AllocationParams
params' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AllocationParams
params
    Ptr AllocationParams
result <- Ptr AllocationParams -> IO (Ptr AllocationParams)
gst_allocation_params_copy Ptr AllocationParams
params'
    Maybe AllocationParams
maybeResult <- Ptr AllocationParams
-> (Ptr AllocationParams -> IO AllocationParams)
-> IO (Maybe AllocationParams)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr AllocationParams
result ((Ptr AllocationParams -> IO AllocationParams)
 -> IO (Maybe AllocationParams))
-> (Ptr AllocationParams -> IO AllocationParams)
-> IO (Maybe AllocationParams)
forall a b. (a -> b) -> a -> b
$ \Ptr AllocationParams
result' -> do
        AllocationParams
result'' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
AllocationParams) Ptr AllocationParams
result'
        AllocationParams -> IO AllocationParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AllocationParams
result''
    AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AllocationParams
params
    Maybe AllocationParams -> IO (Maybe AllocationParams)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AllocationParams
maybeResult

#if defined(ENABLE_OVERLOADING)
data AllocationParamsCopyMethodInfo
instance (signature ~ (m (Maybe AllocationParams)), MonadIO m) => O.OverloadedMethod AllocationParamsCopyMethodInfo AllocationParams signature where
    overloadedMethod = allocationParamsCopy

instance O.OverloadedMethodInfo AllocationParamsCopyMethodInfo AllocationParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.allocationParamsCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#v:allocationParamsCopy"
        })


#endif

-- 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 t'GI.Gst.Structs.AllocationParams.AllocationParams'
    -> m ()
allocationParamsFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AllocationParams -> m ()
allocationParamsFree AllocationParams
params = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AllocationParams
params' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed AllocationParams
params
    Ptr AllocationParams -> IO ()
gst_allocation_params_free Ptr AllocationParams
params'
    AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AllocationParams
params
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AllocationParamsFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod AllocationParamsFreeMethodInfo AllocationParams signature where
    overloadedMethod = allocationParamsFree

instance O.OverloadedMethodInfo AllocationParamsFreeMethodInfo AllocationParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.allocationParamsFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#v:allocationParamsFree"
        })


#endif

-- 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 t'GI.Gst.Structs.AllocationParams.AllocationParams'
    -> m ()
allocationParamsInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AllocationParams -> m ()
allocationParamsInit AllocationParams
params = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AllocationParams
params' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AllocationParams
params
    Ptr AllocationParams -> IO ()
gst_allocation_params_init Ptr AllocationParams
params'
    AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AllocationParams
params
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AllocationParamsInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod AllocationParamsInitMethodInfo AllocationParams signature where
    overloadedMethod = allocationParamsInit

instance O.OverloadedMethodInfo AllocationParamsInitMethodInfo AllocationParams where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.AllocationParams.allocationParamsInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-AllocationParams.html#v:allocationParamsInit"
        })


#endif

#if defined(ENABLE_OVERLOADING)
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.OverloadedMethod info AllocationParams p) => OL.IsLabel t (AllocationParams -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveAllocationParamsMethod t AllocationParams, O.OverloadedMethod info AllocationParams p, R.HasField t AllocationParams p) => R.HasField t AllocationParams p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveAllocationParamsMethod t AllocationParams, O.OverloadedMethodInfo info AllocationParams) => OL.IsLabel t (O.MethodProxy info AllocationParams) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif