{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This base class is for parser elements that process data and splits it
-- into separate audio\/video\/whatever frames.
-- 
-- It provides for:
-- 
--   * provides one sink pad and one source pad
--   * handles state changes
--   * can operate in pull mode or push mode
--   * handles seeking in both modes
--   * handles events (SEGMENT\/EOS\/FLUSH)
--   * handles queries (POSITION\/DURATION\/SEEKING\/FORMAT\/CONVERT)
--   * handles flushing
-- 
-- The purpose of this base class is to provide the basic functionality of
-- a parser and share a lot of rather complex code.
-- 
-- = Description of the parsing mechanism:
-- 
-- == Set-up phase
-- 
--  * t'GI.GstBase.Objects.BaseParse.BaseParse' calls t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/start/@() to inform subclass
--    that data processing is about to start now.
-- 
--  * t'GI.GstBase.Objects.BaseParse.BaseParse' class calls t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/set_sink_caps/@() to
--    inform the subclass about incoming sinkpad caps. Subclass could
--    already set the srcpad caps accordingly, but this might be delayed
--    until calling 'GI.GstBase.Objects.BaseParse.baseParseFinishFrame' with a non-queued frame.
-- 
--  * At least at this point subclass needs to tell the t'GI.GstBase.Objects.BaseParse.BaseParse' class
--    how big data chunks it wants to receive (minimum frame size ). It can
--    do this with 'GI.GstBase.Objects.BaseParse.baseParseSetMinFrameSize'.
-- 
--  * t'GI.GstBase.Objects.BaseParse.BaseParse' class sets up appropriate data passing mode (pull\/push)
--    and starts to process the data.
-- 
-- == Parsing phase
-- 
--  * t'GI.GstBase.Objects.BaseParse.BaseParse' gathers at least min_frame_size bytes of data either
--    by pulling it from upstream or collecting buffers in an internal
--    t'GI.GstBase.Objects.Adapter.Adapter'.
-- 
--  * A buffer of (at least) min_frame_size bytes is passed to subclass
--    with t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/handle_frame/@(). Subclass checks the contents
--    and can optionally return @/GST_FLOW_OK/@ along with an amount of data
--    to be skipped to find a valid frame (which will result in a
--    subsequent DISCONT).  If, otherwise, the buffer does not hold a
--    complete frame, t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/handle_frame/@() can merely return
--    and will be called again when additional data is available.  In push
--    mode this amounts to an additional input buffer (thus minimal
--    additional latency), in pull mode this amounts to some arbitrary
--    reasonable buffer size increase.
-- 
--    Of course, 'GI.GstBase.Objects.BaseParse.baseParseSetMinFrameSize' could also be used if
--    a very specific known amount of additional data is required.  If,
--    however, the buffer holds a complete valid frame, it can pass the
--    size of this frame to 'GI.GstBase.Objects.BaseParse.baseParseFinishFrame'.
-- 
--    If acting as a converter, it can also merely indicate consumed input
--    data while simultaneously providing custom output data.  Note that
--    baseclass performs some processing (such as tracking overall consumed
--    data rate versus duration) for each finished frame, but other state
--    is only updated upon each call to t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/handle_frame/@()
--    (such as tracking upstream input timestamp).
-- 
--    Subclass is also responsible for setting the buffer metadata
--    (e.g. buffer timestamp and duration, or keyframe if applicable).
--    (although the latter can also be done by t'GI.GstBase.Objects.BaseParse.BaseParse' if it is
--    appropriately configured, see below).  Frame is provided with
--    timestamp derived from upstream (as much as generally possible),
--    duration obtained from configuration (see below), and offset
--    if meaningful (in pull mode).
-- 
--    Note that t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/handle_frame/@() might receive any small
--    amount of input data when leftover data is being drained (e.g. at
--    EOS).
-- 
--  * As part of finish frame processing, just prior to actually pushing
--    the buffer in question, it is passed to
--    t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/pre_push_frame/@() which gives subclass yet one last
--    chance to examine buffer metadata, or to send some custom (tag)
--    events, or to perform custom (segment) filtering.
-- 
--  * During the parsing process t'GI.GstBase.Structs.BaseParseClass.BaseParseClass' will handle both srcpad
--    and sinkpad events. They will be passed to subclass if
--    t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/event/@() or t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/src_event/@()
--    implementations have been provided.
-- 
-- == Shutdown phase
-- 
-- * t'GI.GstBase.Objects.BaseParse.BaseParse' class calls t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/stop/@() to inform the
--   subclass that data parsing will be stopped.
-- 
-- Subclass is responsible for providing pad template caps for source and
-- sink pads. The pads need to be named \"sink\" and \"src\". It also needs to
-- set the fixed caps on srcpad, when the format is ensured (e.g.  when
-- base class calls subclass\' t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/set_sink_caps/@() function).
-- 
-- This base class uses 'GI.Gst.Enums.FormatDefault' as a meaning of frames. So,
-- subclass conversion routine needs to know that conversion from
-- 'GI.Gst.Enums.FormatTime' to 'GI.Gst.Enums.FormatDefault' must return the
-- frame number that can be found from the given byte position.
-- 
-- t'GI.GstBase.Objects.BaseParse.BaseParse' uses subclasses conversion methods also for seeking (or
-- otherwise uses its own default one, see also below).
-- 
-- Subclass /@start@/ and /@stop@/ functions will be called to inform the beginning
-- and end of data processing.
-- 
-- Things that subclass need to take care of:
-- 
-- * Provide pad templates
-- * Fixate the source pad caps when appropriate
-- * Inform base class how big data chunks should be retrieved. This is
--   done with 'GI.GstBase.Objects.BaseParse.baseParseSetMinFrameSize' function.
-- * Examine data chunks passed to subclass with
--   t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/handle_frame/@() and pass proper frame(s) to
--   'GI.GstBase.Objects.BaseParse.baseParseFinishFrame', and setting src pad caps and timestamps
--   on frame.
-- * Provide conversion functions
-- * Update the duration information with 'GI.GstBase.Objects.BaseParse.baseParseSetDuration'
-- * Optionally passthrough using 'GI.GstBase.Objects.BaseParse.baseParseSetPassthrough'
-- * Configure various baseparse parameters using
--   'GI.GstBase.Objects.BaseParse.baseParseSetAverageBitrate', 'GI.GstBase.Objects.BaseParse.baseParseSetSyncable'
--   and 'GI.GstBase.Objects.BaseParse.baseParseSetFrameRate'.
-- 
-- * In particular, if subclass is unable to determine a duration, but
--   parsing (or specs) yields a frames per seconds rate, then this can be
--   provided to t'GI.GstBase.Objects.BaseParse.BaseParse' to enable it to cater for buffer time
--   metadata (which will be taken from upstream as much as
--   possible). Internally keeping track of frame durations and respective
--   sizes that have been pushed provides t'GI.GstBase.Objects.BaseParse.BaseParse' with an estimated
--   bitrate. A default t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/convert/@() (used if not
--   overridden) will then use these rates to perform obvious conversions.
--   These rates are also used to update (estimated) duration at regular
--   frame intervals.

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

module GI.GstBase.Objects.BaseParse
    ( 

-- * Exported types
    BaseParse(..)                           ,
    IsBaseParse                             ,
    toBaseParse                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveBaseParseMethod                  ,
#endif


-- ** addIndexEntry #method:addIndexEntry#

#if defined(ENABLE_OVERLOADING)
    BaseParseAddIndexEntryMethodInfo        ,
#endif
    baseParseAddIndexEntry                  ,


-- ** convertDefault #method:convertDefault#

#if defined(ENABLE_OVERLOADING)
    BaseParseConvertDefaultMethodInfo       ,
#endif
    baseParseConvertDefault                 ,


-- ** drain #method:drain#

#if defined(ENABLE_OVERLOADING)
    BaseParseDrainMethodInfo                ,
#endif
    baseParseDrain                          ,


-- ** finishFrame #method:finishFrame#

#if defined(ENABLE_OVERLOADING)
    BaseParseFinishFrameMethodInfo          ,
#endif
    baseParseFinishFrame                    ,


-- ** mergeTags #method:mergeTags#

#if defined(ENABLE_OVERLOADING)
    BaseParseMergeTagsMethodInfo            ,
#endif
    baseParseMergeTags                      ,


-- ** pushFrame #method:pushFrame#

#if defined(ENABLE_OVERLOADING)
    BaseParsePushFrameMethodInfo            ,
#endif
    baseParsePushFrame                      ,


-- ** setAverageBitrate #method:setAverageBitrate#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetAverageBitrateMethodInfo    ,
#endif
    baseParseSetAverageBitrate              ,


-- ** setDuration #method:setDuration#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetDurationMethodInfo          ,
#endif
    baseParseSetDuration                    ,


-- ** setFrameRate #method:setFrameRate#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetFrameRateMethodInfo         ,
#endif
    baseParseSetFrameRate                   ,


-- ** setHasTimingInfo #method:setHasTimingInfo#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetHasTimingInfoMethodInfo     ,
#endif
    baseParseSetHasTimingInfo               ,


-- ** setInferTs #method:setInferTs#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetInferTsMethodInfo           ,
#endif
    baseParseSetInferTs                     ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetLatencyMethodInfo           ,
#endif
    baseParseSetLatency                     ,


-- ** setMinFrameSize #method:setMinFrameSize#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetMinFrameSizeMethodInfo      ,
#endif
    baseParseSetMinFrameSize                ,


-- ** setPassthrough #method:setPassthrough#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetPassthroughMethodInfo       ,
#endif
    baseParseSetPassthrough                 ,


-- ** setPtsInterpolation #method:setPtsInterpolation#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetPtsInterpolationMethodInfo  ,
#endif
    baseParseSetPtsInterpolation            ,


-- ** setSyncable #method:setSyncable#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetSyncableMethodInfo          ,
#endif
    baseParseSetSyncable                    ,


-- ** setTsAtOffset #method:setTsAtOffset#

#if defined(ENABLE_OVERLOADING)
    BaseParseSetTsAtOffsetMethodInfo        ,
#endif
    baseParseSetTsAtOffset                  ,




 -- * Properties
-- ** disablePassthrough #attr:disablePassthrough#
-- | If set to 'P.True', baseparse will unconditionally force parsing of the
-- incoming data. This can be required in the rare cases where the incoming
-- side-data (caps, pts, dts, ...) is not trusted by the user and wants to
-- force validation and parsing of the incoming data.
-- If set to 'P.False', decision of whether to parse the data or not is up to
-- the implementation (standard behaviour).

#if defined(ENABLE_OVERLOADING)
    BaseParseDisablePassthroughPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    baseParseDisablePassthrough             ,
#endif
    constructBaseParseDisablePassthrough    ,
    getBaseParseDisablePassthrough          ,
    setBaseParseDisablePassthrough          ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.TagList as Gst.TagList
import {-# SOURCE #-} qualified GI.GstBase.Structs.BaseParseFrame as GstBase.BaseParseFrame

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

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

foreign import ccall "gst_base_parse_get_type"
    c_gst_base_parse_get_type :: IO B.Types.GType

instance B.Types.TypedObject BaseParse where
    glibType :: IO GType
glibType = IO GType
c_gst_base_parse_get_type

instance B.Types.GObject BaseParse

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

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

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

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

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

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data BaseParseDisablePassthroughPropertyInfo
instance AttrInfo BaseParseDisablePassthroughPropertyInfo where
    type AttrAllowedOps BaseParseDisablePassthroughPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BaseParseDisablePassthroughPropertyInfo = IsBaseParse
    type AttrSetTypeConstraint BaseParseDisablePassthroughPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint BaseParseDisablePassthroughPropertyInfo = (~) Bool
    type AttrTransferType BaseParseDisablePassthroughPropertyInfo = Bool
    type AttrGetType BaseParseDisablePassthroughPropertyInfo = Bool
    type AttrLabel BaseParseDisablePassthroughPropertyInfo = "disable-passthrough"
    type AttrOrigin BaseParseDisablePassthroughPropertyInfo = BaseParse
    attrGet = getBaseParseDisablePassthrough
    attrSet = setBaseParseDisablePassthrough
    attrTransfer _ v = do
        return v
    attrConstruct = constructBaseParseDisablePassthrough
    attrClear = undefined
#endif

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

#if defined(ENABLE_OVERLOADING)
baseParseDisablePassthrough :: AttrLabelProxy "disablePassthrough"
baseParseDisablePassthrough = AttrLabelProxy

#endif

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

#endif

-- method BaseParse::add_index_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParse." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset of entry" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ts"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "timestamp associated with offset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether entry refers to keyframe"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "force"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "add entry disregarding sanity checks"
--                 , 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_parse_add_index_entry" gst_base_parse_add_index_entry :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Word64 ->                               -- offset : TBasicType TUInt64
    Word64 ->                               -- ts : TBasicType TUInt64
    CInt ->                                 -- key : TBasicType TBoolean
    CInt ->                                 -- force : TBasicType TBoolean
    IO CInt

-- | Adds an entry to the index associating /@offset@/ to /@ts@/.  It is recommended
-- to only add keyframe entries.  /@force@/ allows to bypass checks, such as
-- whether the stream is (upstream) seekable, another entry is already \"close\"
-- to the new entry, etc.
baseParseAddIndexEntry ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: t'GI.GstBase.Objects.BaseParse.BaseParse'.
    -> Word64
    -- ^ /@offset@/: offset of entry
    -> Word64
    -- ^ /@ts@/: timestamp associated with offset
    -> Bool
    -- ^ /@key@/: whether entry refers to keyframe
    -> Bool
    -- ^ /@force@/: add entry disregarding sanity checks
    -> m Bool
    -- ^ __Returns:__ t'P.Bool' indicating whether entry was added
baseParseAddIndexEntry :: a -> Word64 -> Word64 -> Bool -> Bool -> m Bool
baseParseAddIndexEntry a
parse Word64
offset Word64
ts Bool
key Bool
force = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let key' :: CInt
key' = (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
key
    let force' :: CInt
force' = (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
force
    CInt
result <- Ptr BaseParse -> Word64 -> Word64 -> CInt -> CInt -> IO CInt
gst_base_parse_add_index_entry Ptr BaseParse
parse' Word64
offset Word64
ts CInt
key' CInt
force'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BaseParseAddIndexEntryMethodInfo
instance (signature ~ (Word64 -> Word64 -> Bool -> Bool -> m Bool), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseAddIndexEntryMethodInfo a signature where
    overloadedMethod = baseParseAddIndexEntry

#endif

-- method BaseParse::convert_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParse." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstFormat describing the source format."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source value to be converted."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_format"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstFormat defining the converted format."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Pointer where the conversion result will be put."
--                 , 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_parse_convert_default" gst_base_parse_convert_default :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_value : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_value : TBasicType TInt64
    IO CInt

-- | Default implementation of t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/convert/@().
baseParseConvertDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: t'GI.GstBase.Objects.BaseParse.BaseParse'.
    -> Gst.Enums.Format
    -- ^ /@srcFormat@/: t'GI.Gst.Enums.Format' describing the source format.
    -> Int64
    -- ^ /@srcValue@/: Source value to be converted.
    -> Gst.Enums.Format
    -- ^ /@destFormat@/: t'GI.Gst.Enums.Format' defining the converted format.
    -> m ((Bool, Int64))
    -- ^ __Returns:__ 'P.True' if conversion was successful.
baseParseConvertDefault :: a -> Format -> Int64 -> Format -> m (Bool, Int64)
baseParseConvertDefault a
parse Format
srcFormat Int64
srcValue Format
destFormat = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let srcFormat' :: CUInt
srcFormat' = (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
srcFormat
    let destFormat' :: CUInt
destFormat' = (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
destFormat
    Ptr Int64
destValue <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr BaseParse -> CUInt -> Int64 -> CUInt -> Ptr Int64 -> IO CInt
gst_base_parse_convert_default Ptr BaseParse
parse' CUInt
srcFormat' Int64
srcValue CUInt
destFormat' Ptr Int64
destValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int64
destValue' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destValue
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destValue
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
destValue')

#if defined(ENABLE_OVERLOADING)
data BaseParseConvertDefaultMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseConvertDefaultMethodInfo a signature where
    overloadedMethod = baseParseConvertDefault

#endif

-- method BaseParse::drain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , 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_parse_drain" gst_base_parse_drain :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    IO ()

-- | Drains the adapter until it is empty. It decreases the min_frame_size to
-- match the current adapter size and calls chain method until the adapter
-- is emptied or chain returns with error.
-- 
-- /Since: 1.12/
baseParseDrain ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> m ()
baseParseDrain :: a -> m ()
baseParseDrain a
parse = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParse -> IO ()
gst_base_parse_drain Ptr BaseParse
parse'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseDrainMethodInfo
instance (signature ~ (m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseDrainMethodInfo a signature where
    overloadedMethod = baseParseDrain

#endif

-- method BaseParse::finish_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParseFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParseFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "consumed input data represented by frame"
--                 , 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_parse_finish_frame" gst_base_parse_finish_frame :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Ptr GstBase.BaseParseFrame.BaseParseFrame -> -- frame : TInterface (Name {namespace = "GstBase", name = "BaseParseFrame"})
    Int32 ->                                -- size : TBasicType TInt
    IO CInt

-- | Collects parsed data and pushes this downstream.
-- Source pad caps must be set when this is called.
-- 
-- If /@frame@/\'s out_buffer is set, that will be used as subsequent frame data.
-- Otherwise, /@size@/ samples will be taken from the input and used for output,
-- and the output\'s metadata (timestamps etc) will be taken as (optionally)
-- set by the subclass on /@frame@/\'s (input) buffer (which is otherwise
-- ignored for any but the above purpose\/information).
-- 
-- Note that the latter buffer is invalidated by this call, whereas the
-- caller retains ownership of /@frame@/.
baseParseFinishFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> GstBase.BaseParseFrame.BaseParseFrame
    -- ^ /@frame@/: a t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'
    -> Int32
    -- ^ /@size@/: consumed input data represented by frame
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' that should be escalated to caller (of caller)
baseParseFinishFrame :: a -> BaseParseFrame -> Int32 -> m FlowReturn
baseParseFinishFrame a
parse BaseParseFrame
frame Int32
size = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParseFrame
frame' <- BaseParseFrame -> IO (Ptr BaseParseFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseParseFrame
frame
    CInt
result <- Ptr BaseParse -> Ptr BaseParseFrame -> Int32 -> IO CInt
gst_base_parse_finish_frame Ptr BaseParse
parse' Ptr BaseParseFrame
frame' Int32
size
    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
parse
    BaseParseFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseParseFrame
frame
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data BaseParseFinishFrameMethodInfo
instance (signature ~ (GstBase.BaseParseFrame.BaseParseFrame -> Int32 -> m Gst.Enums.FlowReturn), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseFinishFrameMethodInfo a signature where
    overloadedMethod = baseParseFinishFrame

#endif

-- method BaseParse::merge_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstTagList to merge, or NULL to unset\n    previously-set tags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagMergeMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstTagMergeMode to use, usually #GST_TAG_MERGE_REPLACE"
--                 , 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_parse_merge_tags" gst_base_parse_merge_tags :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Ptr Gst.TagList.TagList ->              -- tags : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "TagMergeMode"})
    IO ()

-- | Sets the parser subclass\'s tags and how they should be merged with any
-- upstream stream tags. This will override any tags previously-set
-- with 'GI.GstBase.Objects.BaseParse.baseParseMergeTags'.
-- 
-- Note that this is provided for convenience, and the subclass is
-- not required to use this and can still do tag handling on its own.
-- 
-- /Since: 1.6/
baseParseMergeTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tags@/: a t'GI.Gst.Structs.TagList.TagList' to merge, or NULL to unset
    --     previously-set tags
    -> Gst.Enums.TagMergeMode
    -- ^ /@mode@/: the t'GI.Gst.Enums.TagMergeMode' to use, usually @/GST_TAG_MERGE_REPLACE/@
    -> m ()
baseParseMergeTags :: a -> Maybe TagList -> TagMergeMode -> m ()
baseParseMergeTags a
parse Maybe TagList
tags TagMergeMode
mode = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Maybe TagList
Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just TagList
jTags -> do
            Ptr TagList
jTags' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
jTags
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTags'
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagMergeMode -> Int) -> TagMergeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagMergeMode -> Int
forall a. Enum a => a -> Int
fromEnum) TagMergeMode
mode
    Ptr BaseParse -> Ptr TagList -> CUInt -> IO ()
gst_base_parse_merge_tags Ptr BaseParse
parse' Ptr TagList
maybeTags CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tags TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseMergeTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> Gst.Enums.TagMergeMode -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseMergeTagsMethodInfo a signature where
    overloadedMethod = baseParseMergeTags

#endif

-- method BaseParse::push_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParse." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParseFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParseFrame"
--                 , 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_parse_push_frame" gst_base_parse_push_frame :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Ptr GstBase.BaseParseFrame.BaseParseFrame -> -- frame : TInterface (Name {namespace = "GstBase", name = "BaseParseFrame"})
    IO CInt

-- | Pushes the frame\'s buffer downstream, sends any pending events and
-- does some timestamp and segment handling. Takes ownership of
-- frame\'s buffer, though caller retains ownership of /@frame@/.
-- 
-- This must be called with sinkpad STREAM_LOCK held.
baseParsePushFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: t'GI.GstBase.Objects.BaseParse.BaseParse'.
    -> GstBase.BaseParseFrame.BaseParseFrame
    -- ^ /@frame@/: a t'GI.GstBase.Structs.BaseParseFrame.BaseParseFrame'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ t'GI.Gst.Enums.FlowReturn'
baseParsePushFrame :: a -> BaseParseFrame -> m FlowReturn
baseParsePushFrame a
parse BaseParseFrame
frame = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParseFrame
frame' <- BaseParseFrame -> IO (Ptr BaseParseFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BaseParseFrame
frame
    CInt
result <- Ptr BaseParse -> Ptr BaseParseFrame -> IO CInt
gst_base_parse_push_frame Ptr BaseParse
parse' Ptr BaseParseFrame
frame'
    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
parse
    BaseParseFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BaseParseFrame
frame
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data BaseParsePushFrameMethodInfo
instance (signature ~ (GstBase.BaseParseFrame.BaseParseFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParsePushFrameMethodInfo a signature where
    overloadedMethod = baseParsePushFrame

#endif

-- method BaseParse::set_average_bitrate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParse." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bitrate"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "average bitrate in bits/second"
--                 , 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_parse_set_average_bitrate" gst_base_parse_set_average_bitrate :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Word32 ->                               -- bitrate : TBasicType TUInt
    IO ()

-- | Optionally sets the average bitrate detected in media (if non-zero),
-- e.g. based on metadata, as it will be posted to the application.
-- 
-- By default, announced average bitrate is estimated. The average bitrate
-- is used to estimate the total duration of the stream and to estimate
-- a seek position, if there\'s no index and the format is syncable
-- (see 'GI.GstBase.Objects.BaseParse.baseParseSetSyncable').
baseParseSetAverageBitrate ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: t'GI.GstBase.Objects.BaseParse.BaseParse'.
    -> Word32
    -- ^ /@bitrate@/: average bitrate in bits\/second
    -> m ()
baseParseSetAverageBitrate :: a -> Word32 -> m ()
baseParseSetAverageBitrate a
parse Word32
bitrate = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParse -> Word32 -> IO ()
gst_base_parse_set_average_bitrate Ptr BaseParse
parse' Word32
bitrate
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetAverageBitrateMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetAverageBitrateMethodInfo a signature where
    overloadedMethod = baseParseSetAverageBitrate

#endif

-- method BaseParse::set_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParse." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstFormat." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "duration value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "how often to update the duration estimate based on bitrate, or 0."
--                 , 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_parse_set_duration" gst_base_parse_set_duration :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CUInt ->                                -- fmt : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- duration : TBasicType TInt64
    Int32 ->                                -- interval : TBasicType TInt
    IO ()

-- | Sets the duration of the currently playing media. Subclass can use this
-- when it is able to determine duration and\/or notices a change in the media
-- duration.  Alternatively, if /@interval@/ is non-zero (default), then stream
-- duration is determined based on estimated bitrate, and updated every /@interval@/
-- frames.
baseParseSetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: t'GI.GstBase.Objects.BaseParse.BaseParse'.
    -> Gst.Enums.Format
    -- ^ /@fmt@/: t'GI.Gst.Enums.Format'.
    -> Int64
    -- ^ /@duration@/: duration value.
    -> Int32
    -- ^ /@interval@/: how often to update the duration estimate based on bitrate, or 0.
    -> m ()
baseParseSetDuration :: a -> Format -> Int64 -> Int32 -> m ()
baseParseSetDuration a
parse Format
fmt Int64
duration Int32
interval = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let fmt' :: CUInt
fmt' = (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
fmt
    Ptr BaseParse -> CUInt -> Int64 -> Int32 -> IO ()
gst_base_parse_set_duration Ptr BaseParse
parse' CUInt
fmt' Int64
duration Int32
interval
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetDurationMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Int32 -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetDurationMethodInfo a signature where
    overloadedMethod = baseParseSetDuration

#endif

-- method BaseParse::set_frame_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBaseParse to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_num"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "frames per second (numerator)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_den"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "frames per second (denominator)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lead_in"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "frames needed before a segment for subsequent decode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lead_out"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "frames needed after a segment"
--                 , 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_parse_set_frame_rate" gst_base_parse_set_frame_rate :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Word32 ->                               -- fps_num : TBasicType TUInt
    Word32 ->                               -- fps_den : TBasicType TUInt
    Word32 ->                               -- lead_in : TBasicType TUInt
    Word32 ->                               -- lead_out : TBasicType TUInt
    IO ()

-- | If frames per second is configured, parser can take care of buffer duration
-- and timestamping.  When performing segment clipping, or seeking to a specific
-- location, a corresponding decoder might need an initial /@leadIn@/ and a
-- following /@leadOut@/ number of frames to ensure the desired segment is
-- entirely filled upon decoding.
baseParseSetFrameRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: the t'GI.GstBase.Objects.BaseParse.BaseParse' to set
    -> Word32
    -- ^ /@fpsNum@/: frames per second (numerator).
    -> Word32
    -- ^ /@fpsDen@/: frames per second (denominator).
    -> Word32
    -- ^ /@leadIn@/: frames needed before a segment for subsequent decode
    -> Word32
    -- ^ /@leadOut@/: frames needed after a segment
    -> m ()
baseParseSetFrameRate :: a -> Word32 -> Word32 -> Word32 -> Word32 -> m ()
baseParseSetFrameRate a
parse Word32
fpsNum Word32
fpsDen Word32
leadIn Word32
leadOut = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParse -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
gst_base_parse_set_frame_rate Ptr BaseParse
parse' Word32
fpsNum Word32
fpsDen Word32
leadIn Word32
leadOut
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetFrameRateMethodInfo
instance (signature ~ (Word32 -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetFrameRateMethodInfo a signature where
    overloadedMethod = baseParseSetFrameRate

#endif

-- method BaseParse::set_has_timing_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "has_timing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether frames carry timing information"
--                 , 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_parse_set_has_timing_info" gst_base_parse_set_has_timing_info :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CInt ->                                 -- has_timing : TBasicType TBoolean
    IO ()

-- | Set if frames carry timing information which the subclass can (generally)
-- parse and provide.  In particular, intrinsic (rather than estimated) time
-- can be obtained following a seek.
baseParseSetHasTimingInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Bool
    -- ^ /@hasTiming@/: whether frames carry timing information
    -> m ()
baseParseSetHasTimingInfo :: a -> Bool -> m ()
baseParseSetHasTimingInfo a
parse Bool
hasTiming = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let hasTiming' :: CInt
hasTiming' = (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
hasTiming
    Ptr BaseParse -> CInt -> IO ()
gst_base_parse_set_has_timing_info Ptr BaseParse
parse' CInt
hasTiming'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetHasTimingInfoMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetHasTimingInfoMethodInfo a signature where
    overloadedMethod = baseParseSetHasTimingInfo

#endif

-- method BaseParse::set_infer_ts
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "infer_ts"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if parser should infer DTS/PTS from each other"
--                 , 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_parse_set_infer_ts" gst_base_parse_set_infer_ts :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CInt ->                                 -- infer_ts : TBasicType TBoolean
    IO ()

-- | By default, the base class might try to infer PTS from DTS and vice
-- versa.  While this is generally correct for audio data, it may not
-- be otherwise. Sub-classes implementing such formats should disable
-- timestamp inferring.
baseParseSetInferTs ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Bool
    -- ^ /@inferTs@/: 'P.True' if parser should infer DTS\/PTS from each other
    -> m ()
baseParseSetInferTs :: a -> Bool -> m ()
baseParseSetInferTs a
parse Bool
inferTs = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let inferTs' :: CInt
inferTs' = (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
inferTs
    Ptr BaseParse -> CInt -> IO ()
gst_base_parse_set_infer_ts Ptr BaseParse
parse' CInt
inferTs'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetInferTsMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetInferTsMethodInfo a signature where
    overloadedMethod = baseParseSetInferTs

#endif

-- method BaseParse::set_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "minimum parse latency"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "maximum parse latency"
--                 , 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_parse_set_latency" gst_base_parse_set_latency :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Word64 ->                               -- min_latency : TBasicType TUInt64
    Word64 ->                               -- max_latency : TBasicType TUInt64
    IO ()

-- | Sets the minimum and maximum (which may likely be equal) latency introduced
-- by the parsing process.  If there is such a latency, which depends on the
-- particular parsing of the format, it typically corresponds to 1 frame duration.
baseParseSetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Word64
    -- ^ /@minLatency@/: minimum parse latency
    -> Word64
    -- ^ /@maxLatency@/: maximum parse latency
    -> m ()
baseParseSetLatency :: a -> Word64 -> Word64 -> m ()
baseParseSetLatency a
parse Word64
minLatency Word64
maxLatency = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParse -> Word64 -> Word64 -> IO ()
gst_base_parse_set_latency Ptr BaseParse
parse' Word64
minLatency Word64
maxLatency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetLatencyMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetLatencyMethodInfo a signature where
    overloadedMethod = baseParseSetLatency

#endif

-- method BaseParse::set_min_frame_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstBaseParse." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Minimum size in bytes of the data that this base class should\n      give to subclass."
--                 , 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_parse_set_min_frame_size" gst_base_parse_set_min_frame_size :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Word32 ->                               -- min_size : TBasicType TUInt
    IO ()

-- | Subclass can use this function to tell the base class that it needs to
-- be given buffers of at least /@minSize@/ bytes.
baseParseSetMinFrameSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: t'GI.GstBase.Objects.BaseParse.BaseParse'.
    -> Word32
    -- ^ /@minSize@/: Minimum size in bytes of the data that this base class should
    --       give to subclass.
    -> m ()
baseParseSetMinFrameSize :: a -> Word32 -> m ()
baseParseSetMinFrameSize a
parse Word32
minSize = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParse -> Word32 -> IO ()
gst_base_parse_set_min_frame_size Ptr BaseParse
parse' Word32
minSize
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetMinFrameSizeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetMinFrameSizeMethodInfo a signature where
    overloadedMethod = baseParseSetMinFrameSize

#endif

-- method BaseParse::set_passthrough
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "passthrough"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if parser should run in passthrough 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_parse_set_passthrough" gst_base_parse_set_passthrough :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CInt ->                                 -- passthrough : TBasicType TBoolean
    IO ()

-- | Set if the nature of the format or configuration does not allow (much)
-- parsing, and the parser should operate in passthrough mode (which only
-- applies when operating in push mode). That is, incoming buffers are
-- pushed through unmodified, i.e. no t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/handle_frame/@()
-- will be invoked, but t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/pre_push_frame/@() will still be
-- invoked, so subclass can perform as much or as little is appropriate for
-- passthrough semantics in t'GI.GstBase.Structs.BaseParseClass.BaseParseClass'.@/pre_push_frame/@().
baseParseSetPassthrough ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Bool
    -- ^ /@passthrough@/: 'P.True' if parser should run in passthrough mode
    -> m ()
baseParseSetPassthrough :: a -> Bool -> m ()
baseParseSetPassthrough a
parse Bool
passthrough = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let passthrough' :: CInt
passthrough' = (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
passthrough
    Ptr BaseParse -> CInt -> IO ()
gst_base_parse_set_passthrough Ptr BaseParse
parse' CInt
passthrough'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetPassthroughMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetPassthroughMethodInfo a signature where
    overloadedMethod = baseParseSetPassthrough

#endif

-- method BaseParse::set_pts_interpolation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pts_interpolate"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if parser should interpolate PTS timestamps"
--                 , 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_parse_set_pts_interpolation" gst_base_parse_set_pts_interpolation :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CInt ->                                 -- pts_interpolate : TBasicType TBoolean
    IO ()

-- | By default, the base class will guess PTS timestamps using a simple
-- interpolation (previous timestamp + duration), which is incorrect for
-- data streams with reordering, where PTS can go backward. Sub-classes
-- implementing such formats should disable PTS interpolation.
baseParseSetPtsInterpolation ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Bool
    -- ^ /@ptsInterpolate@/: 'P.True' if parser should interpolate PTS timestamps
    -> m ()
baseParseSetPtsInterpolation :: a -> Bool -> m ()
baseParseSetPtsInterpolation a
parse Bool
ptsInterpolate = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let ptsInterpolate' :: CInt
ptsInterpolate' = (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
ptsInterpolate
    Ptr BaseParse -> CInt -> IO ()
gst_base_parse_set_pts_interpolation Ptr BaseParse
parse' CInt
ptsInterpolate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetPtsInterpolationMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetPtsInterpolationMethodInfo a signature where
    overloadedMethod = baseParseSetPtsInterpolation

#endif

-- method BaseParse::set_syncable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "syncable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "set if frame starts can be identified"
--                 , 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_parse_set_syncable" gst_base_parse_set_syncable :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    CInt ->                                 -- syncable : TBasicType TBoolean
    IO ()

-- | Set if frame starts can be identified. This is set by default and
-- determines whether seeking based on bitrate averages
-- is possible for a format\/stream.
baseParseSetSyncable ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Bool
    -- ^ /@syncable@/: set if frame starts can be identified
    -> m ()
baseParseSetSyncable :: a -> Bool -> m ()
baseParseSetSyncable a
parse Bool
syncable = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    let syncable' :: CInt
syncable' = (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
syncable
    Ptr BaseParse -> CInt -> IO ()
gst_base_parse_set_syncable Ptr BaseParse
parse' CInt
syncable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetSyncableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetSyncableMethodInfo a signature where
    overloadedMethod = baseParseSetSyncable

#endif

-- method BaseParse::set_ts_at_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parse"
--           , argType =
--               TInterface Name { namespace = "GstBase" , name = "BaseParse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBaseParse" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset into current buffer"
--                 , 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_parse_set_ts_at_offset" gst_base_parse_set_ts_at_offset :: 
    Ptr BaseParse ->                        -- parse : TInterface (Name {namespace = "GstBase", name = "BaseParse"})
    Word64 ->                               -- offset : TBasicType TUInt64
    IO ()

-- | This function should only be called from a /@handleFrame@/ implementation.
-- 
-- t'GI.GstBase.Objects.BaseParse.BaseParse' creates initial timestamps for frames by using the last
-- timestamp seen in the stream before the frame starts.  In certain
-- cases, the correct timestamps will occur in the stream after the
-- start of the frame, but before the start of the actual picture data.
-- This function can be used to set the timestamps based on the offset
-- into the frame data that the picture starts.
-- 
-- /Since: 1.2/
baseParseSetTsAtOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsBaseParse a) =>
    a
    -- ^ /@parse@/: a t'GI.GstBase.Objects.BaseParse.BaseParse'
    -> Word64
    -- ^ /@offset@/: offset into current buffer
    -> m ()
baseParseSetTsAtOffset :: a -> Word64 -> m ()
baseParseSetTsAtOffset a
parse Word64
offset = 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 BaseParse
parse' <- a -> IO (Ptr BaseParse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parse
    Ptr BaseParse -> Word64 -> IO ()
gst_base_parse_set_ts_at_offset Ptr BaseParse
parse' Word64
offset
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parse
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BaseParseSetTsAtOffsetMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsBaseParse a) => O.MethodInfo BaseParseSetTsAtOffsetMethodInfo a signature where
    overloadedMethod = baseParseSetTsAtOffset

#endif