{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- VideoAggregator can accept AYUV, ARGB and BGRA video streams. For each of the requested
-- sink pads it will compare the incoming geometry and framerate to define the
-- output parameters. Indeed output video frames will have the geometry of the
-- biggest incoming video stream and the framerate of the fastest incoming one.
-- 
-- VideoAggregator will do colorspace conversion.
-- 
-- Zorder for each input stream can be configured on the
-- t'GI.GstVideo.Objects.VideoAggregatorPad.VideoAggregatorPad'.

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

module GI.GstVideo.Objects.VideoAggregator
    ( 

-- * Exported types
    VideoAggregator(..)                     ,
    IsVideoAggregator                       ,
    toVideoAggregator                       ,
    noVideoAggregator                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveVideoAggregatorMethod            ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.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 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.GstBase.Objects.Aggregator as GstBase.Aggregator

-- | Memory-managed wrapper type.
newtype VideoAggregator = VideoAggregator (ManagedPtr VideoAggregator)
    deriving (VideoAggregator -> VideoAggregator -> Bool
(VideoAggregator -> VideoAggregator -> Bool)
-> (VideoAggregator -> VideoAggregator -> Bool)
-> Eq VideoAggregator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoAggregator -> VideoAggregator -> Bool
$c/= :: VideoAggregator -> VideoAggregator -> Bool
== :: VideoAggregator -> VideoAggregator -> Bool
$c== :: VideoAggregator -> VideoAggregator -> Bool
Eq)
foreign import ccall "gst_video_aggregator_get_type"
    c_gst_video_aggregator_get_type :: IO GType

instance GObject VideoAggregator where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_video_aggregator_get_type
    

-- | Convert 'VideoAggregator' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue VideoAggregator where
    toGValue :: VideoAggregator -> IO GValue
toGValue o :: VideoAggregator
o = do
        GType
gtype <- IO GType
c_gst_video_aggregator_get_type
        VideoAggregator -> (Ptr VideoAggregator -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoAggregator
o (GType
-> (GValue -> Ptr VideoAggregator -> IO ())
-> Ptr VideoAggregator
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr VideoAggregator -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO VideoAggregator
fromGValue gv :: GValue
gv = do
        Ptr VideoAggregator
ptr <- GValue -> IO (Ptr VideoAggregator)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr VideoAggregator)
        (ManagedPtr VideoAggregator -> VideoAggregator)
-> Ptr VideoAggregator -> IO VideoAggregator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VideoAggregator -> VideoAggregator
VideoAggregator Ptr VideoAggregator
ptr
        
    

-- | Type class for types which can be safely cast to `VideoAggregator`, for instance with `toVideoAggregator`.
class (GObject o, O.IsDescendantOf VideoAggregator o) => IsVideoAggregator o
instance (GObject o, O.IsDescendantOf VideoAggregator o) => IsVideoAggregator o

instance O.HasParentTypes VideoAggregator
type instance O.ParentTypes VideoAggregator = '[GstBase.Aggregator.Aggregator, Gst.Element.Element, Gst.Object.Object, GObject.Object.Object]

-- | Cast to `VideoAggregator`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toVideoAggregator :: (MonadIO m, IsVideoAggregator o) => o -> m VideoAggregator
toVideoAggregator :: o -> m VideoAggregator
toVideoAggregator = IO VideoAggregator -> m VideoAggregator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoAggregator -> m VideoAggregator)
-> (o -> IO VideoAggregator) -> o -> m VideoAggregator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr VideoAggregator -> VideoAggregator)
-> o -> IO VideoAggregator
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr VideoAggregator -> VideoAggregator
VideoAggregator

-- | A convenience alias for `Nothing` :: `Maybe` `VideoAggregator`.
noVideoAggregator :: Maybe VideoAggregator
noVideoAggregator :: Maybe VideoAggregator
noVideoAggregator = Maybe VideoAggregator
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoAggregatorMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoAggregatorMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveVideoAggregatorMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveVideoAggregatorMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveVideoAggregatorMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveVideoAggregatorMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveVideoAggregatorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVideoAggregatorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVideoAggregatorMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveVideoAggregatorMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveVideoAggregatorMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveVideoAggregatorMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveVideoAggregatorMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveVideoAggregatorMethod "finishBuffer" o = GstBase.Aggregator.AggregatorFinishBufferMethodInfo
    ResolveVideoAggregatorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVideoAggregatorMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveVideoAggregatorMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveVideoAggregatorMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveVideoAggregatorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVideoAggregatorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVideoAggregatorMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveVideoAggregatorMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveVideoAggregatorMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveVideoAggregatorMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveVideoAggregatorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVideoAggregatorMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveVideoAggregatorMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveVideoAggregatorMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveVideoAggregatorMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveVideoAggregatorMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveVideoAggregatorMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveVideoAggregatorMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveVideoAggregatorMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveVideoAggregatorMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveVideoAggregatorMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveVideoAggregatorMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveVideoAggregatorMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveVideoAggregatorMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveVideoAggregatorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVideoAggregatorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVideoAggregatorMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveVideoAggregatorMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveVideoAggregatorMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveVideoAggregatorMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveVideoAggregatorMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveVideoAggregatorMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveVideoAggregatorMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveVideoAggregatorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVideoAggregatorMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveVideoAggregatorMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveVideoAggregatorMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveVideoAggregatorMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveVideoAggregatorMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveVideoAggregatorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVideoAggregatorMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveVideoAggregatorMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveVideoAggregatorMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveVideoAggregatorMethod "simpleGetNextTime" o = GstBase.Aggregator.AggregatorSimpleGetNextTimeMethodInfo
    ResolveVideoAggregatorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVideoAggregatorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVideoAggregatorMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveVideoAggregatorMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveVideoAggregatorMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveVideoAggregatorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVideoAggregatorMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveVideoAggregatorMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveVideoAggregatorMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveVideoAggregatorMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveVideoAggregatorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVideoAggregatorMethod "getAllocator" o = GstBase.Aggregator.AggregatorGetAllocatorMethodInfo
    ResolveVideoAggregatorMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveVideoAggregatorMethod "getBufferPool" o = GstBase.Aggregator.AggregatorGetBufferPoolMethodInfo
    ResolveVideoAggregatorMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveVideoAggregatorMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveVideoAggregatorMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveVideoAggregatorMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveVideoAggregatorMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveVideoAggregatorMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveVideoAggregatorMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveVideoAggregatorMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveVideoAggregatorMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveVideoAggregatorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVideoAggregatorMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveVideoAggregatorMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveVideoAggregatorMethod "getLatency" o = GstBase.Aggregator.AggregatorGetLatencyMethodInfo
    ResolveVideoAggregatorMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveVideoAggregatorMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveVideoAggregatorMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveVideoAggregatorMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveVideoAggregatorMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveVideoAggregatorMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveVideoAggregatorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVideoAggregatorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVideoAggregatorMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveVideoAggregatorMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveVideoAggregatorMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveVideoAggregatorMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveVideoAggregatorMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveVideoAggregatorMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveVideoAggregatorMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveVideoAggregatorMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveVideoAggregatorMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveVideoAggregatorMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveVideoAggregatorMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveVideoAggregatorMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveVideoAggregatorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVideoAggregatorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVideoAggregatorMethod "setLatency" o = GstBase.Aggregator.AggregatorSetLatencyMethodInfo
    ResolveVideoAggregatorMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveVideoAggregatorMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveVideoAggregatorMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveVideoAggregatorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVideoAggregatorMethod "setSrcCaps" o = GstBase.Aggregator.AggregatorSetSrcCapsMethodInfo
    ResolveVideoAggregatorMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveVideoAggregatorMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveVideoAggregatorMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoAggregator
type instance O.AttributeList VideoAggregator = VideoAggregatorAttributeList
type VideoAggregatorAttributeList = ('[ '("latency", GstBase.Aggregator.AggregatorLatencyPropertyInfo), '("minUpstreamLatency", GstBase.Aggregator.AggregatorMinUpstreamLatencyPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("startTime", GstBase.Aggregator.AggregatorStartTimePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VideoAggregator = VideoAggregatorSignalList
type VideoAggregatorSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("noMorePads", Gst.Element.ElementNoMorePadsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("padAdded", Gst.Element.ElementPadAddedSignalInfo), '("padRemoved", Gst.Element.ElementPadRemovedSignalInfo)] :: [(Symbol, *)])

#endif