{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gst.Objects.BufferPool.BufferPool' is an object that can be used to pre-allocate and recycle
-- buffers of the same size and with the same properties.
-- 
-- A t'GI.Gst.Objects.BufferPool.BufferPool' is created with 'GI.Gst.Objects.BufferPool.bufferPoolNew'.
-- 
-- Once a pool is created, it needs to be configured. A call to
-- 'GI.Gst.Objects.BufferPool.bufferPoolGetConfig' returns the current configuration structure from
-- the pool. With 'GI.Gst.Objects.BufferPool.bufferPoolConfigSetParams' and
-- 'GI.Gst.Objects.BufferPool.bufferPoolConfigSetAllocator' the bufferpool parameters and
-- allocator can be configured. Other properties can be configured in the pool
-- depending on the pool implementation.
-- 
-- A bufferpool can have extra options that can be enabled with
-- 'GI.Gst.Objects.BufferPool.bufferPoolConfigAddOption'. The available options can be retrieved
-- with 'GI.Gst.Objects.BufferPool.bufferPoolGetOptions'. Some options allow for additional
-- configuration properties to be set.
-- 
-- After the configuration structure has been configured,
-- 'GI.Gst.Objects.BufferPool.bufferPoolSetConfig' updates the configuration in the pool. This can
-- fail when the configuration structure is not accepted.
-- 
-- After the pool has been configured, it can be activated with
-- 'GI.Gst.Objects.BufferPool.bufferPoolSetActive'. This will preallocate the configured resources
-- in the pool.
-- 
-- When the pool is active, 'GI.Gst.Objects.BufferPool.bufferPoolAcquireBuffer' can be used to
-- retrieve a buffer from the pool.
-- 
-- Buffers allocated from a bufferpool will automatically be returned to the
-- pool with 'GI.Gst.Objects.BufferPool.bufferPoolReleaseBuffer' when their refcount drops to 0.
-- 
-- The bufferpool can be deactivated again with 'GI.Gst.Objects.BufferPool.bufferPoolSetActive'.
-- All further 'GI.Gst.Objects.BufferPool.bufferPoolAcquireBuffer' calls will return an error. When
-- all buffers are returned to the pool they will be freed.

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

module GI.Gst.Objects.BufferPool
    ( 

-- * Exported types
    BufferPool(..)                          ,
    IsBufferPool                            ,
    toBufferPool                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [acquireBuffer]("GI.Gst.Objects.BufferPool#g:method:acquireBuffer"), [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [hasOption]("GI.Gst.Objects.BufferPool#g:method:hasOption"), [isActive]("GI.Gst.Objects.BufferPool#g:method:isActive"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [releaseBuffer]("GI.Gst.Objects.BufferPool#g:method:releaseBuffer"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getConfig]("GI.Gst.Objects.BufferPool#g:method:getConfig"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getOptions]("GI.Gst.Objects.BufferPool#g:method:getOptions"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setActive]("GI.Gst.Objects.BufferPool#g:method:setActive"), [setConfig]("GI.Gst.Objects.BufferPool#g:method:setConfig"), [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFlushing]("GI.Gst.Objects.BufferPool#g:method:setFlushing"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBufferPoolMethod                 ,
#endif

-- ** acquireBuffer #method:acquireBuffer#

#if defined(ENABLE_OVERLOADING)
    BufferPoolAcquireBufferMethodInfo       ,
#endif
    bufferPoolAcquireBuffer                 ,


-- ** configAddOption #method:configAddOption#

    bufferPoolConfigAddOption               ,


-- ** configGetAllocator #method:configGetAllocator#

    bufferPoolConfigGetAllocator            ,


-- ** configGetOption #method:configGetOption#

    bufferPoolConfigGetOption               ,


-- ** configGetParams #method:configGetParams#

    bufferPoolConfigGetParams               ,


-- ** configHasOption #method:configHasOption#

    bufferPoolConfigHasOption               ,


-- ** configNOptions #method:configNOptions#

    bufferPoolConfigNOptions                ,


-- ** configSetAllocator #method:configSetAllocator#

    bufferPoolConfigSetAllocator            ,


-- ** configSetParams #method:configSetParams#

    bufferPoolConfigSetParams               ,


-- ** configValidateParams #method:configValidateParams#

    bufferPoolConfigValidateParams          ,


-- ** getConfig #method:getConfig#

#if defined(ENABLE_OVERLOADING)
    BufferPoolGetConfigMethodInfo           ,
#endif
    bufferPoolGetConfig                     ,


-- ** getOptions #method:getOptions#

#if defined(ENABLE_OVERLOADING)
    BufferPoolGetOptionsMethodInfo          ,
#endif
    bufferPoolGetOptions                    ,


-- ** hasOption #method:hasOption#

#if defined(ENABLE_OVERLOADING)
    BufferPoolHasOptionMethodInfo           ,
#endif
    bufferPoolHasOption                     ,


-- ** isActive #method:isActive#

#if defined(ENABLE_OVERLOADING)
    BufferPoolIsActiveMethodInfo            ,
#endif
    bufferPoolIsActive                      ,


-- ** new #method:new#

    bufferPoolNew                           ,


-- ** releaseBuffer #method:releaseBuffer#

#if defined(ENABLE_OVERLOADING)
    BufferPoolReleaseBufferMethodInfo       ,
#endif
    bufferPoolReleaseBuffer                 ,


-- ** setActive #method:setActive#

#if defined(ENABLE_OVERLOADING)
    BufferPoolSetActiveMethodInfo           ,
#endif
    bufferPoolSetActive                     ,


-- ** setConfig #method:setConfig#

#if defined(ENABLE_OVERLOADING)
    BufferPoolSetConfigMethodInfo           ,
#endif
    bufferPoolSetConfig                     ,


-- ** setFlushing #method:setFlushing#

#if defined(ENABLE_OVERLOADING)
    BufferPoolSetFlushingMethodInfo         ,
#endif
    bufferPoolSetFlushing                   ,




    ) 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.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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Objects.Allocator as Gst.Allocator
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.BufferPoolAcquireParams as Gst.BufferPoolAcquireParams
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

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

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

foreign import ccall "gst_buffer_pool_get_type"
    c_gst_buffer_pool_get_type :: IO B.Types.GType

instance B.Types.TypedObject BufferPool where
    glibType :: IO GType
glibType = IO GType
c_gst_buffer_pool_get_type

instance B.Types.GObject BufferPool

-- | Type class for types which can be safely cast to `BufferPool`, for instance with `toBufferPool`.
class (SP.GObject o, O.IsDescendantOf BufferPool o) => IsBufferPool o
instance (SP.GObject o, O.IsDescendantOf BufferPool o) => IsBufferPool o

instance O.HasParentTypes BufferPool
type instance O.ParentTypes BufferPool = '[Gst.Object.Object, GObject.Object.Object]

-- | Cast to `BufferPool`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toBufferPool :: (MIO.MonadIO m, IsBufferPool o) => o -> m BufferPool
toBufferPool :: forall (m :: * -> *) o.
(MonadIO m, IsBufferPool o) =>
o -> m BufferPool
toBufferPool = IO BufferPool -> m BufferPool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO BufferPool -> m BufferPool)
-> (o -> IO BufferPool) -> o -> m BufferPool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr BufferPool -> BufferPool) -> o -> IO BufferPool
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr BufferPool -> BufferPool
BufferPool

-- | Convert 'BufferPool' 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 BufferPool) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_buffer_pool_get_type
    gvalueSet_ :: Ptr GValue -> Maybe BufferPool -> IO ()
gvalueSet_ Ptr GValue
gv Maybe BufferPool
P.Nothing = Ptr GValue -> Ptr BufferPool -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr BufferPool
forall a. Ptr a
FP.nullPtr :: FP.Ptr BufferPool)
    gvalueSet_ Ptr GValue
gv (P.Just BufferPool
obj) = BufferPool -> (Ptr BufferPool -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BufferPool
obj (Ptr GValue -> Ptr BufferPool -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe BufferPool)
gvalueGet_ Ptr GValue
gv = do
        Ptr BufferPool
ptr <- Ptr GValue -> IO (Ptr BufferPool)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr BufferPool)
        if Ptr BufferPool
ptr Ptr BufferPool -> Ptr BufferPool -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BufferPool
forall a. Ptr a
FP.nullPtr
        then BufferPool -> Maybe BufferPool
forall a. a -> Maybe a
P.Just (BufferPool -> Maybe BufferPool)
-> IO BufferPool -> IO (Maybe BufferPool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr BufferPool -> BufferPool)
-> Ptr BufferPool -> IO BufferPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr BufferPool -> BufferPool
BufferPool Ptr BufferPool
ptr
        else Maybe BufferPool -> IO (Maybe BufferPool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BufferPool
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveBufferPoolMethod (t :: Symbol) (o :: *) :: * where
    ResolveBufferPoolMethod "acquireBuffer" o = BufferPoolAcquireBufferMethodInfo
    ResolveBufferPoolMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveBufferPoolMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBufferPoolMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBufferPoolMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveBufferPoolMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBufferPoolMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBufferPoolMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBufferPoolMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveBufferPoolMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveBufferPoolMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveBufferPoolMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveBufferPoolMethod "hasOption" o = BufferPoolHasOptionMethodInfo
    ResolveBufferPoolMethod "isActive" o = BufferPoolIsActiveMethodInfo
    ResolveBufferPoolMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBufferPoolMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBufferPoolMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBufferPoolMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveBufferPoolMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBufferPoolMethod "releaseBuffer" o = BufferPoolReleaseBufferMethodInfo
    ResolveBufferPoolMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveBufferPoolMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBufferPoolMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBufferPoolMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBufferPoolMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveBufferPoolMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveBufferPoolMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBufferPoolMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveBufferPoolMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveBufferPoolMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBufferPoolMethod "getConfig" o = BufferPoolGetConfigMethodInfo
    ResolveBufferPoolMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveBufferPoolMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveBufferPoolMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBufferPoolMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveBufferPoolMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveBufferPoolMethod "getOptions" o = BufferPoolGetOptionsMethodInfo
    ResolveBufferPoolMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveBufferPoolMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveBufferPoolMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBufferPoolMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBufferPoolMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveBufferPoolMethod "setActive" o = BufferPoolSetActiveMethodInfo
    ResolveBufferPoolMethod "setConfig" o = BufferPoolSetConfigMethodInfo
    ResolveBufferPoolMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveBufferPoolMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveBufferPoolMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveBufferPoolMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBufferPoolMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBufferPoolMethod "setFlushing" o = BufferPoolSetFlushingMethodInfo
    ResolveBufferPoolMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveBufferPoolMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveBufferPoolMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBufferPoolMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveBufferPoolMethod t BufferPool, O.OverloadedMethod info BufferPool p) => OL.IsLabel t (BufferPool -> 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 ~ ResolveBufferPoolMethod t BufferPool, O.OverloadedMethod info BufferPool p, R.HasField t BufferPool p) => R.HasField t BufferPool p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BufferPool
type instance O.AttributeList BufferPool = BufferPoolAttributeList
type BufferPoolAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList BufferPool = BufferPoolSignalList
type BufferPoolSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gst_buffer_pool_new" gst_buffer_pool_new :: 
    IO (Ptr BufferPool)

-- | Creates a new t'GI.Gst.Objects.BufferPool.BufferPool' instance.
bufferPoolNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m BufferPool
    -- ^ __Returns:__ a new t'GI.Gst.Objects.BufferPool.BufferPool' instance
bufferPoolNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m BufferPool
bufferPoolNew  = IO BufferPool -> m BufferPool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BufferPool -> m BufferPool) -> IO BufferPool -> m BufferPool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
result <- IO (Ptr BufferPool)
gst_buffer_pool_new
    Text -> Ptr BufferPool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferPoolNew" Ptr BufferPool
result
    BufferPool
result' <- ((ManagedPtr BufferPool -> BufferPool)
-> Ptr BufferPool -> IO BufferPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BufferPool -> BufferPool
BufferPool) Ptr BufferPool
result
    BufferPool -> IO BufferPool
forall (m :: * -> *) a. Monad m => a -> m a
return BufferPool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::acquire_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location for a #GstBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "BufferPoolAcquireParams" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "parameters." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_acquire_buffer" gst_buffer_pool_acquire_buffer :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    Ptr (Ptr Gst.Buffer.Buffer) ->          -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.BufferPoolAcquireParams.BufferPoolAcquireParams -> -- params : TInterface (Name {namespace = "Gst", name = "BufferPoolAcquireParams"})
    IO CInt

-- | Acquires a buffer from /@pool@/. /@buffer@/ should point to a memory location that
-- can hold a pointer to the new buffer.
-- 
-- /@params@/ can contain optional parameters to influence the allocation.
bufferPoolAcquireBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Maybe (Gst.BufferPoolAcquireParams.BufferPoolAcquireParams)
    -- ^ /@params@/: parameters.
    -> m ((Gst.Enums.FlowReturn, Gst.Buffer.Buffer))
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' such as 'GI.Gst.Enums.FlowReturnFlushing' when the pool is
    -- inactive.
bufferPoolAcquireBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> Maybe BufferPoolAcquireParams -> m (FlowReturn, Buffer)
bufferPoolAcquireBuffer a
pool Maybe BufferPoolAcquireParams
params = IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer))
-> IO (FlowReturn, Buffer) -> m (FlowReturn, Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    Ptr (Ptr Buffer)
buffer <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    Ptr BufferPoolAcquireParams
maybeParams <- case Maybe BufferPoolAcquireParams
params of
        Maybe BufferPoolAcquireParams
Nothing -> Ptr BufferPoolAcquireParams -> IO (Ptr BufferPoolAcquireParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr BufferPoolAcquireParams
forall a. Ptr a
nullPtr
        Just BufferPoolAcquireParams
jParams -> do
            Ptr BufferPoolAcquireParams
jParams' <- BufferPoolAcquireParams -> IO (Ptr BufferPoolAcquireParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BufferPoolAcquireParams
jParams
            Ptr BufferPoolAcquireParams -> IO (Ptr BufferPoolAcquireParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr BufferPoolAcquireParams
jParams'
    CInt
result <- Ptr BufferPool
-> Ptr (Ptr Buffer) -> Ptr BufferPoolAcquireParams -> IO CInt
gst_buffer_pool_acquire_buffer Ptr BufferPool
pool' Ptr (Ptr Buffer)
buffer Ptr BufferPoolAcquireParams
maybeParams
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    Ptr Buffer
buffer' <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Buffer)
buffer
    Buffer
buffer'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Maybe BufferPoolAcquireParams
-> (BufferPoolAcquireParams -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe BufferPoolAcquireParams
params BufferPoolAcquireParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Buffer)
buffer
    (FlowReturn, Buffer) -> IO (FlowReturn, Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return (FlowReturn
result', Buffer
buffer'')

#if defined(ENABLE_OVERLOADING)
data BufferPoolAcquireBufferMethodInfo
instance (signature ~ (Maybe (Gst.BufferPoolAcquireParams.BufferPoolAcquireParams) -> m ((Gst.Enums.FlowReturn, Gst.Buffer.Buffer))), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolAcquireBufferMethodInfo a signature where
    overloadedMethod = bufferPoolAcquireBuffer

instance O.OverloadedMethodInfo BufferPoolAcquireBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolAcquireBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolAcquireBuffer"
        })


#endif

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

foreign import ccall "gst_buffer_pool_get_config" gst_buffer_pool_get_config :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    IO (Ptr Gst.Structure.Structure)

-- | Gets a copy of the current configuration of the pool. This configuration
-- can be modified and used for the 'GI.Gst.Objects.BufferPool.bufferPoolSetConfig' call.
bufferPoolGetConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ a copy of the current configuration of /@pool@/.
bufferPoolGetConfig :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> m Structure
bufferPoolGetConfig a
pool = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    Ptr Structure
result <- Ptr BufferPool -> IO (Ptr Structure)
gst_buffer_pool_get_config Ptr BufferPool
pool'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferPoolGetConfig" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data BufferPoolGetConfigMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolGetConfigMethodInfo a signature where
    overloadedMethod = bufferPoolGetConfig

instance O.OverloadedMethodInfo BufferPoolGetConfigMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolGetConfig",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolGetConfig"
        })


#endif

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

foreign import ccall "gst_buffer_pool_get_options" gst_buffer_pool_get_options :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    IO (Ptr CString)

-- | Gets a 'P.Nothing' terminated array of string with supported bufferpool options for
-- /@pool@/. An option would typically be enabled with
-- 'GI.Gst.Objects.BufferPool.bufferPoolConfigAddOption'.
bufferPoolGetOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing' terminated array
    --          of strings.
bufferPoolGetOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> m [Text]
bufferPoolGetOptions a
pool = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    Ptr CString
result <- Ptr BufferPool -> IO (Ptr CString)
gst_buffer_pool_get_options Ptr BufferPool
pool'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bufferPoolGetOptions" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data BufferPoolGetOptionsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolGetOptionsMethodInfo a signature where
    overloadedMethod = bufferPoolGetOptions

instance O.OverloadedMethodInfo BufferPoolGetOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolGetOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolGetOptions"
        })


#endif

-- method BufferPool::has_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an option" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_has_option" gst_buffer_pool_has_option :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    CString ->                              -- option : TBasicType TUTF8
    IO CInt

-- | Checks if the bufferpool supports /@option@/.
bufferPoolHasOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> T.Text
    -- ^ /@option@/: an option
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the buffer pool contains /@option@/.
bufferPoolHasOption :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> Text -> m Bool
bufferPoolHasOption a
pool Text
option = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    CString
option' <- Text -> IO CString
textToCString Text
option
    CInt
result <- Ptr BufferPool -> CString -> IO CInt
gst_buffer_pool_has_option Ptr BufferPool
pool' CString
option'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
option'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferPoolHasOptionMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolHasOptionMethodInfo a signature where
    overloadedMethod = bufferPoolHasOption

instance O.OverloadedMethodInfo BufferPoolHasOptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolHasOption",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolHasOption"
        })


#endif

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

foreign import ccall "gst_buffer_pool_is_active" gst_buffer_pool_is_active :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    IO CInt

-- | Checks if /@pool@/ is active. A pool can be activated with the
-- 'GI.Gst.Objects.BufferPool.bufferPoolSetActive' call.
bufferPoolIsActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> m Bool
    -- ^ __Returns:__ 'P.True' when the pool is active.
bufferPoolIsActive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> m Bool
bufferPoolIsActive a
pool = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    CInt
result <- Ptr BufferPool -> IO CInt
gst_buffer_pool_is_active Ptr BufferPool
pool'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferPoolIsActiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolIsActiveMethodInfo a signature where
    overloadedMethod = bufferPoolIsActive

instance O.OverloadedMethodInfo BufferPoolIsActiveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolIsActive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolIsActive"
        })


#endif

-- method BufferPool::release_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_release_buffer" gst_buffer_pool_release_buffer :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO ()

-- | Releases /@buffer@/ to /@pool@/. /@buffer@/ should have previously been allocated from
-- /@pool@/ with 'GI.Gst.Objects.BufferPool.bufferPoolAcquireBuffer'.
-- 
-- This function is usually called automatically when the last ref on /@buffer@/
-- disappears.
bufferPoolReleaseBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer'
    -> m ()
bufferPoolReleaseBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> Buffer -> m ()
bufferPoolReleaseBuffer a
pool Buffer
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    Ptr BufferPool -> Ptr Buffer -> IO ()
gst_buffer_pool_release_buffer Ptr BufferPool
pool' Ptr Buffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferPoolReleaseBufferMethodInfo
instance (signature ~ (Gst.Buffer.Buffer -> m ()), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolReleaseBufferMethodInfo a signature where
    overloadedMethod = bufferPoolReleaseBuffer

instance O.OverloadedMethodInfo BufferPoolReleaseBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolReleaseBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolReleaseBuffer"
        })


#endif

-- method BufferPool::set_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new active state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_set_active" gst_buffer_pool_set_active :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Controls the active state of /@pool@/. When the pool is inactive, new calls to
-- 'GI.Gst.Objects.BufferPool.bufferPoolAcquireBuffer' will return with 'GI.Gst.Enums.FlowReturnFlushing'.
-- 
-- Activating the bufferpool will preallocate all resources in the pool based on
-- the configuration of the pool.
-- 
-- Deactivating will free the resources again when there are no outstanding
-- buffers. When there are outstanding buffers, they will be freed as soon as
-- they are all returned to the pool.
bufferPoolSetActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Bool
    -- ^ /@active@/: the new active state
    -> m Bool
    -- ^ __Returns:__ 'P.False' when the pool was not configured or when preallocation of the
    -- buffers failed.
bufferPoolSetActive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> Bool -> m Bool
bufferPoolSetActive a
pool Bool
active = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let active' :: CInt
active' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
active
    CInt
result <- Ptr BufferPool -> CInt -> IO CInt
gst_buffer_pool_set_active Ptr BufferPool
pool' CInt
active'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferPoolSetActiveMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolSetActiveMethodInfo a signature where
    overloadedMethod = bufferPoolSetActive

instance O.OverloadedMethodInfo BufferPoolSetActiveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolSetActive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolSetActive"
        })


#endif

-- method BufferPool::set_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_set_config" gst_buffer_pool_set_config :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Sets the configuration of the pool. If the pool is already configured, and
-- the configuration hasn\'t changed, this function will return 'P.True'. If the
-- pool is active, this method will return 'P.False' and active configuration
-- will remain. Buffers allocated from this pool must be returned or else this
-- function will do nothing and return 'P.False'.
-- 
-- /@config@/ is a t'GI.Gst.Structs.Structure.Structure' that contains the configuration parameters for
-- the pool. A default and mandatory set of parameters can be configured with
-- 'GI.Gst.Objects.BufferPool.bufferPoolConfigSetParams', 'GI.Gst.Objects.BufferPool.bufferPoolConfigSetAllocator'
-- and 'GI.Gst.Objects.BufferPool.bufferPoolConfigAddOption'.
-- 
-- If the parameters in /@config@/ can not be set exactly, this function returns
-- 'P.False' and will try to update as much state as possible. The new state can
-- then be retrieved and refined with 'GI.Gst.Objects.BufferPool.bufferPoolGetConfig'.
-- 
-- This function takes ownership of /@config@/.
bufferPoolSetConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m Bool
    -- ^ __Returns:__ 'P.True' when the configuration could be set.
bufferPoolSetConfig :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> Structure -> m Bool
bufferPoolSetConfig a
pool Structure
config = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
config
    CInt
result <- Ptr BufferPool -> Ptr Structure -> IO CInt
gst_buffer_pool_set_config Ptr BufferPool
pool' Ptr Structure
config'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BufferPoolSetConfigMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m Bool), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolSetConfigMethodInfo a signature where
    overloadedMethod = bufferPoolSetConfig

instance O.OverloadedMethodInfo BufferPoolSetConfigMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolSetConfig",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolSetConfig"
        })


#endif

-- method BufferPool::set_flushing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pool"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferPool" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flushing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to start or stop flushing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_set_flushing" gst_buffer_pool_set_flushing :: 
    Ptr BufferPool ->                       -- pool : TInterface (Name {namespace = "Gst", name = "BufferPool"})
    CInt ->                                 -- flushing : TBasicType TBoolean
    IO ()

-- | Enables or disables the flushing state of a /@pool@/ without freeing or
-- allocating buffers.
-- 
-- /Since: 1.4/
bufferPoolSetFlushing ::
    (B.CallStack.HasCallStack, MonadIO m, IsBufferPool a) =>
    a
    -- ^ /@pool@/: a t'GI.Gst.Objects.BufferPool.BufferPool'
    -> Bool
    -- ^ /@flushing@/: whether to start or stop flushing
    -> m ()
bufferPoolSetFlushing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBufferPool a) =>
a -> Bool -> m ()
bufferPoolSetFlushing a
pool Bool
flushing = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BufferPool
pool' <- a -> IO (Ptr BufferPool)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pool
    let flushing' :: CInt
flushing' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
flushing
    Ptr BufferPool -> CInt -> IO ()
gst_buffer_pool_set_flushing Ptr BufferPool
pool' CInt
flushing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pool
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BufferPoolSetFlushingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBufferPool a) => O.OverloadedMethod BufferPoolSetFlushingMethodInfo a signature where
    overloadedMethod = bufferPoolSetFlushing

instance O.OverloadedMethodInfo BufferPoolSetFlushingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Objects.BufferPool.bufferPoolSetFlushing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Objects-BufferPool.html#v:bufferPoolSetFlushing"
        })


#endif

-- method BufferPool::config_add_option
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an option to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_add_option" gst_buffer_pool_config_add_option :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- option : TBasicType TUTF8
    IO ()

-- | Enables the option in /@config@/. This will instruct the /@bufferpool@/ to enable
-- the specified option on the buffers that it allocates.
-- 
-- The options supported by /@pool@/ can be retrieved with 'GI.Gst.Objects.BufferPool.bufferPoolGetOptions'.
bufferPoolConfigAddOption ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> T.Text
    -- ^ /@option@/: an option to add
    -> m ()
bufferPoolConfigAddOption :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m ()
bufferPoolConfigAddOption Structure
config Text
option = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    CString
option' <- Text -> IO CString
textToCString Text
option
    Ptr Structure -> CString -> IO ()
gst_buffer_pool_config_add_option Ptr Structure
config' CString
option'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
option'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_get_allocator
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAllocator, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstAllocationParams, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_get_allocator" gst_buffer_pool_config_get_allocator :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr (Ptr Gst.Allocator.Allocator) ->    -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO CInt

-- | Gets the /@allocator@/ and /@params@/ from /@config@/.
bufferPoolConfigGetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> m ((Bool, Maybe Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
    -- ^ __Returns:__ 'P.True', if the values are set.
bufferPoolConfigGetAllocator :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m (Bool, Maybe Allocator, AllocationParams)
bufferPoolConfigGetAllocator Structure
config = IO (Bool, Maybe Allocator, AllocationParams)
-> m (Bool, Maybe Allocator, AllocationParams)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Maybe Allocator, AllocationParams)
 -> m (Bool, Maybe Allocator, AllocationParams))
-> IO (Bool, Maybe Allocator, AllocationParams)
-> m (Bool, Maybe Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    Ptr (Ptr Allocator)
allocator <- IO (Ptr (Ptr Allocator))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
64 :: IO (Ptr Gst.AllocationParams.AllocationParams)
    CInt
result <- Ptr Structure
-> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO CInt
gst_buffer_pool_config_get_allocator Ptr Structure
config' Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Maybe Allocator
maybeAllocator' <- Ptr Allocator
-> (Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Allocator
allocator' ((Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator))
-> (Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator)
forall a b. (a -> b) -> a -> b
$ \Ptr Allocator
allocator'' -> do
        Allocator
allocator''' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator''
        Allocator -> IO Allocator
forall (m :: * -> *) a. Monad m => a -> m a
return Allocator
allocator'''
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
Gst.AllocationParams.AllocationParams) Ptr AllocationParams
params
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Bool, Maybe Allocator, AllocationParams)
-> IO (Bool, Maybe Allocator, AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Maybe Allocator
maybeAllocator', AllocationParams
params')

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_get_option
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position in the option array to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_get_option" gst_buffer_pool_config_get_option :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    Word32 ->                               -- index : TBasicType TUInt
    IO CString

-- | Parses an available /@config@/ and gets the option at /@index@/ of the options API
-- array.
bufferPoolConfigGetOption ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> Word32
    -- ^ /@index@/: position in the option array to read
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the option at /@index@/.
bufferPoolConfigGetOption :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Word32 -> m (Maybe Text)
bufferPoolConfigGetOption Structure
config Word32
index = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    CString
result <- Ptr Structure -> Word32 -> IO CString
gst_buffer_pool_config_get_option Ptr Structure
config' Word32
index
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_get_params
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the caps of buffers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the size of each buffer, not including prefix and padding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "min_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minimum amount of buffers to allocate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "max_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the maximum amount of buffers to allocate or 0 for unlimited."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_get_params" gst_buffer_pool_config_get_params :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr (Ptr Gst.Caps.Caps) ->              -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Word32 ->                           -- size : TBasicType TUInt
    Ptr Word32 ->                           -- min_buffers : TBasicType TUInt
    Ptr Word32 ->                           -- max_buffers : TBasicType TUInt
    IO CInt

-- | Gets the configuration values from /@config@/.
bufferPoolConfigGetParams ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> m ((Bool, Maybe Gst.Caps.Caps, Word32, Word32, Word32))
    -- ^ __Returns:__ 'P.True' if all parameters could be fetched.
bufferPoolConfigGetParams :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m (Bool, Maybe Caps, Word32, Word32, Word32)
bufferPoolConfigGetParams Structure
config = IO (Bool, Maybe Caps, Word32, Word32, Word32)
-> m (Bool, Maybe Caps, Word32, Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Maybe Caps, Word32, Word32, Word32)
 -> m (Bool, Maybe Caps, Word32, Word32, Word32))
-> IO (Bool, Maybe Caps, Word32, Word32, Word32)
-> m (Bool, Maybe Caps, Word32, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    Ptr (Ptr Caps)
caps <- IO (Ptr (Ptr Caps))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    Ptr Word32
size <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
minBuffers <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
maxBuffers <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Structure
-> Ptr (Ptr Caps)
-> Ptr Word32
-> Ptr Word32
-> Ptr Word32
-> IO CInt
gst_buffer_pool_config_get_params Ptr Structure
config' Ptr (Ptr Caps)
caps Ptr Word32
size Ptr Word32
minBuffers Ptr Word32
maxBuffers
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Caps
caps' <- Ptr (Ptr Caps) -> IO (Ptr Caps)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Caps)
caps
    Maybe Caps
maybeCaps' <- Ptr Caps -> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Caps
caps' ((Ptr Caps -> IO Caps) -> IO (Maybe Caps))
-> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ \Ptr Caps
caps'' -> do
        Caps
caps''' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
caps''
        Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
caps'''
    Word32
size' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
size
    Word32
minBuffers' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
minBuffers
    Word32
maxBuffers' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
maxBuffers
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Ptr (Ptr Caps) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Caps)
caps
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
size
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
minBuffers
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
maxBuffers
    (Bool, Maybe Caps, Word32, Word32, Word32)
-> IO (Bool, Maybe Caps, Word32, Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Maybe Caps
maybeCaps', Word32
size', Word32
minBuffers', Word32
maxBuffers')

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_has_option
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an option" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_has_option" gst_buffer_pool_config_has_option :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    CString ->                              -- option : TBasicType TUTF8
    IO CInt

-- | Checks if /@config@/ contains /@option@/.
bufferPoolConfigHasOption ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> T.Text
    -- ^ /@option@/: an option
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the options array contains /@option@/.
bufferPoolConfigHasOption :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Text -> m Bool
bufferPoolConfigHasOption Structure
config Text
option = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    CString
option' <- Text -> IO CString
textToCString Text
option
    CInt
result <- Ptr Structure -> CString -> IO CInt
gst_buffer_pool_config_has_option Ptr Structure
config' CString
option'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
option'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_n_options
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_n_options" gst_buffer_pool_config_n_options :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO Word32

-- | Retrieves the number of values currently stored in the options array of the
-- /@config@/ structure.
bufferPoolConfigNOptions ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> m Word32
    -- ^ __Returns:__ the options array size as a @/guint/@.
bufferPoolConfigNOptions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Word32
bufferPoolConfigNOptions Structure
config = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    Word32
result <- Ptr Structure -> IO Word32
gst_buffer_pool_config_n_options Ptr Structure
config'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_set_allocator
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAllocator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#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_buffer_pool_config_set_allocator" gst_buffer_pool_config_set_allocator :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Gst.Allocator.Allocator ->          -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Sets the /@allocator@/ and /@params@/ on /@config@/.
-- 
-- One of /@allocator@/ and /@params@/ can be 'P.Nothing', but not both. When /@allocator@/
-- is 'P.Nothing', the default allocator of the pool will use the values in /@param@/
-- to perform its allocation. When /@param@/ is 'P.Nothing', the pool will use the
-- provided /@allocator@/ with its default t'GI.Gst.Structs.AllocationParams.AllocationParams'.
-- 
-- A call to 'GI.Gst.Objects.BufferPool.bufferPoolSetConfig' can update the allocator and params
-- with the values that it is able to do. Some pools are, for example, not able
-- to operate with different allocators or cannot allocate with the values
-- specified in /@params@/. Use 'GI.Gst.Objects.BufferPool.bufferPoolGetConfig' to get the currently
-- used values.
bufferPoolConfigSetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Allocator.IsAllocator a) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> Maybe (a)
    -- ^ /@allocator@/: a t'GI.Gst.Objects.Allocator.Allocator'
    -> Maybe (Gst.AllocationParams.AllocationParams)
    -- ^ /@params@/: t'GI.Gst.Structs.AllocationParams.AllocationParams'
    -> m ()
bufferPoolConfigSetAllocator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAllocator a) =>
Structure -> Maybe a -> Maybe AllocationParams -> m ()
bufferPoolConfigSetAllocator Structure
config Maybe a
allocator Maybe AllocationParams
params = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    Ptr Allocator
maybeAllocator <- case Maybe a
allocator of
        Maybe a
Nothing -> Ptr Allocator -> IO (Ptr Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
forall a. Ptr a
nullPtr
        Just a
jAllocator -> do
            Ptr Allocator
jAllocator' <- a -> IO (Ptr Allocator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jAllocator
            Ptr Allocator -> IO (Ptr Allocator)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Allocator
jAllocator'
    Ptr AllocationParams
maybeParams <- case Maybe AllocationParams
params of
        Maybe AllocationParams
Nothing -> Ptr AllocationParams -> IO (Ptr AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
forall a. Ptr a
nullPtr
        Just AllocationParams
jParams -> do
            Ptr AllocationParams
jParams' <- AllocationParams -> IO (Ptr AllocationParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AllocationParams
jParams
            Ptr AllocationParams -> IO (Ptr AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AllocationParams
jParams'
    Ptr Structure -> Ptr Allocator -> Ptr AllocationParams -> IO ()
gst_buffer_pool_config_set_allocator Ptr Structure
config' Ptr Allocator
maybeAllocator Ptr AllocationParams
maybeParams
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
allocator a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe AllocationParams -> (AllocationParams -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe AllocationParams
params AllocationParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_set_params
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caps for the buffers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the size of each buffer, not including prefix and padding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minimum amount of buffers to allocate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the maximum amount of buffers to allocate or 0 for unlimited."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_set_params" gst_buffer_pool_config_set_params :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- size : TBasicType TUInt
    Word32 ->                               -- min_buffers : TBasicType TUInt
    Word32 ->                               -- max_buffers : TBasicType TUInt
    IO ()

-- | Configures /@config@/ with the given parameters.
bufferPoolConfigSetParams ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: caps for the buffers
    -> Word32
    -- ^ /@size@/: the size of each buffer, not including prefix and padding
    -> Word32
    -- ^ /@minBuffers@/: the minimum amount of buffers to allocate.
    -> Word32
    -- ^ /@maxBuffers@/: the maximum amount of buffers to allocate or 0 for unlimited.
    -> m ()
bufferPoolConfigSetParams :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Maybe Caps -> Word32 -> Word32 -> Word32 -> m ()
bufferPoolConfigSetParams Structure
config Maybe Caps
caps Word32
size Word32
minBuffers Word32
maxBuffers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Structure -> Ptr Caps -> Word32 -> Word32 -> Word32 -> IO ()
gst_buffer_pool_config_set_params Ptr Structure
config' Ptr Caps
maybeCaps Word32
size Word32
minBuffers Word32
maxBuffers
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method BufferPool::config_validate_params
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPool configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the excepted caps of buffers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the expected size of each buffer, not including prefix and padding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the expected minimum amount of buffers to allocate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_buffers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the expect maximum amount of buffers to allocate or 0 for unlimited."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_pool_config_validate_params" gst_buffer_pool_config_validate_params :: 
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Word32 ->                               -- size : TBasicType TUInt
    Word32 ->                               -- min_buffers : TBasicType TUInt
    Word32 ->                               -- max_buffers : TBasicType TUInt
    IO CInt

-- | Validates that changes made to /@config@/ are still valid in the context of the
-- expected parameters. This function is a helper that can be used to validate
-- changes made by a pool to a config when 'GI.Gst.Objects.BufferPool.bufferPoolSetConfig'
-- returns 'P.False'. This expects that /@caps@/ haven\'t changed and that
-- /@minBuffers@/ aren\'t lower then what we initially expected.
-- This does not check if options or allocator parameters are still valid,
-- won\'t check if size have changed, since changing the size is valid to adapt
-- padding.
-- 
-- /Since: 1.4/
bufferPoolConfigValidateParams ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    -- ^ /@config@/: a t'GI.Gst.Objects.BufferPool.BufferPool' configuration
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: the excepted caps of buffers
    -> Word32
    -- ^ /@size@/: the expected size of each buffer, not including prefix and padding
    -> Word32
    -- ^ /@minBuffers@/: the expected minimum amount of buffers to allocate.
    -> Word32
    -- ^ /@maxBuffers@/: the expect maximum amount of buffers to allocate or 0 for unlimited.
    -> m Bool
    -- ^ __Returns:__ 'P.True', if the parameters are valid in this context.
bufferPoolConfigValidateParams :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> Maybe Caps -> Word32 -> Word32 -> Word32 -> m Bool
bufferPoolConfigValidateParams Structure
config Maybe Caps
caps Word32
size Word32
minBuffers Word32
maxBuffers = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
config' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
config
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    CInt
result <- Ptr Structure -> Ptr Caps -> Word32 -> Word32 -> Word32 -> IO CInt
gst_buffer_pool_config_validate_params Ptr Structure
config' Ptr Caps
maybeCaps Word32
size Word32
minBuffers Word32
maxBuffers
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
config
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif