{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Utility struct to help handling t'GI.Gst.Enums.FlowReturn' combination. Useful for
-- t'GI.Gst.Objects.Element.Element's that have multiple source pads and need to combine
-- the different t'GI.Gst.Enums.FlowReturn' for those pads.
-- 
-- t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' works by using the last t'GI.Gst.Enums.FlowReturn' for all t'GI.Gst.Objects.Pad.Pad'
-- it has in its list and computes the combined return value and provides
-- it to the caller.
-- 
-- To add a new pad to the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' use 'GI.GstBase.Structs.FlowCombiner.flowCombinerAddPad'.
-- The new t'GI.Gst.Objects.Pad.Pad' is stored with a default value of 'GI.Gst.Enums.FlowReturnOk'.
-- 
-- In case you want a t'GI.Gst.Objects.Pad.Pad' to be removed, use 'GI.GstBase.Structs.FlowCombiner.flowCombinerRemovePad'.
-- 
-- Please be aware that this struct isn\'t thread safe as its designed to be
--  used by demuxers, those usually will have a single thread operating it.
-- 
-- These functions will take refs on the passed t'GI.Gst.Objects.Pad.Pad's.
-- 
-- Aside from reducing the user\'s code size, the main advantage of using this
-- helper struct is to follow the standard rules for t'GI.Gst.Enums.FlowReturn' combination.
-- These rules are:
-- 
-- * 'GI.Gst.Enums.FlowReturnEos': only if all returns are EOS too
-- * 'GI.Gst.Enums.FlowReturnNotLinked': only if all returns are NOT_LINKED too
-- * 'GI.Gst.Enums.FlowReturnError' or below: if at least one returns an error return
-- * 'GI.Gst.Enums.FlowReturnNotNegotiated': if at least one returns a not-negotiated return
-- * 'GI.Gst.Enums.FlowReturnFlushing': if at least one returns flushing
-- * 'GI.Gst.Enums.FlowReturnOk': otherwise
-- 
-- 'GI.Gst.Enums.FlowReturnError' or below, GST_FLOW_NOT_NEGOTIATED and GST_FLOW_FLUSHING are
-- returned immediately from the 'GI.GstBase.Structs.FlowCombiner.flowCombinerUpdateFlow' function.
-- 
-- /Since: 1.4/

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

module GI.GstBase.Structs.FlowCombiner
    ( 

-- * Exported types
    FlowCombiner(..)                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFlowCombinerMethod               ,
#endif


-- ** addPad #method:addPad#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerAddPadMethodInfo            ,
#endif
    flowCombinerAddPad                      ,


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerClearMethodInfo             ,
#endif
    flowCombinerClear                       ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerFreeMethodInfo              ,
#endif
    flowCombinerFree                        ,


-- ** new #method:new#

    flowCombinerNew                         ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerRefMethodInfo               ,
#endif
    flowCombinerRef                         ,


-- ** removePad #method:removePad#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerRemovePadMethodInfo         ,
#endif
    flowCombinerRemovePad                   ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerResetMethodInfo             ,
#endif
    flowCombinerReset                       ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerUnrefMethodInfo             ,
#endif
    flowCombinerUnref                       ,


-- ** updateFlow #method:updateFlow#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerUpdateFlowMethodInfo        ,
#endif
    flowCombinerUpdateFlow                  ,


-- ** updatePadFlow #method:updatePadFlow#

#if defined(ENABLE_OVERLOADING)
    FlowCombinerUpdatePadFlowMethodInfo     ,
#endif
    flowCombinerUpdatePadFlow               ,




    ) where

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

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

import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.Objects.Pad as Gst.Pad

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

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

foreign import ccall "gst_flow_combiner_get_type" c_gst_flow_combiner_get_type :: 
    IO GType

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

instance B.Types.TypedObject FlowCombiner where
    glibType :: IO GType
glibType = IO GType
c_gst_flow_combiner_get_type

instance B.Types.GBoxed FlowCombiner

-- | Convert 'FlowCombiner' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue FlowCombiner where
    toGValue :: FlowCombiner -> IO GValue
toGValue FlowCombiner
o = do
        GType
gtype <- IO GType
c_gst_flow_combiner_get_type
        FlowCombiner -> (Ptr FlowCombiner -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FlowCombiner
o (GType
-> (GValue -> Ptr FlowCombiner -> IO ())
-> Ptr FlowCombiner
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr FlowCombiner -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO FlowCombiner
fromGValue GValue
gv = do
        Ptr FlowCombiner
ptr <- GValue -> IO (Ptr FlowCombiner)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr FlowCombiner)
        (ManagedPtr FlowCombiner -> FlowCombiner)
-> Ptr FlowCombiner -> IO FlowCombiner
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr FlowCombiner -> FlowCombiner
FlowCombiner Ptr FlowCombiner
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FlowCombiner
type instance O.AttributeList FlowCombiner = FlowCombinerAttributeList
type FlowCombinerAttributeList = ('[ ] :: [(Symbol, *)])
#endif

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

foreign import ccall "gst_flow_combiner_new" gst_flow_combiner_new :: 
    IO (Ptr FlowCombiner)

-- | Creates a new t'GI.GstBase.Structs.FlowCombiner.FlowCombiner', use 'GI.GstBase.Structs.FlowCombiner.flowCombinerFree' to free it.
-- 
-- /Since: 1.4/
flowCombinerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FlowCombiner
    -- ^ __Returns:__ A new t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
flowCombinerNew :: m FlowCombiner
flowCombinerNew  = IO FlowCombiner -> m FlowCombiner
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowCombiner -> m FlowCombiner)
-> IO FlowCombiner -> m FlowCombiner
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowCombiner
result <- IO (Ptr FlowCombiner)
gst_flow_combiner_new
    Text -> Ptr FlowCombiner -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"flowCombinerNew" Ptr FlowCombiner
result
    FlowCombiner
result' <- ((ManagedPtr FlowCombiner -> FlowCombiner)
-> Ptr FlowCombiner -> IO FlowCombiner
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FlowCombiner -> FlowCombiner
FlowCombiner) Ptr FlowCombiner
result
    FlowCombiner -> IO FlowCombiner
forall (m :: * -> *) a. Monad m => a -> m a
return FlowCombiner
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method FlowCombiner::add_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad that is being added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_add_pad" gst_flow_combiner_add_pad :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO ()

-- | Adds a new t'GI.Gst.Objects.Pad.Pad' to the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'.
-- 
-- /Since: 1.4/
flowCombinerAddPad ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.IsPad a) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
    -> a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' that is being added
    -> m ()
flowCombinerAddPad :: FlowCombiner -> a -> m ()
flowCombinerAddPad FlowCombiner
combiner a
pad = 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 FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr FlowCombiner -> Ptr Pad -> IO ()
gst_flow_combiner_add_pad Ptr FlowCombiner
combiner' Ptr Pad
pad'
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlowCombinerAddPadMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Gst.Pad.IsPad a) => O.MethodInfo FlowCombinerAddPadMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerAddPad

#endif

-- method FlowCombiner::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner to clear"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_clear" gst_flow_combiner_clear :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    IO ()

-- | Removes all pads from a t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' and resets it to its initial state.
-- 
-- /Since: 1.6/
flowCombinerClear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' to clear
    -> m ()
flowCombinerClear :: FlowCombiner -> m ()
flowCombinerClear FlowCombiner
combiner = 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 FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr FlowCombiner -> IO ()
gst_flow_combiner_clear Ptr FlowCombiner
combiner'
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlowCombinerClearMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FlowCombinerClearMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerClear

#endif

-- method FlowCombiner::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner to free"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_free" gst_flow_combiner_free :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    IO ()

-- | Frees a t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' struct and all its internal data.
-- 
-- /Since: 1.4/
flowCombinerFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' to free
    -> m ()
flowCombinerFree :: FlowCombiner -> m ()
flowCombinerFree FlowCombiner
combiner = 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 FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr FlowCombiner -> IO ()
gst_flow_combiner_free Ptr FlowCombiner
combiner'
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlowCombinerFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FlowCombinerFreeMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerFree

#endif

-- method FlowCombiner::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner to add a reference to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GstBase" , name = "FlowCombiner" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_ref" gst_flow_combiner_ref :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    IO (Ptr FlowCombiner)

-- | Increments the reference count on the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'.
-- 
-- /Since: 1.12.1/
flowCombinerRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' to add a reference to.
    -> m FlowCombiner
    -- ^ __Returns:__ the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'.
flowCombinerRef :: FlowCombiner -> m FlowCombiner
flowCombinerRef FlowCombiner
combiner = IO FlowCombiner -> m FlowCombiner
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowCombiner -> m FlowCombiner)
-> IO FlowCombiner -> m FlowCombiner
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr FlowCombiner
result <- Ptr FlowCombiner -> IO (Ptr FlowCombiner)
gst_flow_combiner_ref Ptr FlowCombiner
combiner'
    Text -> Ptr FlowCombiner -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"flowCombinerRef" Ptr FlowCombiner
result
    FlowCombiner
result' <- ((ManagedPtr FlowCombiner -> FlowCombiner)
-> Ptr FlowCombiner -> IO FlowCombiner
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FlowCombiner -> FlowCombiner
FlowCombiner) Ptr FlowCombiner
result
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    FlowCombiner -> IO FlowCombiner
forall (m :: * -> *) a. Monad m => a -> m a
return FlowCombiner
result'

#if defined(ENABLE_OVERLOADING)
data FlowCombinerRefMethodInfo
instance (signature ~ (m FlowCombiner), MonadIO m) => O.MethodInfo FlowCombinerRefMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerRef

#endif

-- method FlowCombiner::remove_pad
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_remove_pad" gst_flow_combiner_remove_pad :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    IO ()

-- | Removes a t'GI.Gst.Objects.Pad.Pad' from the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'.
-- 
-- /Since: 1.4/
flowCombinerRemovePad ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.IsPad a) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
    -> a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' to remove
    -> m ()
flowCombinerRemovePad :: FlowCombiner -> a -> m ()
flowCombinerRemovePad FlowCombiner
combiner a
pad = 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 FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    Ptr FlowCombiner -> Ptr Pad -> IO ()
gst_flow_combiner_remove_pad Ptr FlowCombiner
combiner' Ptr Pad
pad'
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlowCombinerRemovePadMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Gst.Pad.IsPad a) => O.MethodInfo FlowCombinerRemovePadMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerRemovePad

#endif

-- method FlowCombiner::reset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner to clear"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_reset" gst_flow_combiner_reset :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    IO ()

-- | Reset flow combiner and all pads to their initial state without removing pads.
-- 
-- /Since: 1.6/
flowCombinerReset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' to clear
    -> m ()
flowCombinerReset :: FlowCombiner -> m ()
flowCombinerReset FlowCombiner
combiner = 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 FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr FlowCombiner -> IO ()
gst_flow_combiner_reset Ptr FlowCombiner
combiner'
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlowCombinerResetMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FlowCombinerResetMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerReset

#endif

-- method FlowCombiner::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner to unreference."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_flow_combiner_unref" gst_flow_combiner_unref :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    IO ()

-- | Decrements the reference count on the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'.
-- 
-- /Since: 1.12.1/
flowCombinerUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner' to unreference.
    -> m ()
flowCombinerUnref :: FlowCombiner -> m ()
flowCombinerUnref FlowCombiner
combiner = 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 FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr FlowCombiner -> IO ()
gst_flow_combiner_unref Ptr FlowCombiner
combiner'
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlowCombinerUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FlowCombinerUnrefMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerUnref

#endif

-- method FlowCombiner::update_flow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fret"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "FlowReturn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the latest #GstFlowReturn received for a pad in this #GstFlowCombiner"
--                 , 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_flow_combiner_update_flow" gst_flow_combiner_update_flow :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    CInt ->                                 -- fret : TInterface (Name {namespace = "Gst", name = "FlowReturn"})
    IO CInt

-- | Computes the combined flow return for the pads in it.
-- 
-- The t'GI.Gst.Enums.FlowReturn' parameter should be the last flow return update for a pad
-- in this t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'. It will use this value to be able to shortcut some
-- combinations and avoid looking over all pads again. e.g. The last combined
-- return is the same as the latest obtained t'GI.Gst.Enums.FlowReturn'.
-- 
-- /Since: 1.4/
flowCombinerUpdateFlow ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
    -> Gst.Enums.FlowReturn
    -- ^ /@fret@/: the latest t'GI.Gst.Enums.FlowReturn' received for a pad in this t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ The combined t'GI.Gst.Enums.FlowReturn'
flowCombinerUpdateFlow :: FlowCombiner -> FlowReturn -> m FlowReturn
flowCombinerUpdateFlow FlowCombiner
combiner FlowReturn
fret = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    let fret' :: CInt
fret' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (FlowReturn -> Int) -> FlowReturn -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowReturn -> Int
forall a. Enum a => a -> Int
fromEnum) FlowReturn
fret
    CInt
result <- Ptr FlowCombiner -> CInt -> IO CInt
gst_flow_combiner_update_flow Ptr FlowCombiner
combiner' CInt
fret'
    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
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data FlowCombinerUpdateFlowMethodInfo
instance (signature ~ (Gst.Enums.FlowReturn -> m Gst.Enums.FlowReturn), MonadIO m) => O.MethodInfo FlowCombinerUpdateFlowMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerUpdateFlow

#endif

-- method FlowCombiner::update_pad_flow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "combiner"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "FlowCombiner" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstFlowCombiner"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pad"
--           , argType = TInterface Name { namespace = "Gst" , name = "Pad" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPad whose #GstFlowReturn to update"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fret"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "FlowReturn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the latest #GstFlowReturn received for a pad in this #GstFlowCombiner"
--                 , 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_flow_combiner_update_pad_flow" gst_flow_combiner_update_pad_flow :: 
    Ptr FlowCombiner ->                     -- combiner : TInterface (Name {namespace = "GstBase", name = "FlowCombiner"})
    Ptr Gst.Pad.Pad ->                      -- pad : TInterface (Name {namespace = "Gst", name = "Pad"})
    CInt ->                                 -- fret : TInterface (Name {namespace = "Gst", name = "FlowReturn"})
    IO CInt

-- | Sets the provided pad\'s last flow return to provided value and computes
-- the combined flow return for the pads in it.
-- 
-- The t'GI.Gst.Enums.FlowReturn' parameter should be the last flow return update for a pad
-- in this t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'. It will use this value to be able to shortcut some
-- combinations and avoid looking over all pads again. e.g. The last combined
-- return is the same as the latest obtained t'GI.Gst.Enums.FlowReturn'.
-- 
-- /Since: 1.6/
flowCombinerUpdatePadFlow ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Pad.IsPad a) =>
    FlowCombiner
    -- ^ /@combiner@/: the t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
    -> a
    -- ^ /@pad@/: the t'GI.Gst.Objects.Pad.Pad' whose t'GI.Gst.Enums.FlowReturn' to update
    -> Gst.Enums.FlowReturn
    -- ^ /@fret@/: the latest t'GI.Gst.Enums.FlowReturn' received for a pad in this t'GI.GstBase.Structs.FlowCombiner.FlowCombiner'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ The combined t'GI.Gst.Enums.FlowReturn'
flowCombinerUpdatePadFlow :: FlowCombiner -> a -> FlowReturn -> m FlowReturn
flowCombinerUpdatePadFlow FlowCombiner
combiner a
pad FlowReturn
fret = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr FlowCombiner
combiner' <- FlowCombiner -> IO (Ptr FlowCombiner)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FlowCombiner
combiner
    Ptr Pad
pad' <- a -> IO (Ptr Pad)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pad
    let fret' :: CInt
fret' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (FlowReturn -> Int) -> FlowReturn -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowReturn -> Int
forall a. Enum a => a -> Int
fromEnum) FlowReturn
fret
    CInt
result <- Ptr FlowCombiner -> Ptr Pad -> CInt -> IO CInt
gst_flow_combiner_update_pad_flow Ptr FlowCombiner
combiner' Ptr Pad
pad' CInt
fret'
    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
    FlowCombiner -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FlowCombiner
combiner
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pad
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data FlowCombinerUpdatePadFlowMethodInfo
instance (signature ~ (a -> Gst.Enums.FlowReturn -> m Gst.Enums.FlowReturn), MonadIO m, Gst.Pad.IsPad a) => O.MethodInfo FlowCombinerUpdatePadFlowMethodInfo FlowCombiner signature where
    overloadedMethod = flowCombinerUpdatePadFlow

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFlowCombinerMethod (t :: Symbol) (o :: *) :: * where
    ResolveFlowCombinerMethod "addPad" o = FlowCombinerAddPadMethodInfo
    ResolveFlowCombinerMethod "clear" o = FlowCombinerClearMethodInfo
    ResolveFlowCombinerMethod "free" o = FlowCombinerFreeMethodInfo
    ResolveFlowCombinerMethod "ref" o = FlowCombinerRefMethodInfo
    ResolveFlowCombinerMethod "removePad" o = FlowCombinerRemovePadMethodInfo
    ResolveFlowCombinerMethod "reset" o = FlowCombinerResetMethodInfo
    ResolveFlowCombinerMethod "unref" o = FlowCombinerUnrefMethodInfo
    ResolveFlowCombinerMethod "updateFlow" o = FlowCombinerUpdateFlowMethodInfo
    ResolveFlowCombinerMethod "updatePadFlow" o = FlowCombinerUpdatePadFlowMethodInfo
    ResolveFlowCombinerMethod l o = O.MethodResolutionFailed l o

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

#endif