{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gst.Objects.Pipeline.Pipeline' is a special t'GI.Gst.Objects.Bin.Bin' used as the toplevel container for
-- the filter graph. The t'GI.Gst.Objects.Pipeline.Pipeline' will manage the selection and
-- distribution of a global t'GI.Gst.Objects.Clock.Clock' as well as provide a t'GI.Gst.Objects.Bus.Bus' to the
-- application.
-- 
-- 'GI.Gst.Objects.Pipeline.pipelineNew' is used to create a pipeline. when you are done with
-- the pipeline, use 'GI.Gst.Objects.Object.objectUnref' to free its resources including all
-- added t'GI.Gst.Objects.Element.Element' objects (if not otherwise referenced).
-- 
-- Elements are added and removed from the pipeline using the t'GI.Gst.Objects.Bin.Bin'
-- methods like 'GI.Gst.Objects.Bin.binAdd' and 'GI.Gst.Objects.Bin.binRemove' (see t'GI.Gst.Objects.Bin.Bin').
-- 
-- Before changing the state of the t'GI.Gst.Objects.Pipeline.Pipeline' (see t'GI.Gst.Objects.Element.Element') a t'GI.Gst.Objects.Bus.Bus'
-- can be retrieved with 'GI.Gst.Objects.Pipeline.pipelineGetBus'. This bus can then be
-- used to receive t'GI.Gst.Structs.Message.Message' from the elements in the pipeline.
-- 
-- By default, a t'GI.Gst.Objects.Pipeline.Pipeline' will automatically flush the pending t'GI.Gst.Objects.Bus.Bus'
-- messages when going to the NULL state to ensure that no circular
-- references exist when no messages are read from the t'GI.Gst.Objects.Bus.Bus'. This
-- behaviour can be changed with 'GI.Gst.Objects.Pipeline.pipelineSetAutoFlushBus'.
-- 
-- When the t'GI.Gst.Objects.Pipeline.Pipeline' performs the PAUSED to PLAYING state change it will
-- select a clock for the elements. The clock selection algorithm will by
-- default select a clock provided by an element that is most upstream
-- (closest to the source). For live pipelines (ones that return
-- @/GST_STATE_CHANGE_NO_PREROLL/@ from the 'GI.Gst.Objects.Element.elementSetState' call) this
-- will select the clock provided by the live source. For normal pipelines
-- this will select a clock provided by the sinks (most likely the audio
-- sink). If no element provides a clock, a default t'GI.Gst.Objects.SystemClock.SystemClock' is used.
-- 
-- The clock selection can be controlled with the 'GI.Gst.Objects.Pipeline.pipelineUseClock'
-- method, which will enforce a given clock on the pipeline. With
-- 'GI.Gst.Objects.Pipeline.pipelineAutoClock' the default clock selection algorithm can be
-- restored.
-- 
-- A t'GI.Gst.Objects.Pipeline.Pipeline' maintains a running time for the elements. The running
-- time is defined as the difference between the current clock time and
-- the base time. When the pipeline goes to READY or a flushing seek is
-- performed on it, the running time is reset to 0. When the pipeline is
-- set from PLAYING to PAUSED, the current clock time is sampled and used to
-- configure the base time for the elements when the pipeline is set
-- to PLAYING again. The effect is that the running time (as the difference
-- between the clock time and the base time) will count how much time was spent
-- in the PLAYING state. This default behaviour can be changed with the
-- 'GI.Gst.Objects.Element.elementSetStartTime' method.

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

module GI.Gst.Objects.Pipeline
    ( 

-- * Exported types
    Pipeline(..)                            ,
    IsPipeline                              ,
    toPipeline                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePipelineMethod                   ,
#endif


-- ** autoClock #method:autoClock#

#if defined(ENABLE_OVERLOADING)
    PipelineAutoClockMethodInfo             ,
#endif
    pipelineAutoClock                       ,


-- ** getAutoFlushBus #method:getAutoFlushBus#

#if defined(ENABLE_OVERLOADING)
    PipelineGetAutoFlushBusMethodInfo       ,
#endif
    pipelineGetAutoFlushBus                 ,


-- ** getBus #method:getBus#

#if defined(ENABLE_OVERLOADING)
    PipelineGetBusMethodInfo                ,
#endif
    pipelineGetBus                          ,


-- ** getDelay #method:getDelay#

#if defined(ENABLE_OVERLOADING)
    PipelineGetDelayMethodInfo              ,
#endif
    pipelineGetDelay                        ,


-- ** getLatency #method:getLatency#

#if defined(ENABLE_OVERLOADING)
    PipelineGetLatencyMethodInfo            ,
#endif
    pipelineGetLatency                      ,


-- ** getPipelineClock #method:getPipelineClock#

#if defined(ENABLE_OVERLOADING)
    PipelineGetPipelineClockMethodInfo      ,
#endif
    pipelineGetPipelineClock                ,


-- ** new #method:new#

    pipelineNew                             ,


-- ** setAutoFlushBus #method:setAutoFlushBus#

#if defined(ENABLE_OVERLOADING)
    PipelineSetAutoFlushBusMethodInfo       ,
#endif
    pipelineSetAutoFlushBus                 ,


-- ** setDelay #method:setDelay#

#if defined(ENABLE_OVERLOADING)
    PipelineSetDelayMethodInfo              ,
#endif
    pipelineSetDelay                        ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    PipelineSetLatencyMethodInfo            ,
#endif
    pipelineSetLatency                      ,


-- ** useClock #method:useClock#

#if defined(ENABLE_OVERLOADING)
    PipelineUseClockMethodInfo              ,
#endif
    pipelineUseClock                        ,




 -- * Properties
-- ** autoFlushBus #attr:autoFlushBus#
-- | Whether or not to automatically flush all messages on the
-- pipeline\'s bus when going from READY to NULL state. Please see
-- 'GI.Gst.Objects.Pipeline.pipelineSetAutoFlushBus' for more information on this option.

#if defined(ENABLE_OVERLOADING)
    PipelineAutoFlushBusPropertyInfo        ,
#endif
    constructPipelineAutoFlushBus           ,
    getPipelineAutoFlushBus                 ,
#if defined(ENABLE_OVERLOADING)
    pipelineAutoFlushBus                    ,
#endif
    setPipelineAutoFlushBus                 ,


-- ** delay #attr:delay#
-- | The expected delay needed for elements to spin up to the
-- PLAYING state expressed in nanoseconds.
-- see 'GI.Gst.Objects.Pipeline.pipelineSetDelay' for more information on this option.

#if defined(ENABLE_OVERLOADING)
    PipelineDelayPropertyInfo               ,
#endif
    constructPipelineDelay                  ,
    getPipelineDelay                        ,
#if defined(ENABLE_OVERLOADING)
    pipelineDelay                           ,
#endif
    setPipelineDelay                        ,


-- ** latency #attr:latency#
-- | Latency to configure on the pipeline. See 'GI.Gst.Objects.Pipeline.pipelineSetLatency'.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    PipelineLatencyPropertyInfo             ,
#endif
    constructPipelineLatency                ,
    getPipelineLatency                      ,
#if defined(ENABLE_OVERLOADING)
    pipelineLatency                         ,
#endif
    setPipelineLatency                      ,




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Interfaces.ChildProxy as Gst.ChildProxy
import {-# SOURCE #-} qualified GI.Gst.Objects.Bin as Gst.Bin
import {-# SOURCE #-} qualified GI.Gst.Objects.Bus as Gst.Bus
import {-# SOURCE #-} qualified GI.Gst.Objects.Clock as Gst.Clock
import {-# SOURCE #-} qualified GI.Gst.Objects.Element as Gst.Element
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object

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

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

foreign import ccall "gst_pipeline_get_type"
    c_gst_pipeline_get_type :: IO B.Types.GType

instance B.Types.TypedObject Pipeline where
    glibType :: IO GType
glibType = IO GType
c_gst_pipeline_get_type

instance B.Types.GObject Pipeline

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

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

instance O.HasParentTypes Pipeline
type instance O.ParentTypes Pipeline = '[Gst.Bin.Bin, Gst.Element.Element, Gst.Object.Object, GObject.Object.Object, Gst.ChildProxy.ChildProxy]

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePipelineMethod (t :: Symbol) (o :: *) :: * where
    ResolvePipelineMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolvePipelineMethod "add" o = Gst.Bin.BinAddMethodInfo
    ResolvePipelineMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolvePipelineMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolvePipelineMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolvePipelineMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolvePipelineMethod "autoClock" o = PipelineAutoClockMethodInfo
    ResolvePipelineMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePipelineMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePipelineMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolvePipelineMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolvePipelineMethod "childAdded" o = Gst.ChildProxy.ChildProxyChildAddedMethodInfo
    ResolvePipelineMethod "childRemoved" o = Gst.ChildProxy.ChildProxyChildRemovedMethodInfo
    ResolvePipelineMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolvePipelineMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolvePipelineMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolvePipelineMethod "findUnlinkedPad" o = Gst.Bin.BinFindUnlinkedPadMethodInfo
    ResolvePipelineMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePipelineMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolvePipelineMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolvePipelineMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolvePipelineMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePipelineMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePipelineMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolvePipelineMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolvePipelineMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolvePipelineMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolvePipelineMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePipelineMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolvePipelineMethod "iterateAllByInterface" o = Gst.Bin.BinIterateAllByInterfaceMethodInfo
    ResolvePipelineMethod "iterateElements" o = Gst.Bin.BinIterateElementsMethodInfo
    ResolvePipelineMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolvePipelineMethod "iterateRecurse" o = Gst.Bin.BinIterateRecurseMethodInfo
    ResolvePipelineMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolvePipelineMethod "iterateSinks" o = Gst.Bin.BinIterateSinksMethodInfo
    ResolvePipelineMethod "iterateSorted" o = Gst.Bin.BinIterateSortedMethodInfo
    ResolvePipelineMethod "iterateSources" o = Gst.Bin.BinIterateSourcesMethodInfo
    ResolvePipelineMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolvePipelineMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolvePipelineMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolvePipelineMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolvePipelineMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolvePipelineMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolvePipelineMethod "lookup" o = Gst.ChildProxy.ChildProxyLookupMethodInfo
    ResolvePipelineMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolvePipelineMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolvePipelineMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolvePipelineMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolvePipelineMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePipelineMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePipelineMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolvePipelineMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolvePipelineMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolvePipelineMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolvePipelineMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolvePipelineMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolvePipelineMethod "recalculateLatency" o = Gst.Bin.BinRecalculateLatencyMethodInfo
    ResolvePipelineMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolvePipelineMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePipelineMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolvePipelineMethod "remove" o = Gst.Bin.BinRemoveMethodInfo
    ResolvePipelineMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolvePipelineMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolvePipelineMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolvePipelineMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolvePipelineMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePipelineMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolvePipelineMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolvePipelineMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolvePipelineMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePipelineMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePipelineMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolvePipelineMethod "syncChildrenStates" o = Gst.Bin.BinSyncChildrenStatesMethodInfo
    ResolvePipelineMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolvePipelineMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolvePipelineMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePipelineMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolvePipelineMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolvePipelineMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolvePipelineMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolvePipelineMethod "useClock" o = PipelineUseClockMethodInfo
    ResolvePipelineMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePipelineMethod "getAutoFlushBus" o = PipelineGetAutoFlushBusMethodInfo
    ResolvePipelineMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolvePipelineMethod "getBus" o = PipelineGetBusMethodInfo
    ResolvePipelineMethod "getByInterface" o = Gst.Bin.BinGetByInterfaceMethodInfo
    ResolvePipelineMethod "getByName" o = Gst.Bin.BinGetByNameMethodInfo
    ResolvePipelineMethod "getByNameRecurseUp" o = Gst.Bin.BinGetByNameRecurseUpMethodInfo
    ResolvePipelineMethod "getChildByIndex" o = Gst.ChildProxy.ChildProxyGetChildByIndexMethodInfo
    ResolvePipelineMethod "getChildByName" o = Gst.ChildProxy.ChildProxyGetChildByNameMethodInfo
    ResolvePipelineMethod "getChildrenCount" o = Gst.ChildProxy.ChildProxyGetChildrenCountMethodInfo
    ResolvePipelineMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolvePipelineMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolvePipelineMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolvePipelineMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolvePipelineMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolvePipelineMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolvePipelineMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolvePipelineMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolvePipelineMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePipelineMethod "getDelay" o = PipelineGetDelayMethodInfo
    ResolvePipelineMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolvePipelineMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolvePipelineMethod "getLatency" o = PipelineGetLatencyMethodInfo
    ResolvePipelineMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolvePipelineMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolvePipelineMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolvePipelineMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolvePipelineMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolvePipelineMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolvePipelineMethod "getPipelineClock" o = PipelineGetPipelineClockMethodInfo
    ResolvePipelineMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePipelineMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePipelineMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolvePipelineMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolvePipelineMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolvePipelineMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolvePipelineMethod "getSuppressedFlags" o = Gst.Bin.BinGetSuppressedFlagsMethodInfo
    ResolvePipelineMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolvePipelineMethod "setAutoFlushBus" o = PipelineSetAutoFlushBusMethodInfo
    ResolvePipelineMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolvePipelineMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolvePipelineMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolvePipelineMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolvePipelineMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolvePipelineMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolvePipelineMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolvePipelineMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePipelineMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePipelineMethod "setDelay" o = PipelineSetDelayMethodInfo
    ResolvePipelineMethod "setLatency" o = PipelineSetLatencyMethodInfo
    ResolvePipelineMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolvePipelineMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolvePipelineMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolvePipelineMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePipelineMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolvePipelineMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolvePipelineMethod "setSuppressedFlags" o = Gst.Bin.BinSetSuppressedFlagsMethodInfo
    ResolvePipelineMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "auto-flush-bus"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@auto-flush-bus@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pipeline #autoFlushBus
-- @
getPipelineAutoFlushBus :: (MonadIO m, IsPipeline o) => o -> m Bool
getPipelineAutoFlushBus :: o -> m Bool
getPipelineAutoFlushBus o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"auto-flush-bus"

-- | Set the value of the “@auto-flush-bus@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pipeline [ #autoFlushBus 'Data.GI.Base.Attributes.:=' value ]
-- @
setPipelineAutoFlushBus :: (MonadIO m, IsPipeline o) => o -> Bool -> m ()
setPipelineAutoFlushBus :: o -> Bool -> m ()
setPipelineAutoFlushBus o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"auto-flush-bus" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@auto-flush-bus@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPipelineAutoFlushBus :: (IsPipeline o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructPipelineAutoFlushBus :: Bool -> m (GValueConstruct o)
constructPipelineAutoFlushBus Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"auto-flush-bus" Bool
val

#if defined(ENABLE_OVERLOADING)
data PipelineAutoFlushBusPropertyInfo
instance AttrInfo PipelineAutoFlushBusPropertyInfo where
    type AttrAllowedOps PipelineAutoFlushBusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PipelineAutoFlushBusPropertyInfo = IsPipeline
    type AttrSetTypeConstraint PipelineAutoFlushBusPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PipelineAutoFlushBusPropertyInfo = (~) Bool
    type AttrTransferType PipelineAutoFlushBusPropertyInfo = Bool
    type AttrGetType PipelineAutoFlushBusPropertyInfo = Bool
    type AttrLabel PipelineAutoFlushBusPropertyInfo = "auto-flush-bus"
    type AttrOrigin PipelineAutoFlushBusPropertyInfo = Pipeline
    attrGet = getPipelineAutoFlushBus
    attrSet = setPipelineAutoFlushBus
    attrTransfer _ v = do
        return v
    attrConstruct = constructPipelineAutoFlushBus
    attrClear = undefined
#endif

-- VVV Prop "delay"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@delay@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pipeline #delay
-- @
getPipelineDelay :: (MonadIO m, IsPipeline o) => o -> m Word64
getPipelineDelay :: o -> m Word64
getPipelineDelay o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"delay"

-- | Set the value of the “@delay@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pipeline [ #delay 'Data.GI.Base.Attributes.:=' value ]
-- @
setPipelineDelay :: (MonadIO m, IsPipeline o) => o -> Word64 -> m ()
setPipelineDelay :: o -> Word64 -> m ()
setPipelineDelay o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"delay" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@delay@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPipelineDelay :: (IsPipeline o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructPipelineDelay :: Word64 -> m (GValueConstruct o)
constructPipelineDelay Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"delay" Word64
val

#if defined(ENABLE_OVERLOADING)
data PipelineDelayPropertyInfo
instance AttrInfo PipelineDelayPropertyInfo where
    type AttrAllowedOps PipelineDelayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PipelineDelayPropertyInfo = IsPipeline
    type AttrSetTypeConstraint PipelineDelayPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint PipelineDelayPropertyInfo = (~) Word64
    type AttrTransferType PipelineDelayPropertyInfo = Word64
    type AttrGetType PipelineDelayPropertyInfo = Word64
    type AttrLabel PipelineDelayPropertyInfo = "delay"
    type AttrOrigin PipelineDelayPropertyInfo = Pipeline
    attrGet = getPipelineDelay
    attrSet = setPipelineDelay
    attrTransfer _ v = do
        return v
    attrConstruct = constructPipelineDelay
    attrClear = undefined
#endif

-- VVV Prop "latency"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@latency@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pipeline #latency
-- @
getPipelineLatency :: (MonadIO m, IsPipeline o) => o -> m Word64
getPipelineLatency :: o -> m Word64
getPipelineLatency o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"latency"

-- | Set the value of the “@latency@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pipeline [ #latency 'Data.GI.Base.Attributes.:=' value ]
-- @
setPipelineLatency :: (MonadIO m, IsPipeline o) => o -> Word64 -> m ()
setPipelineLatency :: o -> Word64 -> m ()
setPipelineLatency o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"latency" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@latency@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPipelineLatency :: (IsPipeline o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructPipelineLatency :: Word64 -> m (GValueConstruct o)
constructPipelineLatency Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"latency" Word64
val

#if defined(ENABLE_OVERLOADING)
data PipelineLatencyPropertyInfo
instance AttrInfo PipelineLatencyPropertyInfo where
    type AttrAllowedOps PipelineLatencyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PipelineLatencyPropertyInfo = IsPipeline
    type AttrSetTypeConstraint PipelineLatencyPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint PipelineLatencyPropertyInfo = (~) Word64
    type AttrTransferType PipelineLatencyPropertyInfo = Word64
    type AttrGetType PipelineLatencyPropertyInfo = Word64
    type AttrLabel PipelineLatencyPropertyInfo = "latency"
    type AttrOrigin PipelineLatencyPropertyInfo = Pipeline
    attrGet = getPipelineLatency
    attrSet = setPipelineLatency
    attrTransfer _ v = do
        return v
    attrConstruct = constructPipelineLatency
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Pipeline
type instance O.AttributeList Pipeline = PipelineAttributeList
type PipelineAttributeList = ('[ '("asyncHandling", Gst.Bin.BinAsyncHandlingPropertyInfo), '("autoFlushBus", PipelineAutoFlushBusPropertyInfo), '("delay", PipelineDelayPropertyInfo), '("latency", PipelineLatencyPropertyInfo), '("messageForward", Gst.Bin.BinMessageForwardPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
pipelineAutoFlushBus :: AttrLabelProxy "autoFlushBus"
pipelineAutoFlushBus = AttrLabelProxy

pipelineDelay :: AttrLabelProxy "delay"
pipelineDelay = AttrLabelProxy

pipelineLatency :: AttrLabelProxy "latency"
pipelineLatency = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Pipeline = PipelineSignalList
type PipelineSignalList = ('[ '("childAdded", Gst.ChildProxy.ChildProxyChildAddedSignalInfo), '("childRemoved", Gst.ChildProxy.ChildProxyChildRemovedSignalInfo), '("deepElementAdded", Gst.Bin.BinDeepElementAddedSignalInfo), '("deepElementRemoved", Gst.Bin.BinDeepElementRemovedSignalInfo), '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("doLatency", Gst.Bin.BinDoLatencySignalInfo), '("elementAdded", Gst.Bin.BinElementAddedSignalInfo), '("elementRemoved", Gst.Bin.BinElementRemovedSignalInfo), '("noMorePads", Gst.Element.ElementNoMorePadsSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("padAdded", Gst.Element.ElementPadAddedSignalInfo), '("padRemoved", Gst.Element.ElementPadRemovedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Pipeline::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of new pipeline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Pipeline" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_pipeline_new" gst_pipeline_new :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Pipeline)

-- | Create a new pipeline with the given name.
pipelineNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@name@/: name of new pipeline
    -> m Pipeline
    -- ^ __Returns:__ newly created GstPipeline
    -- 
    -- MT safe.
pipelineNew :: Maybe Text -> m Pipeline
pipelineNew Maybe Text
name = IO Pipeline -> m Pipeline
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pipeline -> m Pipeline) -> IO Pipeline -> m Pipeline
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr Pipeline
result <- Ptr CChar -> IO (Ptr Pipeline)
gst_pipeline_new Ptr CChar
maybeName
    Text -> Ptr Pipeline -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pipelineNew" Ptr Pipeline
result
    Pipeline
result' <- ((ManagedPtr Pipeline -> Pipeline) -> Ptr Pipeline -> IO Pipeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pipeline -> Pipeline
Pipeline) Ptr Pipeline
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Pipeline -> IO Pipeline
forall (m :: * -> *) a. Monad m => a -> m a
return Pipeline
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_pipeline_auto_clock" gst_pipeline_auto_clock :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    IO ()

-- | Let /@pipeline@/ select a clock automatically. This is the default
-- behaviour.
-- 
-- Use this function if you previous forced a fixed clock with
-- 'GI.Gst.Objects.Pipeline.pipelineUseClock' and want to restore the default
-- pipeline clock selection algorithm.
-- 
-- MT safe.
pipelineAutoClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> m ()
pipelineAutoClock :: a -> m ()
pipelineAutoClock a
pipeline = 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 Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Ptr Pipeline -> IO ()
gst_pipeline_auto_clock Ptr Pipeline
pipeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PipelineAutoClockMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPipeline a) => O.MethodInfo PipelineAutoClockMethodInfo a signature where
    overloadedMethod = pipelineAutoClock

#endif

-- method Pipeline::get_auto_flush_bus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pipeline"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Pipeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPipeline" , 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_pipeline_get_auto_flush_bus" gst_pipeline_get_auto_flush_bus :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    IO CInt

-- | Check if /@pipeline@/ will automatically flush messages when going to
-- the NULL state.
pipelineGetAutoFlushBus ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> m Bool
    -- ^ __Returns:__ whether the pipeline will automatically flush its bus when
    -- going from READY to NULL state or not.
    -- 
    -- MT safe.
pipelineGetAutoFlushBus :: a -> m Bool
pipelineGetAutoFlushBus a
pipeline = 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 Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    CInt
result <- Ptr Pipeline -> IO CInt
gst_pipeline_get_auto_flush_bus Ptr Pipeline
pipeline'
    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
pipeline
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PipelineGetAutoFlushBusMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPipeline a) => O.MethodInfo PipelineGetAutoFlushBusMethodInfo a signature where
    overloadedMethod = pipelineGetAutoFlushBus

#endif

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

foreign import ccall "gst_pipeline_get_bus" gst_pipeline_get_bus :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    IO (Ptr Gst.Bus.Bus)

-- | Gets the t'GI.Gst.Objects.Bus.Bus' of /@pipeline@/. The bus allows applications to receive
-- t'GI.Gst.Structs.Message.Message' packets.
pipelineGetBus ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> m Gst.Bus.Bus
    -- ^ __Returns:__ a t'GI.Gst.Objects.Bus.Bus', unref after usage.
    -- 
    -- MT safe.
pipelineGetBus :: a -> m Bus
pipelineGetBus a
pipeline = IO Bus -> m Bus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bus -> m Bus) -> IO Bus -> m Bus
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Ptr Bus
result <- Ptr Pipeline -> IO (Ptr Bus)
gst_pipeline_get_bus Ptr Pipeline
pipeline'
    Text -> Ptr Bus -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pipelineGetBus" Ptr Bus
result
    Bus
result' <- ((ManagedPtr Bus -> Bus) -> Ptr Bus -> IO Bus
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Bus -> Bus
Gst.Bus.Bus) Ptr Bus
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    Bus -> IO Bus
forall (m :: * -> *) a. Monad m => a -> m a
return Bus
result'

#if defined(ENABLE_OVERLOADING)
data PipelineGetBusMethodInfo
instance (signature ~ (m Gst.Bus.Bus), MonadIO m, IsPipeline a) => O.MethodInfo PipelineGetBusMethodInfo a signature where
    overloadedMethod = pipelineGetBus

#endif

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

foreign import ccall "gst_pipeline_get_delay" gst_pipeline_get_delay :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    IO Word64

-- | Get the configured delay (see 'GI.Gst.Objects.Pipeline.pipelineSetDelay').
pipelineGetDelay ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> m Word64
    -- ^ __Returns:__ The configured delay.
    -- 
    -- MT safe.
pipelineGetDelay :: a -> m Word64
pipelineGetDelay a
pipeline = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Word64
result <- Ptr Pipeline -> IO Word64
gst_pipeline_get_delay Ptr Pipeline
pipeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data PipelineGetDelayMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsPipeline a) => O.MethodInfo PipelineGetDelayMethodInfo a signature where
    overloadedMethod = pipelineGetDelay

#endif

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

foreign import ccall "gst_pipeline_get_latency" gst_pipeline_get_latency :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    IO Word64

-- | Gets the latency that should be configured on the pipeline. See
-- 'GI.Gst.Objects.Pipeline.pipelineSetLatency'.
-- 
-- /Since: 1.6/
pipelineGetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> m Word64
    -- ^ __Returns:__ Latency to configure on the pipeline or GST_CLOCK_TIME_NONE
pipelineGetLatency :: a -> m Word64
pipelineGetLatency a
pipeline = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Word64
result <- Ptr Pipeline -> IO Word64
gst_pipeline_get_latency Ptr Pipeline
pipeline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data PipelineGetLatencyMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsPipeline a) => O.MethodInfo PipelineGetLatencyMethodInfo a signature where
    overloadedMethod = pipelineGetLatency

#endif

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

foreign import ccall "gst_pipeline_get_pipeline_clock" gst_pipeline_get_pipeline_clock :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    IO (Ptr Gst.Clock.Clock)

-- | Gets the current clock used by /@pipeline@/.
-- 
-- Unlike 'GI.Gst.Objects.Element.elementGetClock', this function will always return a
-- clock, even if the pipeline is not in the PLAYING state.
-- 
-- /Since: 1.6/
pipelineGetPipelineClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> m Gst.Clock.Clock
    -- ^ __Returns:__ a t'GI.Gst.Objects.Clock.Clock', unref after usage.
pipelineGetPipelineClock :: a -> m Clock
pipelineGetPipelineClock a
pipeline = IO Clock -> m Clock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Clock -> m Clock) -> IO Clock -> m Clock
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Ptr Clock
result <- Ptr Pipeline -> IO (Ptr Clock)
gst_pipeline_get_pipeline_clock Ptr Pipeline
pipeline'
    Text -> Ptr Clock -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pipelineGetPipelineClock" Ptr Clock
result
    Clock
result' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
result'

#if defined(ENABLE_OVERLOADING)
data PipelineGetPipelineClockMethodInfo
instance (signature ~ (m Gst.Clock.Clock), MonadIO m, IsPipeline a) => O.MethodInfo PipelineGetPipelineClockMethodInfo a signature where
    overloadedMethod = pipelineGetPipelineClock

#endif

-- method Pipeline::set_auto_flush_bus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pipeline"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Pipeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPipeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auto_flush"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether or not to automatically flush the bus when\nthe pipeline goes from READY to NULL state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pipeline_set_auto_flush_bus" gst_pipeline_set_auto_flush_bus :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    CInt ->                                 -- auto_flush : TBasicType TBoolean
    IO ()

-- | Usually, when a pipeline goes from READY to NULL state, it automatically
-- flushes all pending messages on the bus, which is done for refcounting
-- purposes, to break circular references.
-- 
-- This means that applications that update state using (async) bus messages
-- (e.g. do certain things when a pipeline goes from PAUSED to READY) might
-- not get to see messages when the pipeline is shut down, because they might
-- be flushed before they can be dispatched in the main thread. This behaviour
-- can be disabled using this function.
-- 
-- It is important that all messages on the bus are handled when the
-- automatic flushing is disabled else memory leaks will be introduced.
-- 
-- MT safe.
pipelineSetAutoFlushBus ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> Bool
    -- ^ /@autoFlush@/: whether or not to automatically flush the bus when
    -- the pipeline goes from READY to NULL state
    -> m ()
pipelineSetAutoFlushBus :: a -> Bool -> m ()
pipelineSetAutoFlushBus a
pipeline Bool
autoFlush = 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 Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    let autoFlush' :: CInt
autoFlush' = (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
autoFlush
    Ptr Pipeline -> CInt -> IO ()
gst_pipeline_set_auto_flush_bus Ptr Pipeline
pipeline' CInt
autoFlush'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PipelineSetAutoFlushBusMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPipeline a) => O.MethodInfo PipelineSetAutoFlushBusMethodInfo a signature where
    overloadedMethod = pipelineSetAutoFlushBus

#endif

-- method Pipeline::set_delay
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pipeline"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Pipeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPipeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delay"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the delay" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pipeline_set_delay" gst_pipeline_set_delay :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    Word64 ->                               -- delay : TBasicType TUInt64
    IO ()

-- | Set the expected delay needed for all elements to perform the
-- PAUSED to PLAYING state change. /@delay@/ will be added to the
-- base time of the elements so that they wait an additional /@delay@/
-- amount of time before starting to process buffers and cannot be
-- 'GI.Gst.Constants.CLOCK_TIME_NONE'.
-- 
-- This option is used for tuning purposes and should normally not be
-- used.
-- 
-- MT safe.
pipelineSetDelay ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> Word64
    -- ^ /@delay@/: the delay
    -> m ()
pipelineSetDelay :: a -> Word64 -> m ()
pipelineSetDelay a
pipeline Word64
delay = 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 Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Ptr Pipeline -> Word64 -> IO ()
gst_pipeline_set_delay Ptr Pipeline
pipeline' Word64
delay
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PipelineSetDelayMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsPipeline a) => O.MethodInfo PipelineSetDelayMethodInfo a signature where
    overloadedMethod = pipelineSetDelay

#endif

-- method Pipeline::set_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pipeline"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Pipeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPipeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "latency to configure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pipeline_set_latency" gst_pipeline_set_latency :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    Word64 ->                               -- latency : TBasicType TUInt64
    IO ()

-- | Sets the latency that should be configured on the pipeline. Setting
-- GST_CLOCK_TIME_NONE will restore the default behaviour of using the minimum
-- latency from the LATENCY query. Setting this is usually not required and
-- the pipeline will figure out an appropriate latency automatically.
-- 
-- Setting a too low latency, especially lower than the minimum latency from
-- the LATENCY query, will most likely cause the pipeline to fail.
-- 
-- /Since: 1.6/
pipelineSetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> Word64
    -- ^ /@latency@/: latency to configure
    -> m ()
pipelineSetLatency :: a -> Word64 -> m ()
pipelineSetLatency a
pipeline Word64
latency = 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 Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Ptr Pipeline -> Word64 -> IO ()
gst_pipeline_set_latency Ptr Pipeline
pipeline' Word64
latency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PipelineSetLatencyMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsPipeline a) => O.MethodInfo PipelineSetLatencyMethodInfo a signature where
    overloadedMethod = pipelineSetLatency

#endif

-- method Pipeline::use_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pipeline"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Pipeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPipeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the clock to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_pipeline_use_clock" gst_pipeline_use_clock :: 
    Ptr Pipeline ->                         -- pipeline : TInterface (Name {namespace = "Gst", name = "Pipeline"})
    Ptr Gst.Clock.Clock ->                  -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO ()

-- | Force /@pipeline@/ to use the given /@clock@/. The pipeline will
-- always use the given clock even if new clock providers are added
-- to this pipeline.
-- 
-- If /@clock@/ is 'P.Nothing' all clocking will be disabled which will make
-- the pipeline run as fast as possible.
-- 
-- MT safe.
pipelineUseClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsPipeline a, Gst.Clock.IsClock b) =>
    a
    -- ^ /@pipeline@/: a t'GI.Gst.Objects.Pipeline.Pipeline'
    -> Maybe (b)
    -- ^ /@clock@/: the clock to use
    -> m ()
pipelineUseClock :: a -> Maybe b -> m ()
pipelineUseClock a
pipeline Maybe b
clock = 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 Pipeline
pipeline' <- a -> IO (Ptr Pipeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pipeline
    Ptr Clock
maybeClock <- case Maybe b
clock of
        Maybe b
Nothing -> Ptr Clock -> IO (Ptr Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
forall a. Ptr a
nullPtr
        Just b
jClock -> do
            Ptr Clock
jClock' <- b -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jClock
            Ptr Clock -> IO (Ptr Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
jClock'
    Ptr Pipeline -> Ptr Clock -> IO ()
gst_pipeline_use_clock Ptr Pipeline
pipeline' Ptr Clock
maybeClock
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pipeline
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
clock b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PipelineUseClockMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsPipeline a, Gst.Clock.IsClock b) => O.MethodInfo PipelineUseClockMethodInfo a signature where
    overloadedMethod = pipelineUseClock

#endif