{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This is a generic base class for source elements. The following
-- types of sources are supported:
-- 
--   * random access sources like files
--   * seekable sources
--   * live sources
-- 
-- The source can be configured to operate in any t'GI.Gst.Enums.Format' with the
-- 'GI.GstBase.Objects.BaseSrc.baseSrcSetFormat' method. The currently set format determines
-- the format of the internal t'GI.Gst.Structs.Segment.Segment' and any 'GI.Gst.Enums.EventTypeSegment'
-- events. The default format for t'GI.GstBase.Objects.BaseSrc.BaseSrc' is 'GI.Gst.Enums.FormatBytes'.
-- 
-- t'GI.GstBase.Objects.BaseSrc.BaseSrc' always supports push mode scheduling. If the following
-- conditions are met, it also supports pull mode scheduling:
-- 
--   * The format is set to 'GI.Gst.Enums.FormatBytes' (default).
--   * t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/is_seekable/@() returns 'P.True'.
-- 
-- If all the conditions are met for operating in pull mode, t'GI.GstBase.Objects.BaseSrc.BaseSrc' is
-- automatically seekable in push mode as well. The following conditions must
-- be met to make the element seekable in push mode when the format is not
-- 'GI.Gst.Enums.FormatBytes':
-- 
-- * t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/is_seekable/@() returns 'P.True'.
-- * t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/query/@() can convert all supported seek formats to the
--   internal format as set with 'GI.GstBase.Objects.BaseSrc.baseSrcSetFormat'.
-- * t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/do_seek/@() is implemented, performs the seek and returns
--    'P.True'.
-- 
-- When the element does not meet the requirements to operate in pull mode, the
-- offset and length in the t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/create/@() method should be ignored.
-- It is recommended to subclass t'GI.GstBase.Objects.PushSrc.PushSrc' instead, in this situation. If the
-- element can operate in pull mode but only with specific offsets and
-- lengths, it is allowed to generate an error when the wrong values are passed
-- to the t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/create/@() function.
-- 
-- t'GI.GstBase.Objects.BaseSrc.BaseSrc' has support for live sources. Live sources are sources that when
-- paused discard data, such as audio or video capture devices. A typical live
-- source also produces data at a fixed rate and thus provides a clock to publish
-- this rate.
-- Use 'GI.GstBase.Objects.BaseSrc.baseSrcSetLive' to activate the live source mode.
-- 
-- A live source does not produce data in the PAUSED state. This means that the
-- t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/create/@() method will not be called in PAUSED but only in
-- PLAYING. To signal the pipeline that the element will not produce data, the
-- return value from the READY to PAUSED state will be
-- 'GI.Gst.Enums.StateChangeReturnNoPreroll'.
-- 
-- A typical live source will timestamp the buffers it creates with the
-- current running time of the pipeline. This is one reason why a live source
-- can only produce data in the PLAYING state, when the clock is actually
-- distributed and running.
-- 
-- Live sources that synchronize and block on the clock (an audio source, for
-- example) can use 'GI.GstBase.Objects.BaseSrc.baseSrcWaitPlaying' when the
-- t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/create/@() function was interrupted by a state change to
-- PAUSED.
-- 
-- The t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/get_times/@() method can be used to implement pseudo-live
-- sources. It only makes sense to implement the t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/get_times/@()
-- function if the source is a live source. The t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/get_times/@()
-- function should return timestamps starting from 0, as if it were a non-live
-- source. The base class will make sure that the timestamps are transformed
-- into the current running_time. The base source will then wait for the
-- calculated running_time before pushing out the buffer.
-- 
-- For live sources, the base class will by default report a latency of 0.
-- For pseudo live sources, the base class will by default measure the difference
-- between the first buffer timestamp and the start time of get_times and will
-- report this value as the latency.
-- Subclasses should override the query function when this behaviour is not
-- acceptable.
-- 
-- There is only support in t'GI.GstBase.Objects.BaseSrc.BaseSrc' for exactly one source pad, which
-- should be named \"src\". A source implementation (subclass of t'GI.GstBase.Objects.BaseSrc.BaseSrc')
-- should install a pad template in its class_init function, like so:
-- 
-- === /C code/
-- >
-- >static void
-- >my_element_class_init (GstMyElementClass *klass)
-- >{
-- >  GstElementClass *gstelement_class = GST_ELEMENT_CLASS (klass);
-- >  // srctemplate should be a #GstStaticPadTemplate with direction
-- >  // %GST_PAD_SRC and name "src"
-- >  gst_element_class_add_static_pad_template (gstelement_class, &srctemplate);
-- >
-- >  gst_element_class_set_static_metadata (gstelement_class,
-- >     "Source name",
-- >     "Source",
-- >     "My Source element",
-- >     "The author <my.sink@my.email>");
-- >}
-- 
-- 
-- == Controlled shutdown of live sources in applications
-- 
-- Applications that record from a live source may want to stop recording
-- in a controlled way, so that the recording is stopped, but the data
-- already in the pipeline is processed to the end (remember that many live
-- sources would go on recording forever otherwise). For that to happen the
-- application needs to make the source stop recording and send an EOS
-- event down the pipeline. The application would then wait for an
-- EOS message posted on the pipeline\'s bus to know when all data has
-- been processed and the pipeline can safely be stopped.
-- 
-- An application may send an EOS event to a source element to make it
-- perform the EOS logic (send EOS event downstream or post a
-- 'GI.Gst.Flags.MessageTypeSegmentDone' on the bus). This can typically be done
-- with the 'GI.Gst.Objects.Element.elementSendEvent' function on the element or its parent bin.
-- 
-- After the EOS has been sent to the element, the application should wait for
-- an EOS message to be posted on the pipeline\'s bus. Once this EOS message is
-- received, it may safely shut down the entire pipeline.

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

module GI.GstBase.Objects.BaseSrc
    ( 

-- * Exported types
    BaseSrc(..)                             ,
    IsBaseSrc                               ,
    toBaseSrc                               ,
    noBaseSrc                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBaseSrcMethod                    ,
#endif


-- ** getAllocator #method:getAllocator#

#if defined(ENABLE_OVERLOADING)
    BaseSrcGetAllocatorMethodInfo           ,
#endif
    baseSrcGetAllocator                     ,


-- ** getBlocksize #method:getBlocksize#

#if defined(ENABLE_OVERLOADING)
    BaseSrcGetBlocksizeMethodInfo           ,
#endif
    baseSrcGetBlocksize                     ,


-- ** getBufferPool #method:getBufferPool#

#if defined(ENABLE_OVERLOADING)
    BaseSrcGetBufferPoolMethodInfo          ,
#endif
    baseSrcGetBufferPool                    ,


-- ** getDoTimestamp #method:getDoTimestamp#

#if defined(ENABLE_OVERLOADING)
    BaseSrcGetDoTimestampMethodInfo         ,
#endif
    baseSrcGetDoTimestamp                   ,


-- ** isAsync #method:isAsync#

#if defined(ENABLE_OVERLOADING)
    BaseSrcIsAsyncMethodInfo                ,
#endif
    baseSrcIsAsync                          ,


-- ** isLive #method:isLive#

#if defined(ENABLE_OVERLOADING)
    BaseSrcIsLiveMethodInfo                 ,
#endif
    baseSrcIsLive                           ,


-- ** newSeamlessSegment #method:newSeamlessSegment#

#if defined(ENABLE_OVERLOADING)
    BaseSrcNewSeamlessSegmentMethodInfo     ,
#endif
    baseSrcNewSeamlessSegment               ,


-- ** queryLatency #method:queryLatency#

#if defined(ENABLE_OVERLOADING)
    BaseSrcQueryLatencyMethodInfo           ,
#endif
    baseSrcQueryLatency                     ,


-- ** setAsync #method:setAsync#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetAsyncMethodInfo               ,
#endif
    baseSrcSetAsync                         ,


-- ** setAutomaticEos #method:setAutomaticEos#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetAutomaticEosMethodInfo        ,
#endif
    baseSrcSetAutomaticEos                  ,


-- ** setBlocksize #method:setBlocksize#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetBlocksizeMethodInfo           ,
#endif
    baseSrcSetBlocksize                     ,


-- ** setCaps #method:setCaps#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetCapsMethodInfo                ,
#endif
    baseSrcSetCaps                          ,


-- ** setDoTimestamp #method:setDoTimestamp#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetDoTimestampMethodInfo         ,
#endif
    baseSrcSetDoTimestamp                   ,


-- ** setDynamicSize #method:setDynamicSize#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetDynamicSizeMethodInfo         ,
#endif
    baseSrcSetDynamicSize                   ,


-- ** setFormat #method:setFormat#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetFormatMethodInfo              ,
#endif
    baseSrcSetFormat                        ,


-- ** setLive #method:setLive#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSetLiveMethodInfo                ,
#endif
    baseSrcSetLive                          ,


-- ** startComplete #method:startComplete#

#if defined(ENABLE_OVERLOADING)
    BaseSrcStartCompleteMethodInfo          ,
#endif
    baseSrcStartComplete                    ,


-- ** startWait #method:startWait#

#if defined(ENABLE_OVERLOADING)
    BaseSrcStartWaitMethodInfo              ,
#endif
    baseSrcStartWait                        ,


-- ** submitBufferList #method:submitBufferList#

#if defined(ENABLE_OVERLOADING)
    BaseSrcSubmitBufferListMethodInfo       ,
#endif
    baseSrcSubmitBufferList                 ,


-- ** waitPlaying #method:waitPlaying#

#if defined(ENABLE_OVERLOADING)
    BaseSrcWaitPlayingMethodInfo            ,
#endif
    baseSrcWaitPlaying                      ,




 -- * Properties
-- ** blocksize #attr:blocksize#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BaseSrcBlocksizePropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    baseSrcBlocksize                        ,
#endif
    constructBaseSrcBlocksize               ,
    getBaseSrcBlocksize                     ,
    setBaseSrcBlocksize                     ,


-- ** doTimestamp #attr:doTimestamp#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BaseSrcDoTimestampPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    baseSrcDoTimestamp                      ,
#endif
    constructBaseSrcDoTimestamp             ,
    getBaseSrcDoTimestamp                   ,
    setBaseSrcDoTimestamp                   ,


-- ** numBuffers #attr:numBuffers#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BaseSrcNumBuffersPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    baseSrcNumBuffers                       ,
#endif
    constructBaseSrcNumBuffers              ,
    getBaseSrcNumBuffers                    ,
    setBaseSrcNumBuffers                    ,


-- ** typefind #attr:typefind#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BaseSrcTypefindPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    baseSrcTypefind                         ,
#endif
    constructBaseSrcTypefind                ,
    getBaseSrcTypefind                      ,
    setBaseSrcTypefind                      ,




    ) 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.Enums as Gst.Enums
import qualified GI.Gst.Objects.Allocator as Gst.Allocator
import qualified GI.Gst.Objects.BufferPool as Gst.BufferPool
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import qualified GI.Gst.Structs.BufferList as Gst.BufferList
import qualified GI.Gst.Structs.Caps as Gst.Caps

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

instance GObject BaseSrc where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_base_src_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `BaseSrc`.
noBaseSrc :: Maybe BaseSrc
noBaseSrc :: Maybe BaseSrc
noBaseSrc = Maybe BaseSrc
forall a. Maybe a
Nothing

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

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

#endif

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

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

-- | Set the value of the “@blocksize@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseSrc [ #blocksize 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseSrcBlocksize :: (MonadIO m, IsBaseSrc o) => o -> Word32 -> m ()
setBaseSrcBlocksize :: o -> Word32 -> m ()
setBaseSrcBlocksize obj :: o
obj val :: Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj "blocksize" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@blocksize@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBaseSrcBlocksize :: (IsBaseSrc o) => Word32 -> IO (GValueConstruct o)
constructBaseSrcBlocksize :: Word32 -> IO (GValueConstruct o)
constructBaseSrcBlocksize val :: Word32
val = String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 "blocksize" Word32
val

#if defined(ENABLE_OVERLOADING)
data BaseSrcBlocksizePropertyInfo
instance AttrInfo BaseSrcBlocksizePropertyInfo where
    type AttrAllowedOps BaseSrcBlocksizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BaseSrcBlocksizePropertyInfo = IsBaseSrc
    type AttrSetTypeConstraint BaseSrcBlocksizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint BaseSrcBlocksizePropertyInfo = (~) Word32
    type AttrTransferType BaseSrcBlocksizePropertyInfo = Word32
    type AttrGetType BaseSrcBlocksizePropertyInfo = Word32
    type AttrLabel BaseSrcBlocksizePropertyInfo = "blocksize"
    type AttrOrigin BaseSrcBlocksizePropertyInfo = BaseSrc
    attrGet = getBaseSrcBlocksize
    attrSet = setBaseSrcBlocksize
    attrTransfer _ v = do
        return v
    attrConstruct = constructBaseSrcBlocksize
    attrClear = undefined
#endif

-- VVV Prop "do-timestamp"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@do-timestamp@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseSrc #doTimestamp
-- @
getBaseSrcDoTimestamp :: (MonadIO m, IsBaseSrc o) => o -> m Bool
getBaseSrcDoTimestamp :: o -> m Bool
getBaseSrcDoTimestamp obj :: 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 "do-timestamp"

-- | Set the value of the “@do-timestamp@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseSrc [ #doTimestamp 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseSrcDoTimestamp :: (MonadIO m, IsBaseSrc o) => o -> Bool -> m ()
setBaseSrcDoTimestamp :: o -> Bool -> m ()
setBaseSrcDoTimestamp obj :: o
obj val :: 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 "do-timestamp" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@do-timestamp@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBaseSrcDoTimestamp :: (IsBaseSrc o) => Bool -> IO (GValueConstruct o)
constructBaseSrcDoTimestamp :: Bool -> IO (GValueConstruct o)
constructBaseSrcDoTimestamp val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "do-timestamp" Bool
val

#if defined(ENABLE_OVERLOADING)
data BaseSrcDoTimestampPropertyInfo
instance AttrInfo BaseSrcDoTimestampPropertyInfo where
    type AttrAllowedOps BaseSrcDoTimestampPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BaseSrcDoTimestampPropertyInfo = IsBaseSrc
    type AttrSetTypeConstraint BaseSrcDoTimestampPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BaseSrcDoTimestampPropertyInfo = (~) Bool
    type AttrTransferType BaseSrcDoTimestampPropertyInfo = Bool
    type AttrGetType BaseSrcDoTimestampPropertyInfo = Bool
    type AttrLabel BaseSrcDoTimestampPropertyInfo = "do-timestamp"
    type AttrOrigin BaseSrcDoTimestampPropertyInfo = BaseSrc
    attrGet = getBaseSrcDoTimestamp
    attrSet = setBaseSrcDoTimestamp
    attrTransfer _ v = do
        return v
    attrConstruct = constructBaseSrcDoTimestamp
    attrClear = undefined
#endif

-- VVV Prop "num-buffers"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@num-buffers@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseSrc [ #numBuffers 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseSrcNumBuffers :: (MonadIO m, IsBaseSrc o) => o -> Int32 -> m ()
setBaseSrcNumBuffers :: o -> Int32 -> m ()
setBaseSrcNumBuffers obj :: o
obj val :: Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "num-buffers" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@num-buffers@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBaseSrcNumBuffers :: (IsBaseSrc o) => Int32 -> IO (GValueConstruct o)
constructBaseSrcNumBuffers :: Int32 -> IO (GValueConstruct o)
constructBaseSrcNumBuffers val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "num-buffers" Int32
val

#if defined(ENABLE_OVERLOADING)
data BaseSrcNumBuffersPropertyInfo
instance AttrInfo BaseSrcNumBuffersPropertyInfo where
    type AttrAllowedOps BaseSrcNumBuffersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BaseSrcNumBuffersPropertyInfo = IsBaseSrc
    type AttrSetTypeConstraint BaseSrcNumBuffersPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BaseSrcNumBuffersPropertyInfo = (~) Int32
    type AttrTransferType BaseSrcNumBuffersPropertyInfo = Int32
    type AttrGetType BaseSrcNumBuffersPropertyInfo = Int32
    type AttrLabel BaseSrcNumBuffersPropertyInfo = "num-buffers"
    type AttrOrigin BaseSrcNumBuffersPropertyInfo = BaseSrc
    attrGet = getBaseSrcNumBuffers
    attrSet = setBaseSrcNumBuffers
    attrTransfer _ v = do
        return v
    attrConstruct = constructBaseSrcNumBuffers
    attrClear = undefined
#endif

-- VVV Prop "typefind"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@typefind@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' baseSrc #typefind
-- @
getBaseSrcTypefind :: (MonadIO m, IsBaseSrc o) => o -> m Bool
getBaseSrcTypefind :: o -> m Bool
getBaseSrcTypefind obj :: 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 "typefind"

-- | Set the value of the “@typefind@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' baseSrc [ #typefind 'Data.GI.Base.Attributes.:=' value ]
-- @
setBaseSrcTypefind :: (MonadIO m, IsBaseSrc o) => o -> Bool -> m ()
setBaseSrcTypefind :: o -> Bool -> m ()
setBaseSrcTypefind obj :: o
obj val :: 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 "typefind" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@typefind@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBaseSrcTypefind :: (IsBaseSrc o) => Bool -> IO (GValueConstruct o)
constructBaseSrcTypefind :: Bool -> IO (GValueConstruct o)
constructBaseSrcTypefind val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "typefind" Bool
val

#if defined(ENABLE_OVERLOADING)
data BaseSrcTypefindPropertyInfo
instance AttrInfo BaseSrcTypefindPropertyInfo where
    type AttrAllowedOps BaseSrcTypefindPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BaseSrcTypefindPropertyInfo = IsBaseSrc
    type AttrSetTypeConstraint BaseSrcTypefindPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BaseSrcTypefindPropertyInfo = (~) Bool
    type AttrTransferType BaseSrcTypefindPropertyInfo = Bool
    type AttrGetType BaseSrcTypefindPropertyInfo = Bool
    type AttrLabel BaseSrcTypefindPropertyInfo = "typefind"
    type AttrOrigin BaseSrcTypefindPropertyInfo = BaseSrc
    attrGet = getBaseSrcTypefind
    attrSet = setBaseSrcTypefind
    attrTransfer _ v = do
        return v
    attrConstruct = constructBaseSrcTypefind
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BaseSrc
type instance O.AttributeList BaseSrc = BaseSrcAttributeList
type BaseSrcAttributeList = ('[ '("blocksize", BaseSrcBlocksizePropertyInfo), '("doTimestamp", BaseSrcDoTimestampPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("numBuffers", BaseSrcNumBuffersPropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("typefind", BaseSrcTypefindPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
baseSrcBlocksize :: AttrLabelProxy "blocksize"
baseSrcBlocksize = AttrLabelProxy

baseSrcDoTimestamp :: AttrLabelProxy "doTimestamp"
baseSrcDoTimestamp = AttrLabelProxy

baseSrcNumBuffers :: AttrLabelProxy "numBuffers"
baseSrcNumBuffers = AttrLabelProxy

baseSrcTypefind :: AttrLabelProxy "typefind"
baseSrcTypefind = AttrLabelProxy

#endif

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

#endif

-- method BaseSrc::get_allocator
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseSrc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocator"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Allocator" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAllocator\nused"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "AllocationParams" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the\n#GstAllocationParams of @allocator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_get_allocator" gst_base_src_get_allocator :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    Ptr (Ptr Gst.Allocator.Allocator) ->    -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Lets t'GI.GstBase.Objects.BaseSrc.BaseSrc' sub-classes to know the memory /@allocator@/
-- used by the base class and its /@params@/.
-- 
-- Unref the /@allocator@/ after usage.
baseSrcGetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstBase.Objects.BaseSrc.BaseSrc'
    -> m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
baseSrcGetAllocator :: a -> m (Allocator, AllocationParams)
baseSrcGetAllocator src :: a
src = IO (Allocator, AllocationParams) -> m (Allocator, AllocationParams)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocator, AllocationParams)
 -> m (Allocator, AllocationParams))
-> IO (Allocator, AllocationParams)
-> m (Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr (Ptr Allocator)
allocator <- IO (Ptr (Ptr Allocator))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 64 :: IO (Ptr Gst.AllocationParams.AllocationParams)
    Ptr BaseSrc -> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO ()
gst_base_src_get_allocator Ptr BaseSrc
src' Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Allocator
allocator'' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator'
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
Gst.AllocationParams.AllocationParams) Ptr AllocationParams
params
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Allocator, AllocationParams) -> IO (Allocator, AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocator
allocator'', AllocationParams
params')

#if defined(ENABLE_OVERLOADING)
data BaseSrcGetAllocatorMethodInfo
instance (signature ~ (m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcGetAllocatorMethodInfo a signature where
    overloadedMethod = baseSrcGetAllocator

#endif

-- method BaseSrc::get_blocksize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_get_blocksize" gst_base_src_get_blocksize :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO Word32

-- | Get the number of bytes that /@src@/ will push out with each buffer.
baseSrcGetBlocksize ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: the source
    -> m Word32
    -- ^ __Returns:__ the number of bytes pushed with each buffer.
baseSrcGetBlocksize :: a -> m Word32
baseSrcGetBlocksize src :: a
src = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Word32
result <- Ptr BaseSrc -> IO Word32
gst_base_src_get_blocksize Ptr BaseSrc
src'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data BaseSrcGetBlocksizeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcGetBlocksizeMethodInfo a signature where
    overloadedMethod = baseSrcGetBlocksize

#endif

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

foreign import ccall "gst_base_src_get_buffer_pool" gst_base_src_get_buffer_pool :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO (Ptr Gst.BufferPool.BufferPool)

-- | /No description available in the introspection data./
baseSrcGetBufferPool ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstBase.Objects.BaseSrc.BaseSrc'
    -> m Gst.BufferPool.BufferPool
    -- ^ __Returns:__ the instance of the t'GI.Gst.Objects.BufferPool.BufferPool' used
    -- by the src; unref it after usage.
baseSrcGetBufferPool :: a -> m BufferPool
baseSrcGetBufferPool src :: a
src = IO BufferPool -> m BufferPool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BufferPool -> m BufferPool) -> IO BufferPool -> m BufferPool
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr BufferPool
result <- Ptr BaseSrc -> IO (Ptr BufferPool)
gst_base_src_get_buffer_pool Ptr BaseSrc
src'
    Text -> Ptr BufferPool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "baseSrcGetBufferPool" Ptr BufferPool
result
    BufferPool
result' <- ((ManagedPtr BufferPool -> BufferPool)
-> Ptr BufferPool -> IO BufferPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BufferPool -> BufferPool
Gst.BufferPool.BufferPool) Ptr BufferPool
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    BufferPool -> IO BufferPool
forall (m :: * -> *) a. Monad m => a -> m a
return BufferPool
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcGetBufferPoolMethodInfo
instance (signature ~ (m Gst.BufferPool.BufferPool), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcGetBufferPoolMethodInfo a signature where
    overloadedMethod = baseSrcGetBufferPool

#endif

-- method BaseSrc::get_do_timestamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source" , 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_base_src_get_do_timestamp" gst_base_src_get_do_timestamp :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO CInt

-- | Query if /@src@/ timestamps outgoing buffers based on the current running_time.
baseSrcGetDoTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: the source
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the base class will automatically timestamp outgoing buffers.
baseSrcGetDoTimestamp :: a -> m Bool
baseSrcGetDoTimestamp src :: a
src = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CInt
result <- Ptr BaseSrc -> IO CInt
gst_base_src_get_do_timestamp Ptr BaseSrc
src'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcGetDoTimestampMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcGetDoTimestampMethodInfo a signature where
    overloadedMethod = baseSrcGetDoTimestamp

#endif

-- method BaseSrc::is_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , 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_base_src_is_async" gst_base_src_is_async :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO CInt

-- | Get the current async behaviour of /@src@/. See also 'GI.GstBase.Objects.BaseSrc.baseSrcSetAsync'.
baseSrcIsAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@src@/ is operating in async mode.
baseSrcIsAsync :: a -> m Bool
baseSrcIsAsync src :: a
src = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CInt
result <- Ptr BaseSrc -> IO CInt
gst_base_src_is_async Ptr BaseSrc
src'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcIsAsyncMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcIsAsyncMethodInfo a signature where
    overloadedMethod = baseSrcIsAsync

#endif

-- method BaseSrc::is_live
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , 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_base_src_is_live" gst_base_src_is_live :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO CInt

-- | Check if an element is in live mode.
baseSrcIsLive ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> m Bool
    -- ^ __Returns:__ 'P.True' if element is in live mode.
baseSrcIsLive :: a -> m Bool
baseSrcIsLive src :: a
src = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CInt
result <- Ptr BaseSrc -> IO CInt
gst_base_src_is_live Ptr BaseSrc
src'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcIsLiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcIsLiveMethodInfo a signature where
    overloadedMethod = baseSrcIsLive

#endif

-- method BaseSrc::new_seamless_segment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The source" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new start value for the segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stop"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Stop value for the new segment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The new time value for the start of the new segment"
--                 , 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_base_src_new_seamless_segment" gst_base_src_new_seamless_segment :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    Int64 ->                                -- start : TBasicType TInt64
    Int64 ->                                -- stop : TBasicType TInt64
    Int64 ->                                -- time : TBasicType TInt64
    IO CInt

-- | Prepare a new seamless segment for emission downstream. This function must
-- only be called by derived sub-classes, and only from the @/create()/@ function,
-- as the stream-lock needs to be held.
-- 
-- The format for the new segment will be the current format of the source, as
-- configured with 'GI.GstBase.Objects.BaseSrc.baseSrcSetFormat'
baseSrcNewSeamlessSegment ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: The source
    -> Int64
    -- ^ /@start@/: The new start value for the segment
    -> Int64
    -- ^ /@stop@/: Stop value for the new segment
    -> Int64
    -- ^ /@time@/: The new time value for the start of the new segment
    -> m Bool
    -- ^ __Returns:__ 'P.True' if preparation of the seamless segment succeeded.
baseSrcNewSeamlessSegment :: a -> Int64 -> Int64 -> Int64 -> m Bool
baseSrcNewSeamlessSegment src :: a
src start :: Int64
start stop :: Int64
stop time :: Int64
time = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CInt
result <- Ptr BaseSrc -> Int64 -> Int64 -> Int64 -> IO CInt
gst_base_src_new_seamless_segment Ptr BaseSrc
src' Int64
start Int64
stop Int64
time
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcNewSeamlessSegmentMethodInfo
instance (signature ~ (Int64 -> Int64 -> Int64 -> m Bool), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcNewSeamlessSegmentMethodInfo a signature where
    overloadedMethod = baseSrcNewSeamlessSegment

#endif

-- method BaseSrc::query_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if the source is live"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "min_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the min latency of the source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "max_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the max latency of the source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_query_latency" gst_base_src_query_latency :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    Ptr CInt ->                             -- live : TBasicType TBoolean
    Ptr Word64 ->                           -- min_latency : TBasicType TUInt64
    Ptr Word64 ->                           -- max_latency : TBasicType TUInt64
    IO CInt

-- | Query the source for the latency parameters. /@live@/ will be 'P.True' when /@src@/ is
-- configured as a live source. /@minLatency@/ and /@maxLatency@/ will be set
-- to the difference between the running time and the timestamp of the first
-- buffer.
-- 
-- This function is mostly used by subclasses.
baseSrcQueryLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: the source
    -> m ((Bool, Bool, Word64, Word64))
    -- ^ __Returns:__ 'P.True' if the query succeeded.
baseSrcQueryLatency :: a -> m (Bool, Bool, Word64, Word64)
baseSrcQueryLatency src :: a
src = IO (Bool, Bool, Word64, Word64) -> m (Bool, Bool, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Bool, Word64, Word64) -> m (Bool, Bool, Word64, Word64))
-> IO (Bool, Bool, Word64, Word64)
-> m (Bool, Bool, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr CInt
live <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Word64
minLatency <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
maxLatency <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr BaseSrc -> Ptr CInt -> Ptr Word64 -> Ptr Word64 -> IO CInt
gst_base_src_query_latency Ptr BaseSrc
src' Ptr CInt
live Ptr Word64
minLatency Ptr Word64
maxLatency
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CInt
live' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
live
    let live'' :: Bool
live'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
live'
    Word64
minLatency' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
minLatency
    Word64
maxLatency' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
maxLatency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
live
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
minLatency
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
maxLatency
    (Bool, Bool, Word64, Word64) -> IO (Bool, Bool, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Bool
live'', Word64
minLatency', Word64
maxLatency')

#if defined(ENABLE_OVERLOADING)
data BaseSrcQueryLatencyMethodInfo
instance (signature ~ (m ((Bool, Bool, Word64, Word64))), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcQueryLatencyMethodInfo a signature where
    overloadedMethod = baseSrcQueryLatency

#endif

-- method BaseSrc::set_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "async"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new async mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_set_async" gst_base_src_set_async :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CInt ->                                 -- async : TBasicType TBoolean
    IO ()

-- | Configure async behaviour in /@src@/, no state change will block. The open,
-- close, start, stop, play and pause virtual methods will be executed in a
-- different thread and are thus allowed to perform blocking operations. Any
-- blocking operation should be unblocked with the unlock vmethod.
baseSrcSetAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> Bool
    -- ^ /@async@/: new async mode
    -> m ()
baseSrcSetAsync :: a -> Bool -> m ()
baseSrcSetAsync src :: a
src async :: Bool
async = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let async' :: CInt
async' = (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
async
    Ptr BaseSrc -> CInt -> IO ()
gst_base_src_set_async Ptr BaseSrc
src' CInt
async'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetAsyncMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetAsyncMethodInfo a signature where
    overloadedMethod = baseSrcSetAsync

#endif

-- method BaseSrc::set_automatic_eos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "automatic_eos"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "automatic eos" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_set_automatic_eos" gst_base_src_set_automatic_eos :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CInt ->                                 -- automatic_eos : TBasicType TBoolean
    IO ()

-- | If /@automaticEos@/ is 'P.True', /@src@/ will automatically go EOS if a buffer
-- after the total size is returned. By default this is 'P.True' but sources
-- that can\'t return an authoritative size and only know that they\'re EOS
-- when trying to read more should set this to 'P.False'.
-- 
-- When /@src@/ operates in 'GI.Gst.Enums.FormatTime', t'GI.GstBase.Objects.BaseSrc.BaseSrc' will send an EOS
-- when a buffer outside of the currently configured segment is pushed if
-- /@automaticEos@/ is 'P.True'. Since 1.16, if /@automaticEos@/ is 'P.False' an
-- EOS will be pushed only when the t'GI.GstBase.Objects.BaseSrc.BaseSrc'.@/create/@ implementation
-- returns 'GI.Gst.Enums.FlowReturnEos'.
-- 
-- /Since: 1.4/
baseSrcSetAutomaticEos ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> Bool
    -- ^ /@automaticEos@/: automatic eos
    -> m ()
baseSrcSetAutomaticEos :: a -> Bool -> m ()
baseSrcSetAutomaticEos src :: a
src automaticEos :: Bool
automaticEos = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let automaticEos' :: CInt
automaticEos' = (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
automaticEos
    Ptr BaseSrc -> CInt -> IO ()
gst_base_src_set_automatic_eos Ptr BaseSrc
src' CInt
automaticEos'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetAutomaticEosMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetAutomaticEosMethodInfo a signature where
    overloadedMethod = baseSrcSetAutomaticEos

#endif

-- method BaseSrc::set_blocksize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blocksize"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new blocksize in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_set_blocksize" gst_base_src_set_blocksize :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    Word32 ->                               -- blocksize : TBasicType TUInt
    IO ()

-- | Set the number of bytes that /@src@/ will push out with each buffer. When
-- /@blocksize@/ is set to -1, a default length will be used.
baseSrcSetBlocksize ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: the source
    -> Word32
    -- ^ /@blocksize@/: the new blocksize in bytes
    -> m ()
baseSrcSetBlocksize :: a -> Word32 -> m ()
baseSrcSetBlocksize src :: a
src blocksize :: Word32
blocksize = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr BaseSrc -> Word32 -> IO ()
gst_base_src_set_blocksize Ptr BaseSrc
src' Word32
blocksize
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetBlocksizeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetBlocksizeMethodInfo a signature where
    overloadedMethod = baseSrcSetBlocksize

#endif

-- method BaseSrc::set_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseSrc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , 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_base_src_set_caps" gst_base_src_set_caps :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Set new caps on the basesrc source pad.
baseSrcSetCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstBase.Objects.BaseSrc.BaseSrc'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the caps could be set
baseSrcSetCaps :: a -> Caps -> m Bool
baseSrcSetCaps src :: a
src caps :: Caps
caps = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr BaseSrc -> Ptr Caps -> IO CInt
gst_base_src_set_caps Ptr BaseSrc
src' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetCapsMethodInfo a signature where
    overloadedMethod = baseSrcSetCaps

#endif

-- method BaseSrc::set_do_timestamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "enable or disable timestamping"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_set_do_timestamp" gst_base_src_set_do_timestamp :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CInt ->                                 -- timestamp : TBasicType TBoolean
    IO ()

-- | Configure /@src@/ to automatically timestamp outgoing buffers based on the
-- current running_time of the pipeline. This property is mostly useful for live
-- sources.
baseSrcSetDoTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: the source
    -> Bool
    -- ^ /@timestamp@/: enable or disable timestamping
    -> m ()
baseSrcSetDoTimestamp :: a -> Bool -> m ()
baseSrcSetDoTimestamp src :: a
src timestamp :: Bool
timestamp = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let timestamp' :: CInt
timestamp' = (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
timestamp
    Ptr BaseSrc -> CInt -> IO ()
gst_base_src_set_do_timestamp Ptr BaseSrc
src' CInt
timestamp'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetDoTimestampMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetDoTimestampMethodInfo a signature where
    overloadedMethod = baseSrcSetDoTimestamp

#endif

-- method BaseSrc::set_dynamic_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dynamic"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new dynamic size mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_set_dynamic_size" gst_base_src_set_dynamic_size :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CInt ->                                 -- dynamic : TBasicType TBoolean
    IO ()

-- | If not /@dynamic@/, size is only updated when needed, such as when trying to
-- read past current tracked size.  Otherwise, size is checked for upon each
-- read.
baseSrcSetDynamicSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> Bool
    -- ^ /@dynamic@/: new dynamic size mode
    -> m ()
baseSrcSetDynamicSize :: a -> Bool -> m ()
baseSrcSetDynamicSize src :: a
src dynamic :: Bool
dynamic = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let dynamic' :: CInt
dynamic' = (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
dynamic
    Ptr BaseSrc -> CInt -> IO ()
gst_base_src_set_dynamic_size Ptr BaseSrc
src' CInt
dynamic'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetDynamicSizeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetDynamicSizeMethodInfo a signature where
    overloadedMethod = baseSrcSetDynamicSize

#endif

-- method BaseSrc::set_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the format 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_base_src_set_format" gst_base_src_set_format :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    IO ()

-- | Sets the default format of the source. This will be the format used
-- for sending SEGMENT events and for performing seeks.
-- 
-- If a format of GST_FORMAT_BYTES is set, the element will be able to
-- operate in pull mode if the t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/is_seekable/@() returns 'P.True'.
-- 
-- This function must only be called in states \< 'GI.Gst.Enums.StatePaused'.
baseSrcSetFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> Gst.Enums.Format
    -- ^ /@format@/: the format to use
    -> m ()
baseSrcSetFormat :: a -> Format -> m ()
baseSrcSetFormat src :: a
src format :: Format
format = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr BaseSrc -> CUInt -> IO ()
gst_base_src_set_format Ptr BaseSrc
src' CUInt
format'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetFormatMethodInfo
instance (signature ~ (Gst.Enums.Format -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetFormatMethodInfo a signature where
    overloadedMethod = baseSrcSetFormat

#endif

-- method BaseSrc::set_live
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new live-mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_set_live" gst_base_src_set_live :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CInt ->                                 -- live : TBasicType TBoolean
    IO ()

-- | If the element listens to a live source, /@live@/ should
-- be set to 'P.True'.
-- 
-- A live source will not produce data in the PAUSED state and
-- will therefore not be able to participate in the PREROLL phase
-- of a pipeline. To signal this fact to the application and the
-- pipeline, the state change return value of the live source will
-- be GST_STATE_CHANGE_NO_PREROLL.
baseSrcSetLive ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: base source instance
    -> Bool
    -- ^ /@live@/: new live-mode
    -> m ()
baseSrcSetLive :: a -> Bool -> m ()
baseSrcSetLive src :: a
src live :: Bool
live = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let live' :: CInt
live' = (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
live
    Ptr BaseSrc -> CInt -> IO ()
gst_base_src_set_live Ptr BaseSrc
src' CInt
live'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSetLiveMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSetLiveMethodInfo a signature where
    overloadedMethod = baseSrcSetLive

#endif

-- method BaseSrc::start_complete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "basesrc"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ret"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "FlowReturn" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstFlowReturn" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_start_complete" gst_base_src_start_complete :: 
    Ptr BaseSrc ->                          -- basesrc : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    CInt ->                                 -- ret : TInterface (Name {namespace = "Gst", name = "FlowReturn"})
    IO ()

-- | Complete an asynchronous start operation. When the subclass overrides the
-- start method, it should call 'GI.GstBase.Objects.BaseSrc.baseSrcStartComplete' when the start
-- operation completes either from the same thread or from an asynchronous
-- helper thread.
baseSrcStartComplete ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@basesrc@/: base source instance
    -> Gst.Enums.FlowReturn
    -- ^ /@ret@/: a t'GI.Gst.Enums.FlowReturn'
    -> m ()
baseSrcStartComplete :: a -> FlowReturn -> m ()
baseSrcStartComplete basesrc :: a
basesrc ret :: FlowReturn
ret = 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 BaseSrc
basesrc' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
basesrc
    let ret' :: CInt
ret' = (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
ret
    Ptr BaseSrc -> CInt -> IO ()
gst_base_src_start_complete Ptr BaseSrc
basesrc' CInt
ret'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
basesrc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcStartCompleteMethodInfo
instance (signature ~ (Gst.Enums.FlowReturn -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcStartCompleteMethodInfo a signature where
    overloadedMethod = baseSrcStartComplete

#endif

-- method BaseSrc::start_wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "basesrc"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "base source instance"
--                 , 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_base_src_start_wait" gst_base_src_start_wait :: 
    Ptr BaseSrc ->                          -- basesrc : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO CInt

-- | Wait until the start operation completes.
baseSrcStartWait ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@basesrc@/: base source instance
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn'.
baseSrcStartWait :: a -> m FlowReturn
baseSrcStartWait basesrc :: a
basesrc = 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 BaseSrc
basesrc' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
basesrc
    CInt
result <- Ptr BaseSrc -> IO CInt
gst_base_src_start_wait Ptr BaseSrc
basesrc'
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
basesrc
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcStartWaitMethodInfo
instance (signature ~ (m Gst.Enums.FlowReturn), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcStartWaitMethodInfo a signature where
    overloadedMethod = baseSrcStartWait

#endif

-- method BaseSrc::submit_buffer_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseSrc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer_list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_base_src_submit_buffer_list" gst_base_src_submit_buffer_list :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    Ptr Gst.BufferList.BufferList ->        -- buffer_list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO ()

-- | Subclasses can call this from their create virtual method implementation
-- to submit a buffer list to be pushed out later. This is useful in
-- cases where the create function wants to produce multiple buffers to be
-- pushed out in one go in form of a t'GI.Gst.Structs.BufferList.BufferList', which can reduce overhead
-- drastically, especially for packetised inputs (for data streams where
-- the packetisation\/chunking is not important it is usually more efficient
-- to return larger buffers instead).
-- 
-- Subclasses that use this function from their create function must return
-- 'GI.Gst.Enums.FlowReturnOk' and no buffer from their create virtual method implementation.
-- If a buffer is returned after a buffer list has also been submitted via this
-- function the behaviour is undefined.
-- 
-- Subclasses must only call this function once per create function call and
-- subclasses must only call this function when the source operates in push
-- mode.
-- 
-- /Since: 1.14/
baseSrcSubmitBufferList ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstBase.Objects.BaseSrc.BaseSrc'
    -> Gst.BufferList.BufferList
    -- ^ /@bufferList@/: a t'GI.Gst.Structs.BufferList.BufferList'
    -> m ()
baseSrcSubmitBufferList :: a -> BufferList -> m ()
baseSrcSubmitBufferList src :: a
src bufferList :: BufferList
bufferList = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr BufferList
bufferList' <- BufferList -> IO (Ptr BufferList)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed BufferList
bufferList
    Ptr BaseSrc -> Ptr BufferList -> IO ()
gst_base_src_submit_buffer_list Ptr BaseSrc
src' Ptr BufferList
bufferList'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    BufferList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BufferList
bufferList
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseSrcSubmitBufferListMethodInfo
instance (signature ~ (Gst.BufferList.BufferList -> m ()), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcSubmitBufferListMethodInfo a signature where
    overloadedMethod = baseSrcSubmitBufferList

#endif

-- method BaseSrc::wait_playing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the src" , 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_base_src_wait_playing" gst_base_src_wait_playing :: 
    Ptr BaseSrc ->                          -- src : TInterface (Name {namespace = "GstBase", name = "BaseSrc"})
    IO CInt

-- | If the t'GI.GstBase.Structs.BaseSrcClass.BaseSrcClass'.@/create/@() method performs its own synchronisation
-- against the clock it must unblock when going from PLAYING to the PAUSED state
-- and call this method before continuing to produce the remaining data.
-- 
-- This function will block until a state change to PLAYING happens (in which
-- case this function returns 'GI.Gst.Enums.FlowReturnOk') or the processing must be stopped due
-- to a state change to READY or a FLUSH event (in which case this function
-- returns 'GI.Gst.Enums.FlowReturnFlushing').
baseSrcWaitPlaying ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseSrc a) =>
    a
    -- ^ /@src@/: the src
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ 'GI.Gst.Enums.FlowReturnOk' if /@src@/ is PLAYING and processing can
    -- continue. Any other return value should be returned from the create vmethod.
baseSrcWaitPlaying :: a -> m FlowReturn
baseSrcWaitPlaying src :: a
src = 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 BaseSrc
src' <- a -> IO (Ptr BaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CInt
result <- Ptr BaseSrc -> IO CInt
gst_base_src_wait_playing Ptr BaseSrc
src'
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data BaseSrcWaitPlayingMethodInfo
instance (signature ~ (m Gst.Enums.FlowReturn), MonadIO m, IsBaseSrc a) => O.MethodInfo BaseSrcWaitPlayingMethodInfo a signature where
    overloadedMethod = baseSrcWaitPlaying

#endif