{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This base class is for video decoders turning encoded data into raw video
-- frames.
-- 
-- The GstVideoDecoder base class and derived subclasses should cooperate as
-- follows:
-- 
-- == Configuration
-- 
--   * Initially, GstVideoDecoder calls /@start@/ when the decoder element
--     is activated, which allows the subclass to perform any global setup.
-- 
--   * GstVideoDecoder calls /@setFormat@/ to inform the subclass of caps
--     describing input video data that it is about to receive, including
--     possibly configuration data.
--     While unlikely, it might be called more than once, if changing input
--     parameters require reconfiguration.
-- 
--   * Incoming data buffers are processed as needed, described in Data
--     Processing below.
-- 
--   * GstVideoDecoder calls /@stop@/ at end of all processing.
-- 
-- == Data processing
-- 
--   * The base class gathers input data, and optionally allows subclass
--     to parse this into subsequently manageable chunks, typically
--     corresponding to and referred to as \'frames\'.
-- 
--   * Each input frame is provided in turn to the subclass\' /@handleFrame@/
--     callback.
--   * When the subclass enables the subframe mode with @gst_video_decoder_set_subframe_mode@,
--     the base class will provide to the subclass the same input frame with
--     different input buffers to the subclass /@handleFrame@/
--     callback. During this call, the subclass needs to take
--     ownership of the input_buffer as /@gstVideoCodecFrame@/.input_buffer
--     will have been changed before the next subframe buffer is received.
--     The subclass will call @gst_video_decoder_have_last_subframe@
--     when a new input frame can be created by the base class.
--     Every subframe will share the same /@gstVideoCodecFrame@/.output_buffer
--     to write the decoding result. The subclass is responsible to protect
--     its access.
-- 
--   * If codec processing results in decoded data, the subclass should call
--     /@gstVideoDecoderFinishFrame@/ to have decoded data pushed
--     downstream. In subframe mode
--     the subclass should call /@gstVideoDecoderFinishSubframe@/ until the
--     last subframe where it should call /@gstVideoDecoderFinishFrame@/.
--     The subclass can detect the last subframe using GST_VIDEO_BUFFER_FLAG_MARKER
--     on buffers or using its own logic to collect the subframes.
--     In case of decoding failure, the subclass must call
--     /@gstVideoDecoderDropFrame@/ or /@gstVideoDecoderDropSubframe@/,
--     to allow the base class to do timestamp and offset tracking, and possibly
--     to requeue the frame for a later attempt in the case of reverse playback.
-- 
-- == Shutdown phase
-- 
--   * The GstVideoDecoder class calls /@stop@/ to inform the subclass that data
--     parsing will be stopped.
-- 
-- == Additional Notes
-- 
--   * Seeking\/Flushing
-- 
--     * When the pipeline is seeked or otherwise flushed, the subclass is
--       informed via a call to its /@reset@/ callback, with the hard parameter
--       set to true. This indicates the subclass should drop any internal data
--       queues and timestamps and prepare for a fresh set of buffers to arrive
--       for parsing and decoding.
-- 
--   * End Of Stream
-- 
--     * At end-of-stream, the subclass /@parse@/ function may be called some final
--       times with the at_eos parameter set to true, indicating that the element
--       should not expect any more data to be arriving, and it should parse and
--       remaining frames and call 'GI.GstVideo.Objects.VideoDecoder.videoDecoderHaveFrame' if possible.
-- 
-- The 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 provide information about the output caps, when they are known.
-- This may be when the base class calls the subclass\' /@setFormat@/ function,
-- though it might be during decoding, before calling
-- /@gstVideoDecoderFinishFrame@/. This is done via
-- /@gstVideoDecoderSetOutputState@/
-- 
-- The subclass is also responsible for providing (presentation) timestamps
-- (likely based on corresponding input ones).  If that is not applicable
-- or possible, the base class provides limited framerate based interpolation.
-- 
-- Similarly, the base class provides some limited (legacy) seeking support
-- if specifically requested by the subclass, as full-fledged support
-- should rather be left to upstream demuxer, parser or alike.  This simple
-- approach caters for seeking and duration reporting using estimated input
-- bitrates. To enable it, a subclass should call
-- /@gstVideoDecoderSetEstimateRate@/ to enable handling of incoming
-- byte-streams.
-- 
-- The base class provides some support for reverse playback, in particular
-- in case incoming data is not packetized or upstream does not provide
-- fragments on keyframe boundaries.  However, the subclass should then be
-- prepared for the parsing and frame processing stage to occur separately
-- (in normal forward processing, the latter immediately follows the former),
-- The subclass also needs to ensure the parsing stage properly marks
-- keyframes, unless it knows the upstream elements will do so properly for
-- incoming data.
-- 
-- The bare minimum that a functional subclass needs to implement is:
-- 
--   * Provide pad templates
--   * Inform the base class of output caps via
--      /@gstVideoDecoderSetOutputState@/
-- 
--   * Parse input data, if it is not considered packetized from upstream
--      Data will be provided to /@parse@/ which should invoke
--      /@gstVideoDecoderAddToFrame@/ and /@gstVideoDecoderHaveFrame@/ to
--      separate the data belonging to each video frame.
-- 
--   * Accept data in /@handleFrame@/ and provide decoded results to
--      /@gstVideoDecoderFinishFrame@/, or call /@gstVideoDecoderDropFrame@/.

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

module GI.GstVideo.Objects.VideoDecoder
    ( 

-- * Exported types
    VideoDecoder(..)                        ,
    IsVideoDecoder                          ,
    toVideoDecoder                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [abortState]("GI.Gst.Objects.Element#g:method:abortState"), [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [addPad]("GI.Gst.Objects.Element#g:method:addPad"), [addPropertyDeepNotifyWatch]("GI.Gst.Objects.Element#g:method:addPropertyDeepNotifyWatch"), [addPropertyNotifyWatch]("GI.Gst.Objects.Element#g:method:addPropertyNotifyWatch"), [addToFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:addToFrame"), [allocateOutputBuffer]("GI.GstVideo.Objects.VideoDecoder#g:method:allocateOutputBuffer"), [allocateOutputFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:allocateOutputFrame"), [allocateOutputFrameWithParams]("GI.GstVideo.Objects.VideoDecoder#g:method:allocateOutputFrameWithParams"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [callAsync]("GI.Gst.Objects.Element#g:method:callAsync"), [changeState]("GI.Gst.Objects.Element#g:method:changeState"), [continueState]("GI.Gst.Objects.Element#g:method:continueState"), [createAllPads]("GI.Gst.Objects.Element#g:method:createAllPads"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [dropFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:dropFrame"), [dropSubframe]("GI.GstVideo.Objects.VideoDecoder#g:method:dropSubframe"), [finishFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:finishFrame"), [finishSubframe]("GI.GstVideo.Objects.VideoDecoder#g:method:finishSubframe"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreachPad]("GI.Gst.Objects.Element#g:method:foreachPad"), [foreachSinkPad]("GI.Gst.Objects.Element#g:method:foreachSinkPad"), [foreachSrcPad]("GI.Gst.Objects.Element#g:method:foreachSrcPad"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [haveFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:haveFrame"), [haveLastSubframe]("GI.GstVideo.Objects.VideoDecoder#g:method:haveLastSubframe"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLockedState]("GI.Gst.Objects.Element#g:method:isLockedState"), [iteratePads]("GI.Gst.Objects.Element#g:method:iteratePads"), [iterateSinkPads]("GI.Gst.Objects.Element#g:method:iterateSinkPads"), [iterateSrcPads]("GI.Gst.Objects.Element#g:method:iterateSrcPads"), [link]("GI.Gst.Objects.Element#g:method:link"), [linkFiltered]("GI.Gst.Objects.Element#g:method:linkFiltered"), [linkPads]("GI.Gst.Objects.Element#g:method:linkPads"), [linkPadsFiltered]("GI.Gst.Objects.Element#g:method:linkPadsFiltered"), [linkPadsFull]("GI.Gst.Objects.Element#g:method:linkPadsFull"), [lostState]("GI.Gst.Objects.Element#g:method:lostState"), [mergeTags]("GI.GstVideo.Objects.VideoDecoder#g:method:mergeTags"), [messageFull]("GI.Gst.Objects.Element#g:method:messageFull"), [messageFullWithDetails]("GI.Gst.Objects.Element#g:method:messageFullWithDetails"), [negotiate]("GI.GstVideo.Objects.VideoDecoder#g:method:negotiate"), [noMorePads]("GI.Gst.Objects.Element#g:method:noMorePads"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [postMessage]("GI.Gst.Objects.Element#g:method:postMessage"), [provideClock]("GI.Gst.Objects.Element#g:method:provideClock"), [proxyGetcaps]("GI.GstVideo.Objects.VideoDecoder#g:method:proxyGetcaps"), [query]("GI.Gst.Objects.Element#g:method:query"), [queryConvert]("GI.Gst.Objects.Element#g:method:queryConvert"), [queryDuration]("GI.Gst.Objects.Element#g:method:queryDuration"), [queryPosition]("GI.Gst.Objects.Element#g:method:queryPosition"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [releaseFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:releaseFrame"), [releaseRequestPad]("GI.Gst.Objects.Element#g:method:releaseRequestPad"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [removePad]("GI.Gst.Objects.Element#g:method:removePad"), [removePropertyNotifyWatch]("GI.Gst.Objects.Element#g:method:removePropertyNotifyWatch"), [requestPad]("GI.Gst.Objects.Element#g:method:requestPad"), [requestPadSimple]("GI.Gst.Objects.Element#g:method:requestPadSimple"), [requestSyncPoint]("GI.GstVideo.Objects.VideoDecoder#g:method:requestSyncPoint"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [seek]("GI.Gst.Objects.Element#g:method:seek"), [seekSimple]("GI.Gst.Objects.Element#g:method:seekSimple"), [sendEvent]("GI.Gst.Objects.Element#g:method:sendEvent"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncStateWithParent]("GI.Gst.Objects.Element#g:method:syncStateWithParent"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unlink]("GI.Gst.Objects.Element#g:method:unlink"), [unlinkPads]("GI.Gst.Objects.Element#g:method:unlinkPads"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAllocator]("GI.GstVideo.Objects.VideoDecoder#g:method:getAllocator"), [getBaseTime]("GI.Gst.Objects.Element#g:method:getBaseTime"), [getBufferPool]("GI.GstVideo.Objects.VideoDecoder#g:method:getBufferPool"), [getBus]("GI.Gst.Objects.Element#g:method:getBus"), [getClock]("GI.Gst.Objects.Element#g:method:getClock"), [getCompatiblePad]("GI.Gst.Objects.Element#g:method:getCompatiblePad"), [getCompatiblePadTemplate]("GI.Gst.Objects.Element#g:method:getCompatiblePadTemplate"), [getContext]("GI.Gst.Objects.Element#g:method:getContext"), [getContextUnlocked]("GI.Gst.Objects.Element#g:method:getContextUnlocked"), [getContexts]("GI.Gst.Objects.Element#g:method:getContexts"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getCurrentClockTime]("GI.Gst.Objects.Element#g:method:getCurrentClockTime"), [getCurrentRunningTime]("GI.Gst.Objects.Element#g:method:getCurrentRunningTime"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEstimateRate]("GI.GstVideo.Objects.VideoDecoder#g:method:getEstimateRate"), [getFactory]("GI.Gst.Objects.Element#g:method:getFactory"), [getFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:getFrame"), [getFrames]("GI.GstVideo.Objects.VideoDecoder#g:method:getFrames"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getInputSubframeIndex]("GI.GstVideo.Objects.VideoDecoder#g:method:getInputSubframeIndex"), [getLatency]("GI.GstVideo.Objects.VideoDecoder#g:method:getLatency"), [getMaxDecodeTime]("GI.GstVideo.Objects.VideoDecoder#g:method:getMaxDecodeTime"), [getMaxErrors]("GI.GstVideo.Objects.VideoDecoder#g:method:getMaxErrors"), [getMetadata]("GI.Gst.Objects.Element#g:method:getMetadata"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getNeedsFormat]("GI.GstVideo.Objects.VideoDecoder#g:method:getNeedsFormat"), [getNeedsSyncPoint]("GI.GstVideo.Objects.VideoDecoder#g:method:getNeedsSyncPoint"), [getOldestFrame]("GI.GstVideo.Objects.VideoDecoder#g:method:getOldestFrame"), [getOutputState]("GI.GstVideo.Objects.VideoDecoder#g:method:getOutputState"), [getPacketized]("GI.GstVideo.Objects.VideoDecoder#g:method:getPacketized"), [getPadTemplate]("GI.Gst.Objects.Element#g:method:getPadTemplate"), [getPadTemplateList]("GI.Gst.Objects.Element#g:method:getPadTemplateList"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getPendingFrameSize]("GI.GstVideo.Objects.VideoDecoder#g:method:getPendingFrameSize"), [getProcessedSubframeIndex]("GI.GstVideo.Objects.VideoDecoder#g:method:getProcessedSubframeIndex"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getQosProportion]("GI.GstVideo.Objects.VideoDecoder#g:method:getQosProportion"), [getRequestPad]("GI.Gst.Objects.Element#g:method:getRequestPad"), [getStartTime]("GI.Gst.Objects.Element#g:method:getStartTime"), [getState]("GI.Gst.Objects.Element#g:method:getState"), [getStaticPad]("GI.Gst.Objects.Element#g:method:getStaticPad"), [getSubframeMode]("GI.GstVideo.Objects.VideoDecoder#g:method:getSubframeMode"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setBaseTime]("GI.Gst.Objects.Element#g:method:setBaseTime"), [setBus]("GI.Gst.Objects.Element#g:method:setBus"), [setClock]("GI.Gst.Objects.Element#g:method:setClock"), [setContext]("GI.Gst.Objects.Element#g:method:setContext"), [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEstimateRate]("GI.GstVideo.Objects.VideoDecoder#g:method:setEstimateRate"), [setInterlacedOutputState]("GI.GstVideo.Objects.VideoDecoder#g:method:setInterlacedOutputState"), [setLatency]("GI.GstVideo.Objects.VideoDecoder#g:method:setLatency"), [setLockedState]("GI.Gst.Objects.Element#g:method:setLockedState"), [setMaxErrors]("GI.GstVideo.Objects.VideoDecoder#g:method:setMaxErrors"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setNeedsFormat]("GI.GstVideo.Objects.VideoDecoder#g:method:setNeedsFormat"), [setNeedsSyncPoint]("GI.GstVideo.Objects.VideoDecoder#g:method:setNeedsSyncPoint"), [setOutputState]("GI.GstVideo.Objects.VideoDecoder#g:method:setOutputState"), [setPacketized]("GI.GstVideo.Objects.VideoDecoder#g:method:setPacketized"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStartTime]("GI.Gst.Objects.Element#g:method:setStartTime"), [setState]("GI.Gst.Objects.Element#g:method:setState"), [setSubframeMode]("GI.GstVideo.Objects.VideoDecoder#g:method:setSubframeMode"), [setUseDefaultPadAcceptcaps]("GI.GstVideo.Objects.VideoDecoder#g:method:setUseDefaultPadAcceptcaps").

#if defined(ENABLE_OVERLOADING)
    ResolveVideoDecoderMethod               ,
#endif

-- ** addToFrame #method:addToFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderAddToFrameMethodInfo        ,
#endif
    videoDecoderAddToFrame                  ,


-- ** allocateOutputBuffer #method:allocateOutputBuffer#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderAllocateOutputBufferMethodInfo,
#endif
    videoDecoderAllocateOutputBuffer        ,


-- ** allocateOutputFrame #method:allocateOutputFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderAllocateOutputFrameMethodInfo,
#endif
    videoDecoderAllocateOutputFrame         ,


-- ** allocateOutputFrameWithParams #method:allocateOutputFrameWithParams#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderAllocateOutputFrameWithParamsMethodInfo,
#endif
    videoDecoderAllocateOutputFrameWithParams,


-- ** dropFrame #method:dropFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderDropFrameMethodInfo         ,
#endif
    videoDecoderDropFrame                   ,


-- ** dropSubframe #method:dropSubframe#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderDropSubframeMethodInfo      ,
#endif
    videoDecoderDropSubframe                ,


-- ** finishFrame #method:finishFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderFinishFrameMethodInfo       ,
#endif
    videoDecoderFinishFrame                 ,


-- ** finishSubframe #method:finishSubframe#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderFinishSubframeMethodInfo    ,
#endif
    videoDecoderFinishSubframe              ,


-- ** getAllocator #method:getAllocator#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetAllocatorMethodInfo      ,
#endif
    videoDecoderGetAllocator                ,


-- ** getBufferPool #method:getBufferPool#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetBufferPoolMethodInfo     ,
#endif
    videoDecoderGetBufferPool               ,


-- ** getEstimateRate #method:getEstimateRate#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetEstimateRateMethodInfo   ,
#endif
    videoDecoderGetEstimateRate             ,


-- ** getFrame #method:getFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetFrameMethodInfo          ,
#endif
    videoDecoderGetFrame                    ,


-- ** getFrames #method:getFrames#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetFramesMethodInfo         ,
#endif
    videoDecoderGetFrames                   ,


-- ** getInputSubframeIndex #method:getInputSubframeIndex#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetInputSubframeIndexMethodInfo,
#endif
    videoDecoderGetInputSubframeIndex       ,


-- ** getLatency #method:getLatency#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetLatencyMethodInfo        ,
#endif
    videoDecoderGetLatency                  ,


-- ** getMaxDecodeTime #method:getMaxDecodeTime#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetMaxDecodeTimeMethodInfo  ,
#endif
    videoDecoderGetMaxDecodeTime            ,


-- ** getMaxErrors #method:getMaxErrors#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetMaxErrorsMethodInfo      ,
#endif
    videoDecoderGetMaxErrors                ,


-- ** getNeedsFormat #method:getNeedsFormat#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetNeedsFormatMethodInfo    ,
#endif
    videoDecoderGetNeedsFormat              ,


-- ** getNeedsSyncPoint #method:getNeedsSyncPoint#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetNeedsSyncPointMethodInfo ,
#endif
    videoDecoderGetNeedsSyncPoint           ,


-- ** getOldestFrame #method:getOldestFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetOldestFrameMethodInfo    ,
#endif
    videoDecoderGetOldestFrame              ,


-- ** getOutputState #method:getOutputState#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetOutputStateMethodInfo    ,
#endif
    videoDecoderGetOutputState              ,


-- ** getPacketized #method:getPacketized#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetPacketizedMethodInfo     ,
#endif
    videoDecoderGetPacketized               ,


-- ** getPendingFrameSize #method:getPendingFrameSize#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetPendingFrameSizeMethodInfo,
#endif
    videoDecoderGetPendingFrameSize         ,


-- ** getProcessedSubframeIndex #method:getProcessedSubframeIndex#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetProcessedSubframeIndexMethodInfo,
#endif
    videoDecoderGetProcessedSubframeIndex   ,


-- ** getQosProportion #method:getQosProportion#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetQosProportionMethodInfo  ,
#endif
    videoDecoderGetQosProportion            ,


-- ** getSubframeMode #method:getSubframeMode#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderGetSubframeModeMethodInfo   ,
#endif
    videoDecoderGetSubframeMode             ,


-- ** haveFrame #method:haveFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderHaveFrameMethodInfo         ,
#endif
    videoDecoderHaveFrame                   ,


-- ** haveLastSubframe #method:haveLastSubframe#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderHaveLastSubframeMethodInfo  ,
#endif
    videoDecoderHaveLastSubframe            ,


-- ** mergeTags #method:mergeTags#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderMergeTagsMethodInfo         ,
#endif
    videoDecoderMergeTags                   ,


-- ** negotiate #method:negotiate#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderNegotiateMethodInfo         ,
#endif
    videoDecoderNegotiate                   ,


-- ** proxyGetcaps #method:proxyGetcaps#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderProxyGetcapsMethodInfo      ,
#endif
    videoDecoderProxyGetcaps                ,


-- ** releaseFrame #method:releaseFrame#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderReleaseFrameMethodInfo      ,
#endif
    videoDecoderReleaseFrame                ,


-- ** requestSyncPoint #method:requestSyncPoint#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderRequestSyncPointMethodInfo  ,
#endif
    videoDecoderRequestSyncPoint            ,


-- ** setEstimateRate #method:setEstimateRate#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetEstimateRateMethodInfo   ,
#endif
    videoDecoderSetEstimateRate             ,


-- ** setInterlacedOutputState #method:setInterlacedOutputState#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetInterlacedOutputStateMethodInfo,
#endif
    videoDecoderSetInterlacedOutputState    ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetLatencyMethodInfo        ,
#endif
    videoDecoderSetLatency                  ,


-- ** setMaxErrors #method:setMaxErrors#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetMaxErrorsMethodInfo      ,
#endif
    videoDecoderSetMaxErrors                ,


-- ** setNeedsFormat #method:setNeedsFormat#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetNeedsFormatMethodInfo    ,
#endif
    videoDecoderSetNeedsFormat              ,


-- ** setNeedsSyncPoint #method:setNeedsSyncPoint#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetNeedsSyncPointMethodInfo ,
#endif
    videoDecoderSetNeedsSyncPoint           ,


-- ** setOutputState #method:setOutputState#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetOutputStateMethodInfo    ,
#endif
    videoDecoderSetOutputState              ,


-- ** setPacketized #method:setPacketized#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetPacketizedMethodInfo     ,
#endif
    videoDecoderSetPacketized               ,


-- ** setSubframeMode #method:setSubframeMode#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetSubframeModeMethodInfo   ,
#endif
    videoDecoderSetSubframeMode             ,


-- ** setUseDefaultPadAcceptcaps #method:setUseDefaultPadAcceptcaps#

#if defined(ENABLE_OVERLOADING)
    VideoDecoderSetUseDefaultPadAcceptcapsMethodInfo,
#endif
    videoDecoderSetUseDefaultPadAcceptcaps  ,




 -- * Properties


-- ** automaticRequestSyncPointFlags #attr:automaticRequestSyncPointFlags#
-- | GstVideoDecoderRequestSyncPointFlags to use for the automatically
-- requested sync points if @automatic-request-sync-points@ is enabled.
-- 
-- /Since: 1.20/

#if defined(ENABLE_OVERLOADING)
    VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo,
#endif
    constructVideoDecoderAutomaticRequestSyncPointFlags,
    getVideoDecoderAutomaticRequestSyncPointFlags,
    setVideoDecoderAutomaticRequestSyncPointFlags,
#if defined(ENABLE_OVERLOADING)
    videoDecoderAutomaticRequestSyncPointFlags,
#endif


-- ** automaticRequestSyncPoints #attr:automaticRequestSyncPoints#
-- | If set to 'P.True' the decoder will automatically request sync points when
-- it seems like a good idea, e.g. if the first frames are not key frames or
-- if packet loss was reported by upstream.
-- 
-- /Since: 1.20/

#if defined(ENABLE_OVERLOADING)
    VideoDecoderAutomaticRequestSyncPointsPropertyInfo,
#endif
    constructVideoDecoderAutomaticRequestSyncPoints,
    getVideoDecoderAutomaticRequestSyncPoints,
    setVideoDecoderAutomaticRequestSyncPoints,
#if defined(ENABLE_OVERLOADING)
    videoDecoderAutomaticRequestSyncPoints  ,
#endif


-- ** discardCorruptedFrames #attr:discardCorruptedFrames#
-- | If set to 'P.True' the decoder will discard frames that are marked as
-- corrupted instead of outputting them.
-- 
-- /Since: 1.20/

#if defined(ENABLE_OVERLOADING)
    VideoDecoderDiscardCorruptedFramesPropertyInfo,
#endif
    constructVideoDecoderDiscardCorruptedFrames,
    getVideoDecoderDiscardCorruptedFrames   ,
    setVideoDecoderDiscardCorruptedFrames   ,
#if defined(ENABLE_OVERLOADING)
    videoDecoderDiscardCorruptedFrames      ,
#endif


-- ** maxErrors #attr:maxErrors#
-- | Maximum number of tolerated consecutive decode errors. See
-- 'GI.GstVideo.Objects.VideoDecoder.videoDecoderSetMaxErrors' for more details.
-- 
-- /Since: 1.18/

#if defined(ENABLE_OVERLOADING)
    VideoDecoderMaxErrorsPropertyInfo       ,
#endif
    constructVideoDecoderMaxErrors          ,
    getVideoDecoderMaxErrors                ,
    setVideoDecoderMaxErrors                ,
#if defined(ENABLE_OVERLOADING)
    videoDecoderMaxErrors                   ,
#endif


-- ** minForceKeyUnitInterval #attr:minForceKeyUnitInterval#
-- | Minimum interval between force-key-unit events sent upstream by the
-- decoder. Setting this to 0 will cause every event to be handled, setting
-- this to 'GI.Gst.Constants.CLOCK_TIME_NONE' will cause every event to be ignored.
-- 
-- See 'GI.GstVideo.Functions.videoEventNewUpstreamForceKeyUnit' for more details about
-- force-key-unit events.
-- 
-- /Since: 1.20/

#if defined(ENABLE_OVERLOADING)
    VideoDecoderMinForceKeyUnitIntervalPropertyInfo,
#endif
    constructVideoDecoderMinForceKeyUnitInterval,
    getVideoDecoderMinForceKeyUnitInterval  ,
    setVideoDecoderMinForceKeyUnitInterval  ,
#if defined(ENABLE_OVERLOADING)
    videoDecoderMinForceKeyUnitInterval     ,
#endif


-- ** qos #attr:qos#
-- | If set to 'P.True' the decoder will handle QoS events received
-- from downstream elements.
-- This includes dropping output frames which are detected as late
-- using the metrics reported by those events.
-- 
-- /Since: 1.18/

#if defined(ENABLE_OVERLOADING)
    VideoDecoderQosPropertyInfo             ,
#endif
    constructVideoDecoderQos                ,
    getVideoDecoderQos                      ,
    setVideoDecoderQos                      ,
#if defined(ENABLE_OVERLOADING)
    videoDecoderQos                         ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.Objects.Allocator as Gst.Allocator
import qualified GI.Gst.Objects.BufferPool as Gst.BufferPool
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.AllocationParams as Gst.AllocationParams
import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import qualified GI.Gst.Structs.BufferPoolAcquireParams as Gst.BufferPoolAcquireParams
import qualified GI.Gst.Structs.Caps as Gst.Caps
import qualified GI.Gst.Structs.TagList as Gst.TagList
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoCodecFrame as GstVideo.VideoCodecFrame
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoCodecState as GstVideo.VideoCodecState

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

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

foreign import ccall "gst_video_decoder_get_type"
    c_gst_video_decoder_get_type :: IO B.Types.GType

instance B.Types.TypedObject VideoDecoder where
    glibType :: IO GType
glibType = IO GType
c_gst_video_decoder_get_type

instance B.Types.GObject VideoDecoder

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

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

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

-- | Convert 'VideoDecoder' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe VideoDecoder) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_video_decoder_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VideoDecoder -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VideoDecoder
P.Nothing = Ptr GValue -> Ptr VideoDecoder -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr VideoDecoder
forall a. Ptr a
FP.nullPtr :: FP.Ptr VideoDecoder)
    gvalueSet_ Ptr GValue
gv (P.Just VideoDecoder
obj) = VideoDecoder -> (Ptr VideoDecoder -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoDecoder
obj (Ptr GValue -> Ptr VideoDecoder -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VideoDecoder)
gvalueGet_ Ptr GValue
gv = do
        Ptr VideoDecoder
ptr <- Ptr GValue -> IO (Ptr VideoDecoder)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr VideoDecoder)
        if Ptr VideoDecoder
ptr Ptr VideoDecoder -> Ptr VideoDecoder -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VideoDecoder
forall a. Ptr a
FP.nullPtr
        then VideoDecoder -> Maybe VideoDecoder
forall a. a -> Maybe a
P.Just (VideoDecoder -> Maybe VideoDecoder)
-> IO VideoDecoder -> IO (Maybe VideoDecoder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VideoDecoder -> VideoDecoder)
-> Ptr VideoDecoder -> IO VideoDecoder
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VideoDecoder -> VideoDecoder
VideoDecoder Ptr VideoDecoder
ptr
        else Maybe VideoDecoder -> IO (Maybe VideoDecoder)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoDecoder
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoDecoderMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVideoDecoderMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveVideoDecoderMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveVideoDecoderMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveVideoDecoderMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveVideoDecoderMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveVideoDecoderMethod "addToFrame" o = VideoDecoderAddToFrameMethodInfo
    ResolveVideoDecoderMethod "allocateOutputBuffer" o = VideoDecoderAllocateOutputBufferMethodInfo
    ResolveVideoDecoderMethod "allocateOutputFrame" o = VideoDecoderAllocateOutputFrameMethodInfo
    ResolveVideoDecoderMethod "allocateOutputFrameWithParams" o = VideoDecoderAllocateOutputFrameWithParamsMethodInfo
    ResolveVideoDecoderMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVideoDecoderMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVideoDecoderMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveVideoDecoderMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveVideoDecoderMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveVideoDecoderMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveVideoDecoderMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveVideoDecoderMethod "dropFrame" o = VideoDecoderDropFrameMethodInfo
    ResolveVideoDecoderMethod "dropSubframe" o = VideoDecoderDropSubframeMethodInfo
    ResolveVideoDecoderMethod "finishFrame" o = VideoDecoderFinishFrameMethodInfo
    ResolveVideoDecoderMethod "finishSubframe" o = VideoDecoderFinishSubframeMethodInfo
    ResolveVideoDecoderMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVideoDecoderMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveVideoDecoderMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveVideoDecoderMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveVideoDecoderMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVideoDecoderMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVideoDecoderMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveVideoDecoderMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveVideoDecoderMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveVideoDecoderMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveVideoDecoderMethod "haveFrame" o = VideoDecoderHaveFrameMethodInfo
    ResolveVideoDecoderMethod "haveLastSubframe" o = VideoDecoderHaveLastSubframeMethodInfo
    ResolveVideoDecoderMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVideoDecoderMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveVideoDecoderMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveVideoDecoderMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveVideoDecoderMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveVideoDecoderMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveVideoDecoderMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveVideoDecoderMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveVideoDecoderMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveVideoDecoderMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveVideoDecoderMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveVideoDecoderMethod "mergeTags" o = VideoDecoderMergeTagsMethodInfo
    ResolveVideoDecoderMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveVideoDecoderMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveVideoDecoderMethod "negotiate" o = VideoDecoderNegotiateMethodInfo
    ResolveVideoDecoderMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveVideoDecoderMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVideoDecoderMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVideoDecoderMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveVideoDecoderMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveVideoDecoderMethod "proxyGetcaps" o = VideoDecoderProxyGetcapsMethodInfo
    ResolveVideoDecoderMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveVideoDecoderMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveVideoDecoderMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveVideoDecoderMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveVideoDecoderMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveVideoDecoderMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVideoDecoderMethod "releaseFrame" o = VideoDecoderReleaseFrameMethodInfo
    ResolveVideoDecoderMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveVideoDecoderMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveVideoDecoderMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveVideoDecoderMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveVideoDecoderMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveVideoDecoderMethod "requestPadSimple" o = Gst.Element.ElementRequestPadSimpleMethodInfo
    ResolveVideoDecoderMethod "requestSyncPoint" o = VideoDecoderRequestSyncPointMethodInfo
    ResolveVideoDecoderMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVideoDecoderMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveVideoDecoderMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveVideoDecoderMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveVideoDecoderMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVideoDecoderMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVideoDecoderMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveVideoDecoderMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveVideoDecoderMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveVideoDecoderMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVideoDecoderMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveVideoDecoderMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveVideoDecoderMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveVideoDecoderMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveVideoDecoderMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVideoDecoderMethod "getAllocator" o = VideoDecoderGetAllocatorMethodInfo
    ResolveVideoDecoderMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveVideoDecoderMethod "getBufferPool" o = VideoDecoderGetBufferPoolMethodInfo
    ResolveVideoDecoderMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveVideoDecoderMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveVideoDecoderMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveVideoDecoderMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveVideoDecoderMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveVideoDecoderMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveVideoDecoderMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveVideoDecoderMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveVideoDecoderMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveVideoDecoderMethod "getCurrentClockTime" o = Gst.Element.ElementGetCurrentClockTimeMethodInfo
    ResolveVideoDecoderMethod "getCurrentRunningTime" o = Gst.Element.ElementGetCurrentRunningTimeMethodInfo
    ResolveVideoDecoderMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVideoDecoderMethod "getEstimateRate" o = VideoDecoderGetEstimateRateMethodInfo
    ResolveVideoDecoderMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveVideoDecoderMethod "getFrame" o = VideoDecoderGetFrameMethodInfo
    ResolveVideoDecoderMethod "getFrames" o = VideoDecoderGetFramesMethodInfo
    ResolveVideoDecoderMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveVideoDecoderMethod "getInputSubframeIndex" o = VideoDecoderGetInputSubframeIndexMethodInfo
    ResolveVideoDecoderMethod "getLatency" o = VideoDecoderGetLatencyMethodInfo
    ResolveVideoDecoderMethod "getMaxDecodeTime" o = VideoDecoderGetMaxDecodeTimeMethodInfo
    ResolveVideoDecoderMethod "getMaxErrors" o = VideoDecoderGetMaxErrorsMethodInfo
    ResolveVideoDecoderMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveVideoDecoderMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveVideoDecoderMethod "getNeedsFormat" o = VideoDecoderGetNeedsFormatMethodInfo
    ResolveVideoDecoderMethod "getNeedsSyncPoint" o = VideoDecoderGetNeedsSyncPointMethodInfo
    ResolveVideoDecoderMethod "getOldestFrame" o = VideoDecoderGetOldestFrameMethodInfo
    ResolveVideoDecoderMethod "getOutputState" o = VideoDecoderGetOutputStateMethodInfo
    ResolveVideoDecoderMethod "getPacketized" o = VideoDecoderGetPacketizedMethodInfo
    ResolveVideoDecoderMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveVideoDecoderMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveVideoDecoderMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveVideoDecoderMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveVideoDecoderMethod "getPendingFrameSize" o = VideoDecoderGetPendingFrameSizeMethodInfo
    ResolveVideoDecoderMethod "getProcessedSubframeIndex" o = VideoDecoderGetProcessedSubframeIndexMethodInfo
    ResolveVideoDecoderMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVideoDecoderMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVideoDecoderMethod "getQosProportion" o = VideoDecoderGetQosProportionMethodInfo
    ResolveVideoDecoderMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveVideoDecoderMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveVideoDecoderMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveVideoDecoderMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveVideoDecoderMethod "getSubframeMode" o = VideoDecoderGetSubframeModeMethodInfo
    ResolveVideoDecoderMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveVideoDecoderMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveVideoDecoderMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveVideoDecoderMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveVideoDecoderMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveVideoDecoderMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveVideoDecoderMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveVideoDecoderMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveVideoDecoderMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVideoDecoderMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVideoDecoderMethod "setEstimateRate" o = VideoDecoderSetEstimateRateMethodInfo
    ResolveVideoDecoderMethod "setInterlacedOutputState" o = VideoDecoderSetInterlacedOutputStateMethodInfo
    ResolveVideoDecoderMethod "setLatency" o = VideoDecoderSetLatencyMethodInfo
    ResolveVideoDecoderMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveVideoDecoderMethod "setMaxErrors" o = VideoDecoderSetMaxErrorsMethodInfo
    ResolveVideoDecoderMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveVideoDecoderMethod "setNeedsFormat" o = VideoDecoderSetNeedsFormatMethodInfo
    ResolveVideoDecoderMethod "setNeedsSyncPoint" o = VideoDecoderSetNeedsSyncPointMethodInfo
    ResolveVideoDecoderMethod "setOutputState" o = VideoDecoderSetOutputStateMethodInfo
    ResolveVideoDecoderMethod "setPacketized" o = VideoDecoderSetPacketizedMethodInfo
    ResolveVideoDecoderMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveVideoDecoderMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVideoDecoderMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveVideoDecoderMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveVideoDecoderMethod "setSubframeMode" o = VideoDecoderSetSubframeModeMethodInfo
    ResolveVideoDecoderMethod "setUseDefaultPadAcceptcaps" o = VideoDecoderSetUseDefaultPadAcceptcapsMethodInfo
    ResolveVideoDecoderMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveVideoDecoderMethod t VideoDecoder, O.OverloadedMethod info VideoDecoder p, R.HasField t VideoDecoder p) => R.HasField t VideoDecoder p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveVideoDecoderMethod t VideoDecoder, O.OverloadedMethodInfo info VideoDecoder) => OL.IsLabel t (O.MethodProxy info VideoDecoder) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "automatic-request-sync-point-flags"
   -- Type: TInterface (Name {namespace = "GstVideo", name = "VideoDecoderRequestSyncPointFlags"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@automatic-request-sync-point-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoDecoder #automaticRequestSyncPointFlags
-- @
getVideoDecoderAutomaticRequestSyncPointFlags :: (MonadIO m, IsVideoDecoder o) => o -> m [GstVideo.Flags.VideoDecoderRequestSyncPointFlags]
getVideoDecoderAutomaticRequestSyncPointFlags :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> m [VideoDecoderRequestSyncPointFlags]
getVideoDecoderAutomaticRequestSyncPointFlags o
obj = IO [VideoDecoderRequestSyncPointFlags]
-> m [VideoDecoderRequestSyncPointFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [VideoDecoderRequestSyncPointFlags]
 -> m [VideoDecoderRequestSyncPointFlags])
-> IO [VideoDecoderRequestSyncPointFlags]
-> m [VideoDecoderRequestSyncPointFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [VideoDecoderRequestSyncPointFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"automatic-request-sync-point-flags"

-- | Set the value of the “@automatic-request-sync-point-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoDecoder [ #automaticRequestSyncPointFlags 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoDecoderAutomaticRequestSyncPointFlags :: (MonadIO m, IsVideoDecoder o) => o -> [GstVideo.Flags.VideoDecoderRequestSyncPointFlags] -> m ()
setVideoDecoderAutomaticRequestSyncPointFlags :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> [VideoDecoderRequestSyncPointFlags] -> m ()
setVideoDecoderAutomaticRequestSyncPointFlags o
obj [VideoDecoderRequestSyncPointFlags]
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [VideoDecoderRequestSyncPointFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"automatic-request-sync-point-flags" [VideoDecoderRequestSyncPointFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@automatic-request-sync-point-flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVideoDecoderAutomaticRequestSyncPointFlags :: (IsVideoDecoder o, MIO.MonadIO m) => [GstVideo.Flags.VideoDecoderRequestSyncPointFlags] -> m (GValueConstruct o)
constructVideoDecoderAutomaticRequestSyncPointFlags :: forall o (m :: * -> *).
(IsVideoDecoder o, MonadIO m) =>
[VideoDecoderRequestSyncPointFlags] -> m (GValueConstruct o)
constructVideoDecoderAutomaticRequestSyncPointFlags [VideoDecoderRequestSyncPointFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String
-> [VideoDecoderRequestSyncPointFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"automatic-request-sync-point-flags" [VideoDecoderRequestSyncPointFlags]
val

#if defined(ENABLE_OVERLOADING)
data VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo
instance AttrInfo VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo where
    type AttrAllowedOps VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = IsVideoDecoder
    type AttrSetTypeConstraint VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = (~) [GstVideo.Flags.VideoDecoderRequestSyncPointFlags]
    type AttrTransferTypeConstraint VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = (~) [GstVideo.Flags.VideoDecoderRequestSyncPointFlags]
    type AttrTransferType VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = [GstVideo.Flags.VideoDecoderRequestSyncPointFlags]
    type AttrGetType VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = [GstVideo.Flags.VideoDecoderRequestSyncPointFlags]
    type AttrLabel VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = "automatic-request-sync-point-flags"
    type AttrOrigin VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo = VideoDecoder
    attrGet = getVideoDecoderAutomaticRequestSyncPointFlags
    attrSet = setVideoDecoderAutomaticRequestSyncPointFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoDecoderAutomaticRequestSyncPointFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.automaticRequestSyncPointFlags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#g:attr:automaticRequestSyncPointFlags"
        })
#endif

-- VVV Prop "automatic-request-sync-points"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@automatic-request-sync-points@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoDecoder #automaticRequestSyncPoints
-- @
getVideoDecoderAutomaticRequestSyncPoints :: (MonadIO m, IsVideoDecoder o) => o -> m Bool
getVideoDecoderAutomaticRequestSyncPoints :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> m Bool
getVideoDecoderAutomaticRequestSyncPoints o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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
"automatic-request-sync-points"

-- | Set the value of the “@automatic-request-sync-points@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoDecoder [ #automaticRequestSyncPoints 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoDecoderAutomaticRequestSyncPoints :: (MonadIO m, IsVideoDecoder o) => o -> Bool -> m ()
setVideoDecoderAutomaticRequestSyncPoints :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> Bool -> m ()
setVideoDecoderAutomaticRequestSyncPoints o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"automatic-request-sync-points" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@automatic-request-sync-points@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVideoDecoderAutomaticRequestSyncPoints :: (IsVideoDecoder o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructVideoDecoderAutomaticRequestSyncPoints :: forall o (m :: * -> *).
(IsVideoDecoder o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructVideoDecoderAutomaticRequestSyncPoints Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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
"automatic-request-sync-points" Bool
val

#if defined(ENABLE_OVERLOADING)
data VideoDecoderAutomaticRequestSyncPointsPropertyInfo
instance AttrInfo VideoDecoderAutomaticRequestSyncPointsPropertyInfo where
    type AttrAllowedOps VideoDecoderAutomaticRequestSyncPointsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoDecoderAutomaticRequestSyncPointsPropertyInfo = IsVideoDecoder
    type AttrSetTypeConstraint VideoDecoderAutomaticRequestSyncPointsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint VideoDecoderAutomaticRequestSyncPointsPropertyInfo = (~) Bool
    type AttrTransferType VideoDecoderAutomaticRequestSyncPointsPropertyInfo = Bool
    type AttrGetType VideoDecoderAutomaticRequestSyncPointsPropertyInfo = Bool
    type AttrLabel VideoDecoderAutomaticRequestSyncPointsPropertyInfo = "automatic-request-sync-points"
    type AttrOrigin VideoDecoderAutomaticRequestSyncPointsPropertyInfo = VideoDecoder
    attrGet = getVideoDecoderAutomaticRequestSyncPoints
    attrSet = setVideoDecoderAutomaticRequestSyncPoints
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoDecoderAutomaticRequestSyncPoints
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.automaticRequestSyncPoints"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#g:attr:automaticRequestSyncPoints"
        })
#endif

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

-- | Get the value of the “@discard-corrupted-frames@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoDecoder #discardCorruptedFrames
-- @
getVideoDecoderDiscardCorruptedFrames :: (MonadIO m, IsVideoDecoder o) => o -> m Bool
getVideoDecoderDiscardCorruptedFrames :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> m Bool
getVideoDecoderDiscardCorruptedFrames o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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
"discard-corrupted-frames"

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

-- | Construct a `GValueConstruct` with valid value for the “@discard-corrupted-frames@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVideoDecoderDiscardCorruptedFrames :: (IsVideoDecoder o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructVideoDecoderDiscardCorruptedFrames :: forall o (m :: * -> *).
(IsVideoDecoder o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructVideoDecoderDiscardCorruptedFrames Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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
"discard-corrupted-frames" Bool
val

#if defined(ENABLE_OVERLOADING)
data VideoDecoderDiscardCorruptedFramesPropertyInfo
instance AttrInfo VideoDecoderDiscardCorruptedFramesPropertyInfo where
    type AttrAllowedOps VideoDecoderDiscardCorruptedFramesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoDecoderDiscardCorruptedFramesPropertyInfo = IsVideoDecoder
    type AttrSetTypeConstraint VideoDecoderDiscardCorruptedFramesPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint VideoDecoderDiscardCorruptedFramesPropertyInfo = (~) Bool
    type AttrTransferType VideoDecoderDiscardCorruptedFramesPropertyInfo = Bool
    type AttrGetType VideoDecoderDiscardCorruptedFramesPropertyInfo = Bool
    type AttrLabel VideoDecoderDiscardCorruptedFramesPropertyInfo = "discard-corrupted-frames"
    type AttrOrigin VideoDecoderDiscardCorruptedFramesPropertyInfo = VideoDecoder
    attrGet = getVideoDecoderDiscardCorruptedFrames
    attrSet = setVideoDecoderDiscardCorruptedFrames
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoDecoderDiscardCorruptedFrames
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.discardCorruptedFrames"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#g:attr:discardCorruptedFrames"
        })
#endif

-- VVV Prop "max-errors"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@max-errors@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoDecoder [ #maxErrors 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoDecoderMaxErrors :: (MonadIO m, IsVideoDecoder o) => o -> Int32 -> m ()
setVideoDecoderMaxErrors :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> Int32 -> m ()
setVideoDecoderMaxErrors o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"max-errors" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@max-errors@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVideoDecoderMaxErrors :: (IsVideoDecoder o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructVideoDecoderMaxErrors :: forall o (m :: * -> *).
(IsVideoDecoder o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructVideoDecoderMaxErrors Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"max-errors" Int32
val

#if defined(ENABLE_OVERLOADING)
data VideoDecoderMaxErrorsPropertyInfo
instance AttrInfo VideoDecoderMaxErrorsPropertyInfo where
    type AttrAllowedOps VideoDecoderMaxErrorsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoDecoderMaxErrorsPropertyInfo = IsVideoDecoder
    type AttrSetTypeConstraint VideoDecoderMaxErrorsPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint VideoDecoderMaxErrorsPropertyInfo = (~) Int32
    type AttrTransferType VideoDecoderMaxErrorsPropertyInfo = Int32
    type AttrGetType VideoDecoderMaxErrorsPropertyInfo = Int32
    type AttrLabel VideoDecoderMaxErrorsPropertyInfo = "max-errors"
    type AttrOrigin VideoDecoderMaxErrorsPropertyInfo = VideoDecoder
    attrGet = getVideoDecoderMaxErrors
    attrSet = setVideoDecoderMaxErrors
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoDecoderMaxErrors
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.maxErrors"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#g:attr:maxErrors"
        })
#endif

-- VVV Prop "min-force-key-unit-interval"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@min-force-key-unit-interval@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVideoDecoderMinForceKeyUnitInterval :: (IsVideoDecoder o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructVideoDecoderMinForceKeyUnitInterval :: forall o (m :: * -> *).
(IsVideoDecoder o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructVideoDecoderMinForceKeyUnitInterval Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"min-force-key-unit-interval" Word64
val

#if defined(ENABLE_OVERLOADING)
data VideoDecoderMinForceKeyUnitIntervalPropertyInfo
instance AttrInfo VideoDecoderMinForceKeyUnitIntervalPropertyInfo where
    type AttrAllowedOps VideoDecoderMinForceKeyUnitIntervalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoDecoderMinForceKeyUnitIntervalPropertyInfo = IsVideoDecoder
    type AttrSetTypeConstraint VideoDecoderMinForceKeyUnitIntervalPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint VideoDecoderMinForceKeyUnitIntervalPropertyInfo = (~) Word64
    type AttrTransferType VideoDecoderMinForceKeyUnitIntervalPropertyInfo = Word64
    type AttrGetType VideoDecoderMinForceKeyUnitIntervalPropertyInfo = Word64
    type AttrLabel VideoDecoderMinForceKeyUnitIntervalPropertyInfo = "min-force-key-unit-interval"
    type AttrOrigin VideoDecoderMinForceKeyUnitIntervalPropertyInfo = VideoDecoder
    attrGet = getVideoDecoderMinForceKeyUnitInterval
    attrSet = setVideoDecoderMinForceKeyUnitInterval
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoDecoderMinForceKeyUnitInterval
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.minForceKeyUnitInterval"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#g:attr:minForceKeyUnitInterval"
        })
#endif

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

-- | Get the value of the “@qos@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoDecoder #qos
-- @
getVideoDecoderQos :: (MonadIO m, IsVideoDecoder o) => o -> m Bool
getVideoDecoderQos :: forall (m :: * -> *) o.
(MonadIO m, IsVideoDecoder o) =>
o -> m Bool
getVideoDecoderQos o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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
"qos"

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

-- | Construct a `GValueConstruct` with valid value for the “@qos@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVideoDecoderQos :: (IsVideoDecoder o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructVideoDecoderQos :: forall o (m :: * -> *).
(IsVideoDecoder o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructVideoDecoderQos Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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
"qos" Bool
val

#if defined(ENABLE_OVERLOADING)
data VideoDecoderQosPropertyInfo
instance AttrInfo VideoDecoderQosPropertyInfo where
    type AttrAllowedOps VideoDecoderQosPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoDecoderQosPropertyInfo = IsVideoDecoder
    type AttrSetTypeConstraint VideoDecoderQosPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint VideoDecoderQosPropertyInfo = (~) Bool
    type AttrTransferType VideoDecoderQosPropertyInfo = Bool
    type AttrGetType VideoDecoderQosPropertyInfo = Bool
    type AttrLabel VideoDecoderQosPropertyInfo = "qos"
    type AttrOrigin VideoDecoderQosPropertyInfo = VideoDecoder
    attrGet = getVideoDecoderQos
    attrSet = setVideoDecoderQos
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoDecoderQos
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.qos"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#g:attr:qos"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoDecoder
type instance O.AttributeList VideoDecoder = VideoDecoderAttributeList
type VideoDecoderAttributeList = ('[ '("automaticRequestSyncPointFlags", VideoDecoderAutomaticRequestSyncPointFlagsPropertyInfo), '("automaticRequestSyncPoints", VideoDecoderAutomaticRequestSyncPointsPropertyInfo), '("discardCorruptedFrames", VideoDecoderDiscardCorruptedFramesPropertyInfo), '("maxErrors", VideoDecoderMaxErrorsPropertyInfo), '("minForceKeyUnitInterval", VideoDecoderMinForceKeyUnitIntervalPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("qos", VideoDecoderQosPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
videoDecoderAutomaticRequestSyncPointFlags :: AttrLabelProxy "automaticRequestSyncPointFlags"
videoDecoderAutomaticRequestSyncPointFlags = AttrLabelProxy

videoDecoderAutomaticRequestSyncPoints :: AttrLabelProxy "automaticRequestSyncPoints"
videoDecoderAutomaticRequestSyncPoints = AttrLabelProxy

videoDecoderDiscardCorruptedFrames :: AttrLabelProxy "discardCorruptedFrames"
videoDecoderDiscardCorruptedFrames = AttrLabelProxy

videoDecoderMaxErrors :: AttrLabelProxy "maxErrors"
videoDecoderMaxErrors = AttrLabelProxy

videoDecoderMinForceKeyUnitInterval :: AttrLabelProxy "minForceKeyUnitInterval"
videoDecoderMinForceKeyUnitInterval = AttrLabelProxy

videoDecoderQos :: AttrLabelProxy "qos"
videoDecoderQos = AttrLabelProxy

#endif

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

#endif

-- method VideoDecoder::add_to_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_bytes"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_add_to_frame" gst_video_decoder_add_to_frame :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Int32 ->                                -- n_bytes : TBasicType TInt
    IO ()

-- | Removes next /@nBytes@/ of input data and adds it to currently parsed frame.
videoDecoderAddToFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Int32
    -- ^ /@nBytes@/: the number of bytes to add
    -> m ()
videoDecoderAddToFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Int32 -> m ()
videoDecoderAddToFrame a
decoder Int32
nBytes = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoDecoder -> Int32 -> IO ()
gst_video_decoder_add_to_frame Ptr VideoDecoder
decoder' Int32
nBytes
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderAddToFrameMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderAddToFrameMethodInfo a signature where
    overloadedMethod = videoDecoderAddToFrame

instance O.OverloadedMethodInfo VideoDecoderAddToFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderAddToFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderAddToFrame"
        })


#endif

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

foreign import ccall "gst_video_decoder_allocate_output_buffer" gst_video_decoder_allocate_output_buffer :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Helper function that allocates a buffer to hold a video frame for /@decoder@/\'s
-- current t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'.
-- 
-- You should use 'GI.GstVideo.Objects.VideoDecoder.videoDecoderAllocateOutputFrame' instead of this
-- function, if possible at all.
videoDecoderAllocateOutputBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ allocated buffer, or NULL if no buffer could be
    --     allocated (e.g. when downstream is flushing or shutting down)
videoDecoderAllocateOutputBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m (Maybe Buffer)
videoDecoderAllocateOutputBuffer a
decoder = IO (Maybe Buffer) -> m (Maybe Buffer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr Buffer
result <- Ptr VideoDecoder -> IO (Ptr Buffer)
gst_video_decoder_allocate_output_buffer Ptr VideoDecoder
decoder'
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe Buffer -> IO (Maybe Buffer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderAllocateOutputBufferMethodInfo
instance (signature ~ (m (Maybe Gst.Buffer.Buffer)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderAllocateOutputBufferMethodInfo a signature where
    overloadedMethod = videoDecoderAllocateOutputBuffer

instance O.OverloadedMethodInfo VideoDecoderAllocateOutputBufferMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderAllocateOutputBuffer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderAllocateOutputBuffer"
        })


#endif

-- method VideoDecoder::allocate_output_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoCodecFrame"
--                 , 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_video_decoder_allocate_output_frame" gst_video_decoder_allocate_output_frame :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | Helper function that allocates a buffer to hold a video frame for /@decoder@/\'s
-- current t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'.  Subclass should already have configured video
-- state and set src pad caps.
-- 
-- The buffer allocated here is owned by the frame and you should only
-- keep references to the frame, not the buffer.
videoDecoderAllocateOutputFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ 'GI.Gst.Enums.FlowReturnOk' if an output buffer could be allocated
videoDecoderAllocateOutputFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoDecoderAllocateOutputFrame a
decoder VideoCodecFrame
frame = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    CInt
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_decoder_allocate_output_frame Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
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
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderAllocateOutputFrameMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderAllocateOutputFrameMethodInfo a signature where
    overloadedMethod = videoDecoderAllocateOutputFrame

instance O.OverloadedMethodInfo VideoDecoderAllocateOutputFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderAllocateOutputFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderAllocateOutputFrame"
        })


#endif

-- method VideoDecoder::allocate_output_frame_with_params
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoCodecFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "BufferPoolAcquireParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBufferPoolAcquireParams"
--                 , 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_video_decoder_allocate_output_frame_with_params" gst_video_decoder_allocate_output_frame_with_params :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    Ptr Gst.BufferPoolAcquireParams.BufferPoolAcquireParams -> -- params : TInterface (Name {namespace = "Gst", name = "BufferPoolAcquireParams"})
    IO CInt

-- | Same as @/gst_video_decoder_allocate_output_frame/@ except it allows passing
-- t'GI.Gst.Structs.BufferPoolAcquireParams.BufferPoolAcquireParams' to the sub call gst_buffer_pool_acquire_buffer.
-- 
-- /Since: 1.12/
videoDecoderAllocateOutputFrameWithParams ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> Gst.BufferPoolAcquireParams.BufferPoolAcquireParams
    -- ^ /@params@/: a t'GI.Gst.Structs.BufferPoolAcquireParams.BufferPoolAcquireParams'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ 'GI.Gst.Enums.FlowReturnOk' if an output buffer could be allocated
videoDecoderAllocateOutputFrameWithParams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> BufferPoolAcquireParams -> m FlowReturn
videoDecoderAllocateOutputFrameWithParams a
decoder VideoCodecFrame
frame BufferPoolAcquireParams
params = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    Ptr BufferPoolAcquireParams
params' <- BufferPoolAcquireParams -> IO (Ptr BufferPoolAcquireParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BufferPoolAcquireParams
params
    CInt
result <- Ptr VideoDecoder
-> Ptr VideoCodecFrame -> Ptr BufferPoolAcquireParams -> IO CInt
gst_video_decoder_allocate_output_frame_with_params Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
frame' Ptr BufferPoolAcquireParams
params'
    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
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    BufferPoolAcquireParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BufferPoolAcquireParams
params
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderAllocateOutputFrameWithParamsMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> Gst.BufferPoolAcquireParams.BufferPoolAcquireParams -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderAllocateOutputFrameWithParamsMethodInfo a signature where
    overloadedMethod = videoDecoderAllocateOutputFrameWithParams

instance O.OverloadedMethodInfo VideoDecoderAllocateOutputFrameWithParamsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderAllocateOutputFrameWithParams",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderAllocateOutputFrameWithParams"
        })


#endif

-- method VideoDecoder::drop_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame to drop"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_drop_frame" gst_video_decoder_drop_frame :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | Similar to 'GI.GstVideo.Objects.VideoDecoder.videoDecoderFinishFrame', but drops /@frame@/ in any
-- case and posts a QoS message with the frame\'s details on the bus.
-- In any case, the frame is considered finished and released.
videoDecoderDropFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' to drop
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn', usually GST_FLOW_OK.
videoDecoderDropFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoDecoderDropFrame a
dec VideoCodecFrame
frame = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed VideoCodecFrame
frame
    CInt
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_decoder_drop_frame Ptr VideoDecoder
dec' Ptr VideoCodecFrame
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
dec
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderDropFrameMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderDropFrameMethodInfo a signature where
    overloadedMethod = videoDecoderDropFrame

instance O.OverloadedMethodInfo VideoDecoderDropFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderDropFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderDropFrame"
        })


#endif

-- method VideoDecoder::drop_subframe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_drop_subframe" gst_video_decoder_drop_subframe :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | Drops input data.
-- The frame is not considered finished until the whole frame
-- is finished or dropped by the subclass.
-- 
-- /Since: 1.20/
videoDecoderDropSubframe ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn', usually GST_FLOW_OK.
videoDecoderDropSubframe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoDecoderDropSubframe a
dec VideoCodecFrame
frame = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed VideoCodecFrame
frame
    CInt
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_decoder_drop_subframe Ptr VideoDecoder
dec' Ptr VideoCodecFrame
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
dec
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderDropSubframeMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderDropSubframeMethodInfo a signature where
    overloadedMethod = videoDecoderDropSubframe

instance O.OverloadedMethodInfo VideoDecoderDropSubframeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderDropSubframe",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderDropSubframe"
        })


#endif

-- method VideoDecoder::finish_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a decoded #GstVideoCodecFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_finish_frame" gst_video_decoder_finish_frame :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | /@frame@/ should have a valid decoded data buffer, whose metadata fields
-- are then appropriately set according to frame data and pushed downstream.
-- If no output data is provided, /@frame@/ is considered skipped.
-- In any case, the frame is considered finished and released.
-- 
-- After calling this function the output buffer of the frame is to be
-- considered read-only. This function will also change the metadata
-- of the buffer.
videoDecoderFinishFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a decoded t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' resulting from sending data downstream
videoDecoderFinishFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoDecoderFinishFrame a
decoder VideoCodecFrame
frame = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed VideoCodecFrame
frame
    CInt
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_decoder_finish_frame Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
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
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderFinishFrameMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderFinishFrameMethodInfo a signature where
    overloadedMethod = videoDecoderFinishFrame

instance O.OverloadedMethodInfo VideoDecoderFinishFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderFinishFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderFinishFrame"
        })


#endif

-- method VideoDecoder::finish_subframe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "FlowReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_finish_subframe" gst_video_decoder_finish_subframe :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | Indicate that a subframe has been finished to be decoded
-- by the subclass. This method should be called for all subframes
-- except the last subframe where /@gstVideoDecoderFinishFrame@/
-- should be called instead.
-- 
-- /Since: 1.20/
videoDecoderFinishSubframe ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn', usually GST_FLOW_OK.
videoDecoderFinishSubframe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoDecoderFinishSubframe a
decoder VideoCodecFrame
frame = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed VideoCodecFrame
frame
    CInt
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_decoder_finish_subframe Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
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
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderFinishSubframeMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderFinishSubframeMethodInfo a signature where
    overloadedMethod = videoDecoderFinishSubframe

instance O.OverloadedMethodInfo VideoDecoderFinishSubframeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderFinishSubframe",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderFinishSubframe"
        })


#endif

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

foreign import ccall "gst_video_decoder_get_allocator" gst_video_decoder_get_allocator :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr (Ptr Gst.Allocator.Allocator) ->    -- allocator : TInterface (Name {namespace = "Gst", name = "Allocator"})
    Ptr Gst.AllocationParams.AllocationParams -> -- params : TInterface (Name {namespace = "Gst", name = "AllocationParams"})
    IO ()

-- | Lets t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder' sub-classes to know the memory /@allocator@/
-- used by the base class and its /@params@/.
-- 
-- Unref the /@allocator@/ after use it.
videoDecoderGetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m ((Maybe Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
videoDecoderGetAllocator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m (Maybe Allocator, AllocationParams)
videoDecoderGetAllocator a
decoder = IO (Maybe Allocator, AllocationParams)
-> m (Maybe Allocator, AllocationParams)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Allocator, AllocationParams)
 -> m (Maybe Allocator, AllocationParams))
-> IO (Maybe Allocator, AllocationParams)
-> m (Maybe Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr (Ptr Allocator)
allocator <- IO (Ptr (Ptr Allocator))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
64 :: IO (Ptr Gst.AllocationParams.AllocationParams)
    Ptr VideoDecoder
-> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO ()
gst_video_decoder_get_allocator Ptr VideoDecoder
decoder' Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Maybe Allocator
maybeAllocator' <- Ptr Allocator
-> (Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Allocator
allocator' ((Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator))
-> (Ptr Allocator -> IO Allocator) -> IO (Maybe Allocator)
forall a b. (a -> b) -> a -> b
$ \Ptr Allocator
allocator'' -> do
        Allocator
allocator''' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator''
        Allocator -> IO Allocator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Allocator
allocator'''
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
Gst.AllocationParams.AllocationParams) Ptr AllocationParams
params
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Maybe Allocator, AllocationParams)
-> IO (Maybe Allocator, AllocationParams)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Allocator
maybeAllocator', AllocationParams
params')

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetAllocatorMethodInfo
instance (signature ~ (m ((Maybe Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetAllocatorMethodInfo a signature where
    overloadedMethod = videoDecoderGetAllocator

instance O.OverloadedMethodInfo VideoDecoderGetAllocatorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetAllocator",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetAllocator"
        })


#endif

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

foreign import ccall "gst_video_decoder_get_buffer_pool" gst_video_decoder_get_buffer_pool :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO (Ptr Gst.BufferPool.BufferPool)

-- | /No description available in the introspection data./
videoDecoderGetBufferPool ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m (Maybe Gst.BufferPool.BufferPool)
    -- ^ __Returns:__ the instance of the t'GI.Gst.Objects.BufferPool.BufferPool' used
    -- by the decoder; free it after use it
videoDecoderGetBufferPool :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m (Maybe BufferPool)
videoDecoderGetBufferPool a
decoder = IO (Maybe BufferPool) -> m (Maybe BufferPool)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BufferPool) -> m (Maybe BufferPool))
-> IO (Maybe BufferPool) -> m (Maybe BufferPool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr BufferPool
result <- Ptr VideoDecoder -> IO (Ptr BufferPool)
gst_video_decoder_get_buffer_pool Ptr VideoDecoder
decoder'
    Maybe BufferPool
maybeResult <- Ptr BufferPool
-> (Ptr BufferPool -> IO BufferPool) -> IO (Maybe BufferPool)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BufferPool
result ((Ptr BufferPool -> IO BufferPool) -> IO (Maybe BufferPool))
-> (Ptr BufferPool -> IO BufferPool) -> IO (Maybe BufferPool)
forall a b. (a -> b) -> a -> b
$ \Ptr BufferPool
result' -> do
        BufferPool
result'' <- ((ManagedPtr BufferPool -> BufferPool)
-> Ptr BufferPool -> IO BufferPool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BufferPool -> BufferPool
Gst.BufferPool.BufferPool) Ptr BufferPool
result'
        BufferPool -> IO BufferPool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BufferPool
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe BufferPool -> IO (Maybe BufferPool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BufferPool
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetBufferPoolMethodInfo
instance (signature ~ (m (Maybe Gst.BufferPool.BufferPool)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetBufferPoolMethodInfo a signature where
    overloadedMethod = videoDecoderGetBufferPool

instance O.OverloadedMethodInfo VideoDecoderGetBufferPoolMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetBufferPool",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetBufferPool"
        })


#endif

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

foreign import ccall "gst_video_decoder_get_estimate_rate" gst_video_decoder_get_estimate_rate :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO Int32

-- | /No description available in the introspection data./
videoDecoderGetEstimateRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Int32
    -- ^ __Returns:__ currently configured byte to time conversion setting
videoDecoderGetEstimateRate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Int32
videoDecoderGetEstimateRate a
dec = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Int32
result <- Ptr VideoDecoder -> IO Int32
gst_video_decoder_get_estimate_rate Ptr VideoDecoder
dec'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetEstimateRateMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetEstimateRateMethodInfo a signature where
    overloadedMethod = videoDecoderGetEstimateRate

instance O.OverloadedMethodInfo VideoDecoderGetEstimateRateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetEstimateRate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetEstimateRate"
        })


#endif

-- method VideoDecoder::get_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame_number"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "system_frame_number of a frame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoCodecFrame" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_frame" gst_video_decoder_get_frame :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Int32 ->                                -- frame_number : TBasicType TInt
    IO (Ptr GstVideo.VideoCodecFrame.VideoCodecFrame)

-- | Get a pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoDecoderGetFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Int32
    -- ^ /@frameNumber@/: system_frame_number of a frame
    -> m (Maybe GstVideo.VideoCodecFrame.VideoCodecFrame)
    -- ^ __Returns:__ pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' identified by /@frameNumber@/.
videoDecoderGetFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Int32 -> m (Maybe VideoCodecFrame)
videoDecoderGetFrame a
decoder Int32
frameNumber = IO (Maybe VideoCodecFrame) -> m (Maybe VideoCodecFrame)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoCodecFrame) -> m (Maybe VideoCodecFrame))
-> IO (Maybe VideoCodecFrame) -> m (Maybe VideoCodecFrame)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
result <- Ptr VideoDecoder -> Int32 -> IO (Ptr VideoCodecFrame)
gst_video_decoder_get_frame Ptr VideoDecoder
decoder' Int32
frameNumber
    Maybe VideoCodecFrame
maybeResult <- Ptr VideoCodecFrame
-> (Ptr VideoCodecFrame -> IO VideoCodecFrame)
-> IO (Maybe VideoCodecFrame)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoCodecFrame
result ((Ptr VideoCodecFrame -> IO VideoCodecFrame)
 -> IO (Maybe VideoCodecFrame))
-> (Ptr VideoCodecFrame -> IO VideoCodecFrame)
-> IO (Maybe VideoCodecFrame)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoCodecFrame
result' -> do
        VideoCodecFrame
result'' <- ((ManagedPtr VideoCodecFrame -> VideoCodecFrame)
-> Ptr VideoCodecFrame -> IO VideoCodecFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoCodecFrame -> VideoCodecFrame
GstVideo.VideoCodecFrame.VideoCodecFrame) Ptr VideoCodecFrame
result'
        VideoCodecFrame -> IO VideoCodecFrame
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecFrame
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe VideoCodecFrame -> IO (Maybe VideoCodecFrame)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoCodecFrame
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetFrameMethodInfo
instance (signature ~ (Int32 -> m (Maybe GstVideo.VideoCodecFrame.VideoCodecFrame)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetFrameMethodInfo a signature where
    overloadedMethod = videoDecoderGetFrame

instance O.OverloadedMethodInfo VideoDecoderGetFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetFrame"
        })


#endif

-- method VideoDecoder::get_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "GstVideo" , name = "VideoCodecFrame" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_frames" gst_video_decoder_get_frames :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO (Ptr (GList (Ptr GstVideo.VideoCodecFrame.VideoCodecFrame)))

-- | Get all pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoDecoderGetFrames ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m [GstVideo.VideoCodecFrame.VideoCodecFrame]
    -- ^ __Returns:__ pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'.
videoDecoderGetFrames :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m [VideoCodecFrame]
videoDecoderGetFrames a
decoder = IO [VideoCodecFrame] -> m [VideoCodecFrame]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VideoCodecFrame] -> m [VideoCodecFrame])
-> IO [VideoCodecFrame] -> m [VideoCodecFrame]
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr (GList (Ptr VideoCodecFrame))
result <- Ptr VideoDecoder -> IO (Ptr (GList (Ptr VideoCodecFrame)))
gst_video_decoder_get_frames Ptr VideoDecoder
decoder'
    [Ptr VideoCodecFrame]
result' <- Ptr (GList (Ptr VideoCodecFrame)) -> IO [Ptr VideoCodecFrame]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr VideoCodecFrame))
result
    [VideoCodecFrame]
result'' <- (Ptr VideoCodecFrame -> IO VideoCodecFrame)
-> [Ptr VideoCodecFrame] -> IO [VideoCodecFrame]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr VideoCodecFrame -> VideoCodecFrame)
-> Ptr VideoCodecFrame -> IO VideoCodecFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoCodecFrame -> VideoCodecFrame
GstVideo.VideoCodecFrame.VideoCodecFrame) [Ptr VideoCodecFrame]
result'
    Ptr (GList (Ptr VideoCodecFrame)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr VideoCodecFrame))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    [VideoCodecFrame] -> IO [VideoCodecFrame]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [VideoCodecFrame]
result''

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetFramesMethodInfo
instance (signature ~ (m [GstVideo.VideoCodecFrame.VideoCodecFrame]), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetFramesMethodInfo a signature where
    overloadedMethod = videoDecoderGetFrames

instance O.OverloadedMethodInfo VideoDecoderGetFramesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetFrames",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetFrames"
        })


#endif

-- method VideoDecoder::get_input_subframe_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame to update"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_input_subframe_index" gst_video_decoder_get_input_subframe_index :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO Word32

-- | Queries the number of the last subframe received by
-- the decoder baseclass in the /@frame@/.
-- 
-- /Since: 1.20/
videoDecoderGetInputSubframeIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' to update
    -> m Word32
    -- ^ __Returns:__ the current subframe index received in subframe mode, 1 otherwise.
videoDecoderGetInputSubframeIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m Word32
videoDecoderGetInputSubframeIndex a
decoder VideoCodecFrame
frame = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    Word32
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO Word32
gst_video_decoder_get_input_subframe_index Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
frame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetInputSubframeIndexMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Word32), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetInputSubframeIndexMethodInfo a signature where
    overloadedMethod = videoDecoderGetInputSubframeIndex

instance O.OverloadedMethodInfo VideoDecoderGetInputSubframeIndexMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetInputSubframeIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetInputSubframeIndex"
        })


#endif

-- method VideoDecoder::get_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of variable in which to store the\n    configured minimum latency, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "max_latency"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of variable in which to store the\n    configured mximum latency, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_latency" gst_video_decoder_get_latency :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr Word64 ->                           -- min_latency : TBasicType TUInt64
    Ptr Word64 ->                           -- max_latency : TBasicType TUInt64
    IO ()

-- | Query the configured decoder latency. Results will be returned via
-- /@minLatency@/ and /@maxLatency@/.
videoDecoderGetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m ((Word64, Word64))
videoDecoderGetLatency :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m (Word64, Word64)
videoDecoderGetLatency a
decoder = IO (Word64, Word64) -> m (Word64, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64) -> m (Word64, Word64))
-> IO (Word64, Word64) -> m (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr Word64
minLatency <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
maxLatency <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr VideoDecoder -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_video_decoder_get_latency Ptr VideoDecoder
decoder' Ptr Word64
minLatency Ptr Word64
maxLatency
    Word64
minLatency' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
minLatency
    Word64
maxLatency' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
maxLatency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
minLatency
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
maxLatency
    (Word64, Word64) -> IO (Word64, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
minLatency', Word64
maxLatency')

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetLatencyMethodInfo
instance (signature ~ (m ((Word64, Word64))), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetLatencyMethodInfo a signature where
    overloadedMethod = videoDecoderGetLatency

instance O.OverloadedMethodInfo VideoDecoderGetLatencyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetLatency",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetLatency"
        })


#endif

-- method VideoDecoder::get_max_decode_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoCodecFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_max_decode_time" gst_video_decoder_get_max_decode_time :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO Int64

-- | Determines maximum possible decoding time for /@frame@/ that will
-- allow it to decode and arrive in time (as determined by QoS events).
-- In particular, a negative result means decoding in time is no longer possible
-- and should therefore occur as soon\/skippy as possible.
videoDecoderGetMaxDecodeTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Int64
    -- ^ __Returns:__ max decoding time.
videoDecoderGetMaxDecodeTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m Int64
videoDecoderGetMaxDecodeTime a
decoder VideoCodecFrame
frame = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    Int64
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO Int64
gst_video_decoder_get_max_decode_time Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
frame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetMaxDecodeTimeMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Int64), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetMaxDecodeTimeMethodInfo a signature where
    overloadedMethod = videoDecoderGetMaxDecodeTime

instance O.OverloadedMethodInfo VideoDecoderGetMaxDecodeTimeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetMaxDecodeTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetMaxDecodeTime"
        })


#endif

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

foreign import ccall "gst_video_decoder_get_max_errors" gst_video_decoder_get_max_errors :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO Int32

-- | /No description available in the introspection data./
videoDecoderGetMaxErrors ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Int32
    -- ^ __Returns:__ currently configured decoder tolerated error count.
videoDecoderGetMaxErrors :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Int32
videoDecoderGetMaxErrors a
dec = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Int32
result <- Ptr VideoDecoder -> IO Int32
gst_video_decoder_get_max_errors Ptr VideoDecoder
dec'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetMaxErrorsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetMaxErrorsMethodInfo a signature where
    overloadedMethod = videoDecoderGetMaxErrors

instance O.OverloadedMethodInfo VideoDecoderGetMaxErrorsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetMaxErrors",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetMaxErrors"
        })


#endif

-- method VideoDecoder::get_needs_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_get_needs_format" gst_video_decoder_get_needs_format :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CInt

-- | Queries decoder required format handling.
-- 
-- /Since: 1.4/
videoDecoderGetNeedsFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if required format handling is enabled.
videoDecoderGetNeedsFormat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Bool
videoDecoderGetNeedsFormat a
dec = IO Bool -> m Bool
forall a. IO a -> m a
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 VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    CInt
result <- Ptr VideoDecoder -> IO CInt
gst_video_decoder_get_needs_format Ptr VideoDecoder
dec'
    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
dec
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetNeedsFormatMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetNeedsFormatMethodInfo a signature where
    overloadedMethod = videoDecoderGetNeedsFormat

instance O.OverloadedMethodInfo VideoDecoderGetNeedsFormatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetNeedsFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetNeedsFormat"
        })


#endif

-- method VideoDecoder::get_needs_sync_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_get_needs_sync_point" gst_video_decoder_get_needs_sync_point :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CInt

-- | Queries if the decoder requires a sync point before it starts outputting
-- data in the beginning.
-- 
-- /Since: 1.20/
videoDecoderGetNeedsSyncPoint ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a sync point is required in the beginning.
videoDecoderGetNeedsSyncPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Bool
videoDecoderGetNeedsSyncPoint a
dec = IO Bool -> m Bool
forall a. IO a -> m a
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 VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    CInt
result <- Ptr VideoDecoder -> IO CInt
gst_video_decoder_get_needs_sync_point Ptr VideoDecoder
dec'
    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
dec
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetNeedsSyncPointMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetNeedsSyncPointMethodInfo a signature where
    overloadedMethod = videoDecoderGetNeedsSyncPoint

instance O.OverloadedMethodInfo VideoDecoderGetNeedsSyncPointMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetNeedsSyncPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetNeedsSyncPoint"
        })


#endif

-- method VideoDecoder::get_oldest_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoCodecFrame" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_oldest_frame" gst_video_decoder_get_oldest_frame :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO (Ptr GstVideo.VideoCodecFrame.VideoCodecFrame)

-- | Get the oldest pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoDecoderGetOldestFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m (Maybe GstVideo.VideoCodecFrame.VideoCodecFrame)
    -- ^ __Returns:__ oldest pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'.
videoDecoderGetOldestFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m (Maybe VideoCodecFrame)
videoDecoderGetOldestFrame a
decoder = IO (Maybe VideoCodecFrame) -> m (Maybe VideoCodecFrame)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoCodecFrame) -> m (Maybe VideoCodecFrame))
-> IO (Maybe VideoCodecFrame) -> m (Maybe VideoCodecFrame)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
result <- Ptr VideoDecoder -> IO (Ptr VideoCodecFrame)
gst_video_decoder_get_oldest_frame Ptr VideoDecoder
decoder'
    Maybe VideoCodecFrame
maybeResult <- Ptr VideoCodecFrame
-> (Ptr VideoCodecFrame -> IO VideoCodecFrame)
-> IO (Maybe VideoCodecFrame)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoCodecFrame
result ((Ptr VideoCodecFrame -> IO VideoCodecFrame)
 -> IO (Maybe VideoCodecFrame))
-> (Ptr VideoCodecFrame -> IO VideoCodecFrame)
-> IO (Maybe VideoCodecFrame)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoCodecFrame
result' -> do
        VideoCodecFrame
result'' <- ((ManagedPtr VideoCodecFrame -> VideoCodecFrame)
-> Ptr VideoCodecFrame -> IO VideoCodecFrame
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoCodecFrame -> VideoCodecFrame
GstVideo.VideoCodecFrame.VideoCodecFrame) Ptr VideoCodecFrame
result'
        VideoCodecFrame -> IO VideoCodecFrame
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecFrame
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe VideoCodecFrame -> IO (Maybe VideoCodecFrame)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoCodecFrame
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetOldestFrameMethodInfo
instance (signature ~ (m (Maybe GstVideo.VideoCodecFrame.VideoCodecFrame)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetOldestFrameMethodInfo a signature where
    overloadedMethod = videoDecoderGetOldestFrame

instance O.OverloadedMethodInfo VideoDecoderGetOldestFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetOldestFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetOldestFrame"
        })


#endif

-- method VideoDecoder::get_output_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoCodecState" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_output_state" gst_video_decoder_get_output_state :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO (Ptr GstVideo.VideoCodecState.VideoCodecState)

-- | Get the t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState' currently describing the output stream.
videoDecoderGetOutputState ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m (Maybe GstVideo.VideoCodecState.VideoCodecState)
    -- ^ __Returns:__ t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState' describing format of video data.
videoDecoderGetOutputState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m (Maybe VideoCodecState)
videoDecoderGetOutputState a
decoder = IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState))
-> IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecState
result <- Ptr VideoDecoder -> IO (Ptr VideoCodecState)
gst_video_decoder_get_output_state Ptr VideoDecoder
decoder'
    Maybe VideoCodecState
maybeResult <- Ptr VideoCodecState
-> (Ptr VideoCodecState -> IO VideoCodecState)
-> IO (Maybe VideoCodecState)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoCodecState
result ((Ptr VideoCodecState -> IO VideoCodecState)
 -> IO (Maybe VideoCodecState))
-> (Ptr VideoCodecState -> IO VideoCodecState)
-> IO (Maybe VideoCodecState)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoCodecState
result' -> do
        VideoCodecState
result'' <- ((ManagedPtr VideoCodecState -> VideoCodecState)
-> Ptr VideoCodecState -> IO VideoCodecState
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoCodecState -> VideoCodecState
GstVideo.VideoCodecState.VideoCodecState) Ptr VideoCodecState
result'
        VideoCodecState -> IO VideoCodecState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecState
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe VideoCodecState -> IO (Maybe VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoCodecState
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetOutputStateMethodInfo
instance (signature ~ (m (Maybe GstVideo.VideoCodecState.VideoCodecState)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetOutputStateMethodInfo a signature where
    overloadedMethod = videoDecoderGetOutputState

instance O.OverloadedMethodInfo VideoDecoderGetOutputStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetOutputState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetOutputState"
        })


#endif

-- method VideoDecoder::get_packetized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_get_packetized" gst_video_decoder_get_packetized :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CInt

-- | Queries whether input data is considered packetized or not by the
-- base class.
videoDecoderGetPacketized ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Bool
    -- ^ __Returns:__ TRUE if input data is considered packetized.
videoDecoderGetPacketized :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Bool
videoDecoderGetPacketized a
decoder = IO Bool -> m Bool
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    CInt
result <- Ptr VideoDecoder -> IO CInt
gst_video_decoder_get_packetized Ptr VideoDecoder
decoder'
    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
decoder
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetPacketizedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetPacketizedMethodInfo a signature where
    overloadedMethod = videoDecoderGetPacketized

instance O.OverloadedMethodInfo VideoDecoderGetPacketizedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetPacketized",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetPacketized"
        })


#endif

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

foreign import ccall "gst_video_decoder_get_pending_frame_size" gst_video_decoder_get_pending_frame_size :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO Word64

-- | Returns the number of bytes previously added to the current frame
-- by calling 'GI.GstVideo.Objects.VideoDecoder.videoDecoderAddToFrame'.
-- 
-- /Since: 1.4/
videoDecoderGetPendingFrameSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Word64
    -- ^ __Returns:__ The number of bytes pending for the current frame
videoDecoderGetPendingFrameSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Word64
videoDecoderGetPendingFrameSize a
decoder = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Word64
result <- Ptr VideoDecoder -> IO Word64
gst_video_decoder_get_pending_frame_size Ptr VideoDecoder
decoder'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetPendingFrameSizeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetPendingFrameSizeMethodInfo a signature where
    overloadedMethod = videoDecoderGetPendingFrameSize

instance O.OverloadedMethodInfo VideoDecoderGetPendingFrameSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetPendingFrameSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetPendingFrameSize"
        })


#endif

-- method VideoDecoder::get_processed_subframe_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame to update"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_processed_subframe_index" gst_video_decoder_get_processed_subframe_index :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO Word32

-- | Queries the number of subframes in the frame processed by
-- the decoder baseclass.
-- 
-- /Since: 1.20/
videoDecoderGetProcessedSubframeIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' to update
    -> m Word32
    -- ^ __Returns:__ the current subframe processed received in subframe mode.
videoDecoderGetProcessedSubframeIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m Word32
videoDecoderGetProcessedSubframeIndex a
decoder VideoCodecFrame
frame = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    Word32
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO Word32
gst_video_decoder_get_processed_subframe_index Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
frame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetProcessedSubframeIndexMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Word32), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetProcessedSubframeIndexMethodInfo a signature where
    overloadedMethod = videoDecoderGetProcessedSubframeIndex

instance O.OverloadedMethodInfo VideoDecoderGetProcessedSubframeIndexMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetProcessedSubframeIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetProcessedSubframeIndex"
        })


#endif

-- method VideoDecoder::get_qos_proportion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstVideoDecoder\n    current QoS proportion, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_get_qos_proportion" gst_video_decoder_get_qos_proportion :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CDouble

-- | /No description available in the introspection data./
-- 
-- /Since: 1.0.3/
videoDecoderGetQosProportion ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    --     current QoS proportion, or 'P.Nothing'
    -> m Double
    -- ^ __Returns:__ The current QoS proportion.
videoDecoderGetQosProportion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Double
videoDecoderGetQosProportion a
decoder = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    CDouble
result <- Ptr VideoDecoder -> IO CDouble
gst_video_decoder_get_qos_proportion Ptr VideoDecoder
decoder'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetQosProportionMethodInfo
instance (signature ~ (m Double), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetQosProportionMethodInfo a signature where
    overloadedMethod = videoDecoderGetQosProportion

instance O.OverloadedMethodInfo VideoDecoderGetQosProportionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetQosProportion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetQosProportion"
        })


#endif

-- method VideoDecoder::get_subframe_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_get_subframe_mode" gst_video_decoder_get_subframe_mode :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CInt

-- | Queries whether input data is considered as subframes or not by the
-- base class. If FALSE, each input buffer will be considered as a full
-- frame.
-- 
-- /Since: 1.20/
videoDecoderGetSubframeMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Bool
    -- ^ __Returns:__ TRUE if input data is considered as sub frames.
videoDecoderGetSubframeMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Bool
videoDecoderGetSubframeMode a
decoder = IO Bool -> m Bool
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    CInt
result <- Ptr VideoDecoder -> IO CInt
gst_video_decoder_get_subframe_mode Ptr VideoDecoder
decoder'
    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
decoder
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderGetSubframeModeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderGetSubframeModeMethodInfo a signature where
    overloadedMethod = videoDecoderGetSubframeMode

instance O.OverloadedMethodInfo VideoDecoderGetSubframeModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderGetSubframeMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderGetSubframeMode"
        })


#endif

-- method VideoDecoder::have_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_have_frame" gst_video_decoder_have_frame :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CInt

-- | Gathers all data collected for currently parsed frame, gathers corresponding
-- metadata and passes it along for further processing, i.e. /@handleFrame@/.
videoDecoderHaveFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn'
videoDecoderHaveFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m FlowReturn
videoDecoderHaveFrame a
decoder = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    CInt
result <- Ptr VideoDecoder -> IO CInt
gst_video_decoder_have_frame Ptr VideoDecoder
decoder'
    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
decoder
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderHaveFrameMethodInfo
instance (signature ~ (m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderHaveFrameMethodInfo a signature where
    overloadedMethod = videoDecoderHaveFrame

instance O.OverloadedMethodInfo VideoDecoderHaveFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderHaveFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderHaveFrame"
        })


#endif

-- method VideoDecoder::have_last_subframe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame to update"
--                 , 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_video_decoder_have_last_subframe" gst_video_decoder_have_last_subframe :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | Indicates that the last subframe has been processed by the decoder
-- in /@frame@/. This will release the current frame in video decoder
-- allowing to receive new frames from upstream elements. This method
-- must be called in the subclass /@handleFrame@/ callback.
-- 
-- /Since: 1.20/
videoDecoderHaveLastSubframe ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' to update
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn', usually GST_FLOW_OK.
videoDecoderHaveLastSubframe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoDecoderHaveLastSubframe a
decoder VideoCodecFrame
frame = IO FlowReturn -> m FlowReturn
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    CInt
result <- Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_decoder_have_last_subframe Ptr VideoDecoder
decoder' Ptr VideoCodecFrame
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
decoder
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    FlowReturn -> IO FlowReturn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderHaveLastSubframeMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderHaveLastSubframeMethodInfo a signature where
    overloadedMethod = videoDecoderHaveLastSubframe

instance O.OverloadedMethodInfo VideoDecoderHaveLastSubframeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderHaveLastSubframe",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderHaveLastSubframe"
        })


#endif

-- method VideoDecoder::merge_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_merge_tags" gst_video_decoder_merge_tags :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr Gst.TagList.TagList ->              -- tags : TInterface (Name {namespace = "Gst", name = "TagList"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "TagMergeMode"})
    IO ()

-- | Sets the audio decoder tags and how they should be merged with any
-- upstream stream tags. This will override any tags previously-set
-- with @/gst_audio_decoder_merge_tags()/@.
-- 
-- 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.
-- 
-- MT safe.
videoDecoderMergeTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> 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 ()
videoDecoderMergeTags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Maybe TagList -> TagMergeMode -> m ()
videoDecoderMergeTags a
decoder Maybe TagList
tags TagMergeMode
mode = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Maybe TagList
Nothing -> Ptr TagList -> IO (Ptr TagList)
forall a. a -> IO a
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 a. a -> IO a
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 VideoDecoder -> Ptr TagList -> CUInt -> IO ()
gst_video_decoder_merge_tags Ptr VideoDecoder
decoder' Ptr TagList
maybeTags CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderMergeTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> Gst.Enums.TagMergeMode -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderMergeTagsMethodInfo a signature where
    overloadedMethod = videoDecoderMergeTags

instance O.OverloadedMethodInfo VideoDecoderMergeTagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderMergeTags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderMergeTags"
        })


#endif

-- method VideoDecoder::negotiate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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_video_decoder_negotiate" gst_video_decoder_negotiate :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    IO CInt

-- | Negotiate with downstream elements to currently configured t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'.
-- Unmark GST_PAD_FLAG_NEED_RECONFIGURE in any case. But mark it again if
-- negotiate fails.
videoDecoderNegotiate ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the negotiation succeeded, else 'P.False'.
videoDecoderNegotiate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> m Bool
videoDecoderNegotiate a
decoder = IO Bool -> m Bool
forall a. IO a -> m a
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 VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    CInt
result <- Ptr VideoDecoder -> IO CInt
gst_video_decoder_negotiate Ptr VideoDecoder
decoder'
    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
decoder
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderNegotiateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderNegotiateMethodInfo a signature where
    overloadedMethod = videoDecoderNegotiate

instance O.OverloadedMethodInfo VideoDecoderNegotiateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderNegotiate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderNegotiate"
        })


#endif

-- method VideoDecoder::proxy_getcaps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "initial caps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filter caps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Caps" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_proxy_getcaps" gst_video_decoder_proxy_getcaps :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Caps.Caps ->                    -- filter : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Gst.Caps.Caps)

-- | Returns caps that express /@caps@/ (or sink template caps if /@caps@/ == NULL)
-- restricted to resolution\/format\/... combinations supported by downstream
-- elements.
-- 
-- /Since: 1.6/
videoDecoderProxyGetcaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: initial caps
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@filter@/: filter caps
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ a t'GI.Gst.Structs.Caps.Caps' owned by caller
videoDecoderProxyGetcaps :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Maybe Caps -> Maybe Caps -> m Caps
videoDecoderProxyGetcaps a
decoder Maybe Caps
caps Maybe Caps
filter = IO Caps -> m Caps
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Caps
maybeFilter <- case Maybe Caps
filter of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jFilter -> do
            Ptr Caps
jFilter' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jFilter
            Ptr Caps -> IO (Ptr Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jFilter'
    Ptr Caps
result <- Ptr VideoDecoder -> Ptr Caps -> Ptr Caps -> IO (Ptr Caps)
gst_video_decoder_proxy_getcaps Ptr VideoDecoder
decoder' Ptr Caps
maybeCaps Ptr Caps
maybeFilter
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoDecoderProxyGetcaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
filter Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Caps -> IO Caps
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data VideoDecoderProxyGetcapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> Maybe (Gst.Caps.Caps) -> m Gst.Caps.Caps), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderProxyGetcapsMethodInfo a signature where
    overloadedMethod = videoDecoderProxyGetcaps

instance O.OverloadedMethodInfo VideoDecoderProxyGetcapsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderProxyGetcaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderProxyGetcaps"
        })


#endif

-- method VideoDecoder::release_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstVideoCodecFrame to release"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_release_frame" gst_video_decoder_release_frame :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO ()

-- | Similar to 'GI.GstVideo.Objects.VideoDecoder.videoDecoderDropFrame', but simply releases /@frame@/
-- without any processing other than removing it from list of pending frames,
-- after which it is considered finished and released.
-- 
-- /Since: 1.2.2/
videoDecoderReleaseFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: the t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' to release
    -> m ()
videoDecoderReleaseFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> m ()
videoDecoderReleaseFrame a
dec VideoCodecFrame
frame = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed VideoCodecFrame
frame
    Ptr VideoDecoder -> Ptr VideoCodecFrame -> IO ()
gst_video_decoder_release_frame Ptr VideoDecoder
dec' Ptr VideoCodecFrame
frame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderReleaseFrameMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderReleaseFrameMethodInfo a signature where
    overloadedMethod = videoDecoderReleaseFrame

instance O.OverloadedMethodInfo VideoDecoderReleaseFrameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderReleaseFrame",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderReleaseFrame"
        })


#endif

-- method VideoDecoder::request_sync_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frame"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecFrame" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoCodecFrame"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo"
--                   , name = "VideoDecoderRequestSyncPointFlags"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoDecoderRequestSyncPointFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_request_sync_point" gst_video_decoder_request_sync_point :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoDecoderRequestSyncPointFlags"})
    IO ()

-- | Allows the t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder' subclass to request from the base class that
-- a new sync should be requested from upstream, and that /@frame@/ was the frame
-- when the subclass noticed that a new sync point is required. A reason for
-- the subclass to do this could be missing reference frames, for example.
-- 
-- The base class will then request a new sync point from upstream as long as
-- the time that passed since the last one is exceeding
-- [VideoDecoder:minForceKeyUnitInterval]("GI.GstVideo.Objects.VideoDecoder#g:attr:minForceKeyUnitInterval").
-- 
-- The subclass can signal via /@flags@/ how the frames until the next sync point
-- should be handled:
-- 
--   * If 'GI.GstVideo.Flags.VideoDecoderRequestSyncPointFlagsDiscardInput' is selected then
--     all following input frames until the next sync point are discarded.
--     This can be useful if the lack of a sync point will prevent all further
--     decoding and the decoder implementation is not very robust in handling
--     missing references frames.
--   * If 'GI.GstVideo.Flags.VideoDecoderRequestSyncPointFlagsCorruptOutput' is selected
--     then all output frames following /@frame@/ are marked as corrupted via
--     'GI.Gst.Flags.BufferFlagsCorrupted'. Corrupted frames can be automatically
--     dropped by the base class, see [VideoDecoder:discardCorruptedFrames]("GI.GstVideo.Objects.VideoDecoder#g:attr:discardCorruptedFrames").
--     Subclasses can manually mark frames as corrupted via 'GI.GstVideo.Flags.VideoCodecFrameFlagsCorrupted'
--     before calling 'GI.GstVideo.Objects.VideoDecoder.videoDecoderFinishFrame'.
-- 
-- /Since: 1.20/
videoDecoderRequestSyncPoint ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> [GstVideo.Flags.VideoDecoderRequestSyncPointFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoDecoderRequestSyncPointFlags'
    -> m ()
videoDecoderRequestSyncPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> VideoCodecFrame -> [VideoDecoderRequestSyncPointFlags] -> m ()
videoDecoderRequestSyncPoint a
dec VideoCodecFrame
frame [VideoDecoderRequestSyncPointFlags]
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    let flags' :: CUInt
flags' = [VideoDecoderRequestSyncPointFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoDecoderRequestSyncPointFlags]
flags
    Ptr VideoDecoder -> Ptr VideoCodecFrame -> CUInt -> IO ()
gst_video_decoder_request_sync_point Ptr VideoDecoder
dec' Ptr VideoCodecFrame
frame' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    VideoCodecFrame -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoCodecFrame
frame
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderRequestSyncPointMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> [GstVideo.Flags.VideoDecoderRequestSyncPointFlags] -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderRequestSyncPointMethodInfo a signature where
    overloadedMethod = videoDecoderRequestSyncPoint

instance O.OverloadedMethodInfo VideoDecoderRequestSyncPointMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderRequestSyncPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderRequestSyncPoint"
        })


#endif

-- method VideoDecoder::set_estimate_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to enable byte to time conversion"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_estimate_rate" gst_video_decoder_set_estimate_rate :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Allows baseclass to perform byte to time estimated conversion.
videoDecoderSetEstimateRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Bool
    -- ^ /@enabled@/: whether to enable byte to time conversion
    -> m ()
videoDecoderSetEstimateRate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Bool -> m ()
videoDecoderSetEstimateRate a
dec Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
enabled
    Ptr VideoDecoder -> CInt -> IO ()
gst_video_decoder_set_estimate_rate Ptr VideoDecoder
dec' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetEstimateRateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetEstimateRateMethodInfo a signature where
    overloadedMethod = videoDecoderSetEstimateRate

instance O.OverloadedMethodInfo VideoDecoderSetEstimateRateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetEstimateRate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetEstimateRate"
        })


#endif

-- method VideoDecoder::set_interlaced_output_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormat" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interlace_mode"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoInterlaceMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstVideoInterlaceMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The width in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The height in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reference"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecState" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional reference #GstVideoCodecState"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoCodecState" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_interlaced_output_state" gst_video_decoder_set_interlaced_output_state :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CUInt ->                                -- fmt : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    CUInt ->                                -- interlace_mode : TInterface (Name {namespace = "GstVideo", name = "VideoInterlaceMode"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    Ptr GstVideo.VideoCodecState.VideoCodecState -> -- reference : TInterface (Name {namespace = "GstVideo", name = "VideoCodecState"})
    IO (Ptr GstVideo.VideoCodecState.VideoCodecState)

-- | Same as @/gst_video_decoder_set_output_state/@() but also allows you to also set
-- the interlacing mode.
-- 
-- /Since: 1.16./
videoDecoderSetInterlacedOutputState ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@fmt@/: a t'GI.GstVideo.Enums.VideoFormat'
    -> GstVideo.Enums.VideoInterlaceMode
    -- ^ /@interlaceMode@/: A t'GI.GstVideo.Enums.VideoInterlaceMode'
    -> Word32
    -- ^ /@width@/: The width in pixels
    -> Word32
    -- ^ /@height@/: The height in pixels
    -> Maybe (GstVideo.VideoCodecState.VideoCodecState)
    -- ^ /@reference@/: An optional reference t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'
    -> m (Maybe GstVideo.VideoCodecState.VideoCodecState)
    -- ^ __Returns:__ the newly configured output state.
videoDecoderSetInterlacedOutputState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a
-> VideoFormat
-> VideoInterlaceMode
-> Word32
-> Word32
-> Maybe VideoCodecState
-> m (Maybe VideoCodecState)
videoDecoderSetInterlacedOutputState a
decoder VideoFormat
fmt VideoInterlaceMode
interlaceMode Word32
width Word32
height Maybe VideoCodecState
reference = IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState))
-> IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    let fmt' :: CUInt
fmt' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
fmt
    let interlaceMode' :: CUInt
interlaceMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (VideoInterlaceMode -> Int) -> VideoInterlaceMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoInterlaceMode -> Int
forall a. Enum a => a -> Int
fromEnum) VideoInterlaceMode
interlaceMode
    Ptr VideoCodecState
maybeReference <- case Maybe VideoCodecState
reference of
        Maybe VideoCodecState
Nothing -> Ptr VideoCodecState -> IO (Ptr VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VideoCodecState
forall a. Ptr a
nullPtr
        Just VideoCodecState
jReference -> do
            Ptr VideoCodecState
jReference' <- VideoCodecState -> IO (Ptr VideoCodecState)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecState
jReference
            Ptr VideoCodecState -> IO (Ptr VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VideoCodecState
jReference'
    Ptr VideoCodecState
result <- Ptr VideoDecoder
-> CUInt
-> CUInt
-> Word32
-> Word32
-> Ptr VideoCodecState
-> IO (Ptr VideoCodecState)
gst_video_decoder_set_interlaced_output_state Ptr VideoDecoder
decoder' CUInt
fmt' CUInt
interlaceMode' Word32
width Word32
height Ptr VideoCodecState
maybeReference
    Maybe VideoCodecState
maybeResult <- Ptr VideoCodecState
-> (Ptr VideoCodecState -> IO VideoCodecState)
-> IO (Maybe VideoCodecState)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoCodecState
result ((Ptr VideoCodecState -> IO VideoCodecState)
 -> IO (Maybe VideoCodecState))
-> (Ptr VideoCodecState -> IO VideoCodecState)
-> IO (Maybe VideoCodecState)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoCodecState
result' -> do
        VideoCodecState
result'' <- ((ManagedPtr VideoCodecState -> VideoCodecState)
-> Ptr VideoCodecState -> IO VideoCodecState
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoCodecState -> VideoCodecState
GstVideo.VideoCodecState.VideoCodecState) Ptr VideoCodecState
result'
        VideoCodecState -> IO VideoCodecState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecState
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe VideoCodecState -> (VideoCodecState -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe VideoCodecState
reference VideoCodecState -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe VideoCodecState -> IO (Maybe VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoCodecState
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetInterlacedOutputStateMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> GstVideo.Enums.VideoInterlaceMode -> Word32 -> Word32 -> Maybe (GstVideo.VideoCodecState.VideoCodecState) -> m (Maybe GstVideo.VideoCodecState.VideoCodecState)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetInterlacedOutputStateMethodInfo a signature where
    overloadedMethod = videoDecoderSetInterlacedOutputState

instance O.OverloadedMethodInfo VideoDecoderSetInterlacedOutputStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetInterlacedOutputState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetInterlacedOutputState"
        })


#endif

-- method VideoDecoder::set_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , 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 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 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_video_decoder_set_latency" gst_video_decoder_set_latency :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Word64 ->                               -- min_latency : TBasicType TUInt64
    Word64 ->                               -- max_latency : TBasicType TUInt64
    IO ()

-- | Lets t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder' sub-classes tell the baseclass what the decoder latency
-- is. If the provided values changed from previously provided ones, this will
-- also post a LATENCY message on the bus so the pipeline can reconfigure its
-- global latency.
videoDecoderSetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Word64
    -- ^ /@minLatency@/: minimum latency
    -> Word64
    -- ^ /@maxLatency@/: maximum latency
    -> m ()
videoDecoderSetLatency :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Word64 -> Word64 -> m ()
videoDecoderSetLatency a
decoder Word64
minLatency Word64
maxLatency = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    Ptr VideoDecoder -> Word64 -> Word64 -> IO ()
gst_video_decoder_set_latency Ptr VideoDecoder
decoder' Word64
minLatency Word64
maxLatency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetLatencyMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetLatencyMethodInfo a signature where
    overloadedMethod = videoDecoderSetLatency

instance O.OverloadedMethodInfo VideoDecoderSetLatencyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetLatency",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetLatency"
        })


#endif

-- method VideoDecoder::set_max_errors
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "max tolerated errors"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_max_errors" gst_video_decoder_set_max_errors :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    Int32 ->                                -- num : TBasicType TInt
    IO ()

-- | Sets numbers of tolerated decoder errors, where a tolerated one is then only
-- warned about, but more than tolerated will lead to fatal error.  You can set
-- -1 for never returning fatal errors. Default is set to
-- GST_VIDEO_DECODER_MAX_ERRORS.
-- 
-- The \'-1\' option was added in 1.4
videoDecoderSetMaxErrors ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Int32
    -- ^ /@num@/: max tolerated errors
    -> m ()
videoDecoderSetMaxErrors :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Int32 -> m ()
videoDecoderSetMaxErrors a
dec Int32
num = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    Ptr VideoDecoder -> Int32 -> IO ()
gst_video_decoder_set_max_errors Ptr VideoDecoder
dec' Int32
num
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetMaxErrorsMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetMaxErrorsMethodInfo a signature where
    overloadedMethod = videoDecoderSetMaxErrors

instance O.OverloadedMethodInfo VideoDecoderSetMaxErrorsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetMaxErrors",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetMaxErrors"
        })


#endif

-- method VideoDecoder::set_needs_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new state" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_needs_format" gst_video_decoder_set_needs_format :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Configures decoder format needs.  If enabled, subclass needs to be
-- negotiated with format caps before it can process any data.  It will then
-- never be handed any data before it has been configured.
-- Otherwise, it might be handed data without having been configured and
-- is then expected being able to do so either by default
-- or based on the input data.
-- 
-- /Since: 1.4/
videoDecoderSetNeedsFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Bool
    -- ^ /@enabled@/: new state
    -> m ()
videoDecoderSetNeedsFormat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Bool -> m ()
videoDecoderSetNeedsFormat a
dec Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
enabled
    Ptr VideoDecoder -> CInt -> IO ()
gst_video_decoder_set_needs_format Ptr VideoDecoder
dec' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetNeedsFormatMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetNeedsFormatMethodInfo a signature where
    overloadedMethod = videoDecoderSetNeedsFormat

instance O.OverloadedMethodInfo VideoDecoderSetNeedsFormatMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetNeedsFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetNeedsFormat"
        })


#endif

-- method VideoDecoder::set_needs_sync_point
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "dec"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new state" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_needs_sync_point" gst_video_decoder_set_needs_sync_point :: 
    Ptr VideoDecoder ->                     -- dec : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Configures whether the decoder requires a sync point before it starts
-- outputting data in the beginning. If enabled, the base class will discard
-- all non-sync point frames in the beginning and after a flush and does not
-- pass it to the subclass.
-- 
-- If the first frame is not a sync point, the base class will request a sync
-- point via the force-key-unit event.
-- 
-- /Since: 1.20/
videoDecoderSetNeedsSyncPoint ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@dec@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Bool
    -- ^ /@enabled@/: new state
    -> m ()
videoDecoderSetNeedsSyncPoint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Bool -> m ()
videoDecoderSetNeedsSyncPoint a
dec Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
dec' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
dec
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
enabled
    Ptr VideoDecoder -> CInt -> IO ()
gst_video_decoder_set_needs_sync_point Ptr VideoDecoder
dec' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
dec
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetNeedsSyncPointMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetNeedsSyncPointMethodInfo a signature where
    overloadedMethod = videoDecoderSetNeedsSyncPoint

instance O.OverloadedMethodInfo VideoDecoderSetNeedsSyncPointMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetNeedsSyncPoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetNeedsSyncPoint"
        })


#endif

-- method VideoDecoder::set_output_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fmt"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormat" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The width in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The height in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reference"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoCodecState" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional reference #GstVideoCodecState"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoCodecState" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_output_state" gst_video_decoder_set_output_state :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CUInt ->                                -- fmt : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    Ptr GstVideo.VideoCodecState.VideoCodecState -> -- reference : TInterface (Name {namespace = "GstVideo", name = "VideoCodecState"})
    IO (Ptr GstVideo.VideoCodecState.VideoCodecState)

-- | Creates a new t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState' with the specified /@fmt@/, /@width@/ and /@height@/
-- as the output state for the decoder.
-- Any previously set output state on /@decoder@/ will be replaced by the newly
-- created one.
-- 
-- If the subclass wishes to copy over existing fields (like pixel aspec ratio,
-- or framerate) from an existing t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState', it can be provided as a
-- /@reference@/.
-- 
-- If the subclass wishes to override some fields from the output state (like
-- pixel-aspect-ratio or framerate) it can do so on the returned t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'.
-- 
-- The new output state will only take effect (set on pads and buffers) starting
-- from the next call to @/gst_video_decoder_finish_frame/@().
videoDecoderSetOutputState ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> GstVideo.Enums.VideoFormat
    -- ^ /@fmt@/: a t'GI.GstVideo.Enums.VideoFormat'
    -> Word32
    -- ^ /@width@/: The width in pixels
    -> Word32
    -- ^ /@height@/: The height in pixels
    -> Maybe (GstVideo.VideoCodecState.VideoCodecState)
    -- ^ /@reference@/: An optional reference t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'
    -> m (Maybe GstVideo.VideoCodecState.VideoCodecState)
    -- ^ __Returns:__ the newly configured output state.
videoDecoderSetOutputState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a
-> VideoFormat
-> Word32
-> Word32
-> Maybe VideoCodecState
-> m (Maybe VideoCodecState)
videoDecoderSetOutputState a
decoder VideoFormat
fmt Word32
width Word32
height Maybe VideoCodecState
reference = IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState))
-> IO (Maybe VideoCodecState) -> m (Maybe VideoCodecState)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    let fmt' :: CUInt
fmt' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
fmt
    Ptr VideoCodecState
maybeReference <- case Maybe VideoCodecState
reference of
        Maybe VideoCodecState
Nothing -> Ptr VideoCodecState -> IO (Ptr VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VideoCodecState
forall a. Ptr a
nullPtr
        Just VideoCodecState
jReference -> do
            Ptr VideoCodecState
jReference' <- VideoCodecState -> IO (Ptr VideoCodecState)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecState
jReference
            Ptr VideoCodecState -> IO (Ptr VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VideoCodecState
jReference'
    Ptr VideoCodecState
result <- Ptr VideoDecoder
-> CUInt
-> Word32
-> Word32
-> Ptr VideoCodecState
-> IO (Ptr VideoCodecState)
gst_video_decoder_set_output_state Ptr VideoDecoder
decoder' CUInt
fmt' Word32
width Word32
height Ptr VideoCodecState
maybeReference
    Maybe VideoCodecState
maybeResult <- Ptr VideoCodecState
-> (Ptr VideoCodecState -> IO VideoCodecState)
-> IO (Maybe VideoCodecState)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoCodecState
result ((Ptr VideoCodecState -> IO VideoCodecState)
 -> IO (Maybe VideoCodecState))
-> (Ptr VideoCodecState -> IO VideoCodecState)
-> IO (Maybe VideoCodecState)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoCodecState
result' -> do
        VideoCodecState
result'' <- ((ManagedPtr VideoCodecState -> VideoCodecState)
-> Ptr VideoCodecState -> IO VideoCodecState
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoCodecState -> VideoCodecState
GstVideo.VideoCodecState.VideoCodecState) Ptr VideoCodecState
result'
        VideoCodecState -> IO VideoCodecState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecState
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    Maybe VideoCodecState -> (VideoCodecState -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe VideoCodecState
reference VideoCodecState -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe VideoCodecState -> IO (Maybe VideoCodecState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoCodecState
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetOutputStateMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> Word32 -> Word32 -> Maybe (GstVideo.VideoCodecState.VideoCodecState) -> m (Maybe GstVideo.VideoCodecState.VideoCodecState)), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetOutputStateMethodInfo a signature where
    overloadedMethod = videoDecoderSetOutputState

instance O.OverloadedMethodInfo VideoDecoderSetOutputStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetOutputState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetOutputState"
        })


#endif

-- method VideoDecoder::set_packetized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "packetized"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether the input data should be considered as packetized."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_packetized" gst_video_decoder_set_packetized :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CInt ->                                 -- packetized : TBasicType TBoolean
    IO ()

-- | Allows baseclass to consider input data as packetized or not. If the
-- input is packetized, then the /@parse@/ method will not be called.
videoDecoderSetPacketized ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Bool
    -- ^ /@packetized@/: whether the input data should be considered as packetized.
    -> m ()
videoDecoderSetPacketized :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Bool -> m ()
videoDecoderSetPacketized a
decoder Bool
packetized = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    let packetized' :: CInt
packetized' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
packetized
    Ptr VideoDecoder -> CInt -> IO ()
gst_video_decoder_set_packetized Ptr VideoDecoder
decoder' CInt
packetized'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetPacketizedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetPacketizedMethodInfo a signature where
    overloadedMethod = videoDecoderSetPacketized

instance O.OverloadedMethodInfo VideoDecoderSetPacketizedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetPacketized",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetPacketized"
        })


#endif

-- method VideoDecoder::set_subframe_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subframe_mode"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether the input data should be considered as subframes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_subframe_mode" gst_video_decoder_set_subframe_mode :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CInt ->                                 -- subframe_mode : TBasicType TBoolean
    IO ()

-- | If this is set to TRUE, it informs the base class that the subclass
-- can receive the data at a granularity lower than one frame.
-- 
-- Note that in this mode, the subclass has two options. It can either
-- require the presence of a GST_VIDEO_BUFFER_FLAG_MARKER to mark the
-- end of a frame. Or it can operate in such a way that it will decode
-- a single frame at a time. In this second case, every buffer that
-- arrives to the element is considered part of the same frame until
-- 'GI.GstVideo.Objects.VideoDecoder.videoDecoderFinishFrame' is called.
-- 
-- In either case, the same t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' will be passed to the
-- GstVideoDecoderClass:handle_frame vmethod repeatedly with a
-- different GstVideoCodecFrame:input_buffer every time until the end of the
-- frame has been signaled using either method.
-- This method must be called during the decoder subclass /@setFormat@/ call.
-- 
-- /Since: 1.20/
videoDecoderSetSubframeMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Bool
    -- ^ /@subframeMode@/: whether the input data should be considered as subframes.
    -> m ()
videoDecoderSetSubframeMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Bool -> m ()
videoDecoderSetSubframeMode a
decoder Bool
subframeMode = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    let subframeMode' :: CInt
subframeMode' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
subframeMode
    Ptr VideoDecoder -> CInt -> IO ()
gst_video_decoder_set_subframe_mode Ptr VideoDecoder
decoder' CInt
subframeMode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetSubframeModeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetSubframeModeMethodInfo a signature where
    overloadedMethod = videoDecoderSetSubframeMode

instance O.OverloadedMethodInfo VideoDecoderSetSubframeModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetSubframeMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetSubframeMode"
        })


#endif

-- method VideoDecoder::set_use_default_pad_acceptcaps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "decoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoDecoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoDecoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "use"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if the default pad accept-caps query handling should be used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_decoder_set_use_default_pad_acceptcaps" gst_video_decoder_set_use_default_pad_acceptcaps :: 
    Ptr VideoDecoder ->                     -- decoder : TInterface (Name {namespace = "GstVideo", name = "VideoDecoder"})
    CInt ->                                 -- use : TBasicType TBoolean
    IO ()

-- | Lets t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder' sub-classes decide if they want the sink pad
-- to use the default pad query handler to reply to accept-caps queries.
-- 
-- By setting this to true it is possible to further customize the default
-- handler with @/GST_PAD_SET_ACCEPT_INTERSECT/@ and
-- @/GST_PAD_SET_ACCEPT_TEMPLATE/@
-- 
-- /Since: 1.6/
videoDecoderSetUseDefaultPadAcceptcaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoDecoder a) =>
    a
    -- ^ /@decoder@/: a t'GI.GstVideo.Objects.VideoDecoder.VideoDecoder'
    -> Bool
    -- ^ /@use@/: if the default pad accept-caps query handling should be used
    -> m ()
videoDecoderSetUseDefaultPadAcceptcaps :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoDecoder a) =>
a -> Bool -> m ()
videoDecoderSetUseDefaultPadAcceptcaps a
decoder Bool
use = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoDecoder
decoder' <- a -> IO (Ptr VideoDecoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decoder
    let use' :: CInt
use' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
use
    Ptr VideoDecoder -> CInt -> IO ()
gst_video_decoder_set_use_default_pad_acceptcaps Ptr VideoDecoder
decoder' CInt
use'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoDecoderSetUseDefaultPadAcceptcapsMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoDecoder a) => O.OverloadedMethod VideoDecoderSetUseDefaultPadAcceptcapsMethodInfo a signature where
    overloadedMethod = videoDecoderSetUseDefaultPadAcceptcaps

instance O.OverloadedMethodInfo VideoDecoderSetUseDefaultPadAcceptcapsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoDecoder.videoDecoderSetUseDefaultPadAcceptcaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Objects-VideoDecoder.html#v:videoDecoderSetUseDefaultPadAcceptcaps"
        })


#endif