{-# 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 encoders turning raw video into
-- encoded video data.
-- 
-- GstVideoEncoder and subclass should cooperate as follows.
-- 
-- == Configuration
-- 
--   * Initially, GstVideoEncoder calls /@start@/ when the encoder element
--     is activated, which allows subclass to perform any global setup.
--   * GstVideoEncoder calls /@setFormat@/ to inform subclass of the format
--     of input video data that it is about to receive.  Subclass should
--     setup for encoding and configure base class as appropriate
--     (e.g. latency). While unlikely, it might be called more than once,
--     if changing input parameters require reconfiguration.  Baseclass
--     will ensure that processing of current configuration is finished.
--   * GstVideoEncoder calls /@stop@/ at end of all processing.
-- 
-- == Data processing
-- 
--     * Base class collects input data and metadata into a frame and hands
--       this to subclass\' /@handleFrame@/.
-- 
--     * If codec processing results in encoded data, subclass should call
--       /@gstVideoEncoderFinishFrame@/ to have encoded data pushed
--       downstream.
-- 
--     * If implemented, baseclass calls subclass /@prePush@/ just prior to
--       pushing to allow subclasses to modify some metadata on the buffer.
--       If it returns GST_FLOW_OK, the buffer is pushed downstream.
-- 
--     * GstVideoEncoderClass will handle both srcpad and sinkpad events.
--       Sink events will be passed to subclass if /@event@/ callback has been
--       provided.
-- 
-- == Shutdown phase
-- 
--   * GstVideoEncoder class calls /@stop@/ to inform the subclass that data
--     parsing will be stopped.
-- 
-- Subclass is responsible for providing pad template caps for
-- source and sink pads. The pads need to be named \"sink\" and \"src\". It should
-- also be able to provide fixed src pad caps in /@getcaps@/ by the time it calls
-- /@gstVideoEncoderFinishFrame@/.
-- 
-- Things that subclass need to take care of:
-- 
--   * Provide pad templates
--   * Provide source pad caps before pushing the first buffer
--   * Accept data in /@handleFrame@/ and provide encoded results to
--      /@gstVideoEncoderFinishFrame@/.
-- 
-- 
-- The [VideoEncoder:qos]("GI.GstVideo.Objects.VideoEncoder#g:attr:qos") property will enable the Quality-of-Service
-- features of the encoder which gather statistics about the real-time
-- performance of the downstream elements. If enabled, subclasses can
-- use 'GI.GstVideo.Objects.VideoEncoder.videoEncoderGetMaxEncodeTime' to check if input frames
-- are already late and drop them right away to give a chance to the
-- pipeline to catch up.

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

module GI.GstVideo.Objects.VideoEncoder
    ( 

-- * Exported types
    VideoEncoder(..)                        ,
    IsVideoEncoder                          ,
    toVideoEncoder                          ,


 -- * 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"), [allocateOutputBuffer]("GI.GstVideo.Objects.VideoEncoder#g:method:allocateOutputBuffer"), [allocateOutputFrame]("GI.GstVideo.Objects.VideoEncoder#g:method:allocateOutputFrame"), [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"), [deletePreset]("GI.Gst.Interfaces.Preset#g:method:deletePreset"), [finishFrame]("GI.GstVideo.Objects.VideoEncoder#g:method:finishFrame"), [finishSubframe]("GI.GstVideo.Objects.VideoEncoder#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"), [isEditable]("GI.Gst.Interfaces.Preset#g:method:isEditable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLockedState]("GI.Gst.Objects.Element#g:method:isLockedState"), [isQosEnabled]("GI.GstVideo.Objects.VideoEncoder#g:method:isQosEnabled"), [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"), [loadPreset]("GI.Gst.Interfaces.Preset#g:method:loadPreset"), [lostState]("GI.Gst.Objects.Element#g:method:lostState"), [mergeTags]("GI.GstVideo.Objects.VideoEncoder#g:method:mergeTags"), [messageFull]("GI.Gst.Objects.Element#g:method:messageFull"), [messageFullWithDetails]("GI.Gst.Objects.Element#g:method:messageFullWithDetails"), [negotiate]("GI.GstVideo.Objects.VideoEncoder#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.VideoEncoder#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"), [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"), [renamePreset]("GI.Gst.Interfaces.Preset#g:method:renamePreset"), [requestPad]("GI.Gst.Objects.Element#g:method:requestPad"), [requestPadSimple]("GI.Gst.Objects.Element#g:method:requestPadSimple"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [savePreset]("GI.Gst.Interfaces.Preset#g:method:savePreset"), [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.VideoEncoder#g:method:getAllocator"), [getBaseTime]("GI.Gst.Objects.Element#g:method:getBaseTime"), [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"), [getFactory]("GI.Gst.Objects.Element#g:method:getFactory"), [getFrame]("GI.GstVideo.Objects.VideoEncoder#g:method:getFrame"), [getFrames]("GI.GstVideo.Objects.VideoEncoder#g:method:getFrames"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getLatency]("GI.GstVideo.Objects.VideoEncoder#g:method:getLatency"), [getMaxEncodeTime]("GI.GstVideo.Objects.VideoEncoder#g:method:getMaxEncodeTime"), [getMeta]("GI.Gst.Interfaces.Preset#g:method:getMeta"), [getMetadata]("GI.Gst.Objects.Element#g:method:getMetadata"), [getMinForceKeyUnitInterval]("GI.GstVideo.Objects.VideoEncoder#g:method:getMinForceKeyUnitInterval"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getOldestFrame]("GI.GstVideo.Objects.VideoEncoder#g:method:getOldestFrame"), [getOutputState]("GI.GstVideo.Objects.VideoEncoder#g:method:getOutputState"), [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"), [getPresetNames]("GI.Gst.Interfaces.Preset#g:method:getPresetNames"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getPropertyNames]("GI.Gst.Interfaces.Preset#g:method:getPropertyNames"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [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"), [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"), [setHeaders]("GI.GstVideo.Objects.VideoEncoder#g:method:setHeaders"), [setLatency]("GI.GstVideo.Objects.VideoEncoder#g:method:setLatency"), [setLockedState]("GI.Gst.Objects.Element#g:method:setLockedState"), [setMeta]("GI.Gst.Interfaces.Preset#g:method:setMeta"), [setMinForceKeyUnitInterval]("GI.GstVideo.Objects.VideoEncoder#g:method:setMinForceKeyUnitInterval"), [setMinPts]("GI.GstVideo.Objects.VideoEncoder#g:method:setMinPts"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setOutputState]("GI.GstVideo.Objects.VideoEncoder#g:method:setOutputState"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQosEnabled]("GI.GstVideo.Objects.VideoEncoder#g:method:setQosEnabled"), [setStartTime]("GI.Gst.Objects.Element#g:method:setStartTime"), [setState]("GI.Gst.Objects.Element#g:method:setState").

#if defined(ENABLE_OVERLOADING)
    ResolveVideoEncoderMethod               ,
#endif

-- ** allocateOutputBuffer #method:allocateOutputBuffer#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderAllocateOutputBufferMethodInfo,
#endif
    videoEncoderAllocateOutputBuffer        ,


-- ** allocateOutputFrame #method:allocateOutputFrame#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderAllocateOutputFrameMethodInfo,
#endif
    videoEncoderAllocateOutputFrame         ,


-- ** finishFrame #method:finishFrame#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderFinishFrameMethodInfo       ,
#endif
    videoEncoderFinishFrame                 ,


-- ** finishSubframe #method:finishSubframe#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderFinishSubframeMethodInfo    ,
#endif
    videoEncoderFinishSubframe              ,


-- ** getAllocator #method:getAllocator#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetAllocatorMethodInfo      ,
#endif
    videoEncoderGetAllocator                ,


-- ** getFrame #method:getFrame#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetFrameMethodInfo          ,
#endif
    videoEncoderGetFrame                    ,


-- ** getFrames #method:getFrames#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetFramesMethodInfo         ,
#endif
    videoEncoderGetFrames                   ,


-- ** getLatency #method:getLatency#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetLatencyMethodInfo        ,
#endif
    videoEncoderGetLatency                  ,


-- ** getMaxEncodeTime #method:getMaxEncodeTime#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetMaxEncodeTimeMethodInfo  ,
#endif
    videoEncoderGetMaxEncodeTime            ,


-- ** getMinForceKeyUnitInterval #method:getMinForceKeyUnitInterval#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetMinForceKeyUnitIntervalMethodInfo,
#endif
    videoEncoderGetMinForceKeyUnitInterval  ,


-- ** getOldestFrame #method:getOldestFrame#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetOldestFrameMethodInfo    ,
#endif
    videoEncoderGetOldestFrame              ,


-- ** getOutputState #method:getOutputState#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderGetOutputStateMethodInfo    ,
#endif
    videoEncoderGetOutputState              ,


-- ** isQosEnabled #method:isQosEnabled#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderIsQosEnabledMethodInfo      ,
#endif
    videoEncoderIsQosEnabled                ,


-- ** mergeTags #method:mergeTags#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderMergeTagsMethodInfo         ,
#endif
    videoEncoderMergeTags                   ,


-- ** negotiate #method:negotiate#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderNegotiateMethodInfo         ,
#endif
    videoEncoderNegotiate                   ,


-- ** proxyGetcaps #method:proxyGetcaps#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderProxyGetcapsMethodInfo      ,
#endif
    videoEncoderProxyGetcaps                ,


-- ** setHeaders #method:setHeaders#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderSetHeadersMethodInfo        ,
#endif
    videoEncoderSetHeaders                  ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderSetLatencyMethodInfo        ,
#endif
    videoEncoderSetLatency                  ,


-- ** setMinForceKeyUnitInterval #method:setMinForceKeyUnitInterval#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderSetMinForceKeyUnitIntervalMethodInfo,
#endif
    videoEncoderSetMinForceKeyUnitInterval  ,


-- ** setMinPts #method:setMinPts#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderSetMinPtsMethodInfo         ,
#endif
    videoEncoderSetMinPts                   ,


-- ** setOutputState #method:setOutputState#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderSetOutputStateMethodInfo    ,
#endif
    videoEncoderSetOutputState              ,


-- ** setQosEnabled #method:setQosEnabled#

#if defined(ENABLE_OVERLOADING)
    VideoEncoderSetQosEnabledMethodInfo     ,
#endif
    videoEncoderSetQosEnabled               ,




 -- * Properties


-- ** minForceKeyUnitInterval #attr:minForceKeyUnitInterval#
-- | Minimum interval between force-keyunit requests in nanoseconds. See
-- 'GI.GstVideo.Objects.VideoEncoder.videoEncoderSetMinForceKeyUnitInterval' for more details.
-- 
-- /Since: 1.18/

#if defined(ENABLE_OVERLOADING)
    VideoEncoderMinForceKeyUnitIntervalPropertyInfo,
#endif
    constructVideoEncoderMinForceKeyUnitInterval,
    getVideoEncoderMinForceKeyUnitInterval  ,
    setVideoEncoderMinForceKeyUnitInterval  ,
#if defined(ENABLE_OVERLOADING)
    videoEncoderMinForceKeyUnitInterval     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    VideoEncoderQosPropertyInfo             ,
#endif
    constructVideoEncoderQos                ,
    getVideoEncoderQos                      ,
    setVideoEncoderQos                      ,
#if defined(ENABLE_OVERLOADING)
    videoEncoderQos                         ,
#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.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.Interfaces.Preset as Gst.Preset
import qualified GI.Gst.Objects.Allocator as Gst.Allocator
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.Caps as Gst.Caps
import qualified GI.Gst.Structs.TagList as Gst.TagList
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 VideoEncoder = VideoEncoder (SP.ManagedPtr VideoEncoder)
    deriving (VideoEncoder -> VideoEncoder -> Bool
(VideoEncoder -> VideoEncoder -> Bool)
-> (VideoEncoder -> VideoEncoder -> Bool) -> Eq VideoEncoder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VideoEncoder -> VideoEncoder -> Bool
== :: VideoEncoder -> VideoEncoder -> Bool
$c/= :: VideoEncoder -> VideoEncoder -> Bool
/= :: VideoEncoder -> VideoEncoder -> Bool
Eq)

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

foreign import ccall "gst_video_encoder_get_type"
    c_gst_video_encoder_get_type :: IO B.Types.GType

instance B.Types.TypedObject VideoEncoder where
    glibType :: IO GType
glibType = IO GType
c_gst_video_encoder_get_type

instance B.Types.GObject VideoEncoder

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

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

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

-- | Convert 'VideoEncoder' 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 VideoEncoder) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_video_encoder_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VideoEncoder -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VideoEncoder
P.Nothing = Ptr GValue -> Ptr VideoEncoder -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr VideoEncoder
forall a. Ptr a
FP.nullPtr :: FP.Ptr VideoEncoder)
    gvalueSet_ Ptr GValue
gv (P.Just VideoEncoder
obj) = VideoEncoder -> (Ptr VideoEncoder -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoEncoder
obj (Ptr GValue -> Ptr VideoEncoder -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VideoEncoder)
gvalueGet_ Ptr GValue
gv = do
        Ptr VideoEncoder
ptr <- Ptr GValue -> IO (Ptr VideoEncoder)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr VideoEncoder)
        if Ptr VideoEncoder
ptr Ptr VideoEncoder -> Ptr VideoEncoder -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VideoEncoder
forall a. Ptr a
FP.nullPtr
        then VideoEncoder -> Maybe VideoEncoder
forall a. a -> Maybe a
P.Just (VideoEncoder -> Maybe VideoEncoder)
-> IO VideoEncoder -> IO (Maybe VideoEncoder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VideoEncoder -> VideoEncoder)
-> Ptr VideoEncoder -> IO VideoEncoder
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VideoEncoder -> VideoEncoder
VideoEncoder Ptr VideoEncoder
ptr
        else Maybe VideoEncoder -> IO (Maybe VideoEncoder)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoEncoder
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoEncoderMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoEncoderMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveVideoEncoderMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveVideoEncoderMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveVideoEncoderMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveVideoEncoderMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveVideoEncoderMethod "allocateOutputBuffer" o = VideoEncoderAllocateOutputBufferMethodInfo
    ResolveVideoEncoderMethod "allocateOutputFrame" o = VideoEncoderAllocateOutputFrameMethodInfo
    ResolveVideoEncoderMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVideoEncoderMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVideoEncoderMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveVideoEncoderMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveVideoEncoderMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveVideoEncoderMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveVideoEncoderMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveVideoEncoderMethod "deletePreset" o = Gst.Preset.PresetDeletePresetMethodInfo
    ResolveVideoEncoderMethod "finishFrame" o = VideoEncoderFinishFrameMethodInfo
    ResolveVideoEncoderMethod "finishSubframe" o = VideoEncoderFinishSubframeMethodInfo
    ResolveVideoEncoderMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVideoEncoderMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveVideoEncoderMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveVideoEncoderMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveVideoEncoderMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVideoEncoderMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVideoEncoderMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveVideoEncoderMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveVideoEncoderMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveVideoEncoderMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveVideoEncoderMethod "isEditable" o = Gst.Preset.PresetIsEditableMethodInfo
    ResolveVideoEncoderMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVideoEncoderMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveVideoEncoderMethod "isQosEnabled" o = VideoEncoderIsQosEnabledMethodInfo
    ResolveVideoEncoderMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveVideoEncoderMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveVideoEncoderMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveVideoEncoderMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveVideoEncoderMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveVideoEncoderMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveVideoEncoderMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveVideoEncoderMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveVideoEncoderMethod "loadPreset" o = Gst.Preset.PresetLoadPresetMethodInfo
    ResolveVideoEncoderMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveVideoEncoderMethod "mergeTags" o = VideoEncoderMergeTagsMethodInfo
    ResolveVideoEncoderMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveVideoEncoderMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveVideoEncoderMethod "negotiate" o = VideoEncoderNegotiateMethodInfo
    ResolveVideoEncoderMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveVideoEncoderMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVideoEncoderMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVideoEncoderMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveVideoEncoderMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveVideoEncoderMethod "proxyGetcaps" o = VideoEncoderProxyGetcapsMethodInfo
    ResolveVideoEncoderMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveVideoEncoderMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveVideoEncoderMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveVideoEncoderMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveVideoEncoderMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveVideoEncoderMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVideoEncoderMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveVideoEncoderMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveVideoEncoderMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveVideoEncoderMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveVideoEncoderMethod "renamePreset" o = Gst.Preset.PresetRenamePresetMethodInfo
    ResolveVideoEncoderMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveVideoEncoderMethod "requestPadSimple" o = Gst.Element.ElementRequestPadSimpleMethodInfo
    ResolveVideoEncoderMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVideoEncoderMethod "savePreset" o = Gst.Preset.PresetSavePresetMethodInfo
    ResolveVideoEncoderMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveVideoEncoderMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveVideoEncoderMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveVideoEncoderMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVideoEncoderMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVideoEncoderMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveVideoEncoderMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveVideoEncoderMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveVideoEncoderMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVideoEncoderMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveVideoEncoderMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveVideoEncoderMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveVideoEncoderMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveVideoEncoderMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVideoEncoderMethod "getAllocator" o = VideoEncoderGetAllocatorMethodInfo
    ResolveVideoEncoderMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveVideoEncoderMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveVideoEncoderMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveVideoEncoderMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveVideoEncoderMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveVideoEncoderMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveVideoEncoderMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveVideoEncoderMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveVideoEncoderMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveVideoEncoderMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveVideoEncoderMethod "getCurrentClockTime" o = Gst.Element.ElementGetCurrentClockTimeMethodInfo
    ResolveVideoEncoderMethod "getCurrentRunningTime" o = Gst.Element.ElementGetCurrentRunningTimeMethodInfo
    ResolveVideoEncoderMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVideoEncoderMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveVideoEncoderMethod "getFrame" o = VideoEncoderGetFrameMethodInfo
    ResolveVideoEncoderMethod "getFrames" o = VideoEncoderGetFramesMethodInfo
    ResolveVideoEncoderMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveVideoEncoderMethod "getLatency" o = VideoEncoderGetLatencyMethodInfo
    ResolveVideoEncoderMethod "getMaxEncodeTime" o = VideoEncoderGetMaxEncodeTimeMethodInfo
    ResolveVideoEncoderMethod "getMeta" o = Gst.Preset.PresetGetMetaMethodInfo
    ResolveVideoEncoderMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveVideoEncoderMethod "getMinForceKeyUnitInterval" o = VideoEncoderGetMinForceKeyUnitIntervalMethodInfo
    ResolveVideoEncoderMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveVideoEncoderMethod "getOldestFrame" o = VideoEncoderGetOldestFrameMethodInfo
    ResolveVideoEncoderMethod "getOutputState" o = VideoEncoderGetOutputStateMethodInfo
    ResolveVideoEncoderMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveVideoEncoderMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveVideoEncoderMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveVideoEncoderMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveVideoEncoderMethod "getPresetNames" o = Gst.Preset.PresetGetPresetNamesMethodInfo
    ResolveVideoEncoderMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVideoEncoderMethod "getPropertyNames" o = Gst.Preset.PresetGetPropertyNamesMethodInfo
    ResolveVideoEncoderMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVideoEncoderMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveVideoEncoderMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveVideoEncoderMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveVideoEncoderMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveVideoEncoderMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveVideoEncoderMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveVideoEncoderMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveVideoEncoderMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveVideoEncoderMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveVideoEncoderMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveVideoEncoderMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveVideoEncoderMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveVideoEncoderMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVideoEncoderMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVideoEncoderMethod "setHeaders" o = VideoEncoderSetHeadersMethodInfo
    ResolveVideoEncoderMethod "setLatency" o = VideoEncoderSetLatencyMethodInfo
    ResolveVideoEncoderMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveVideoEncoderMethod "setMeta" o = Gst.Preset.PresetSetMetaMethodInfo
    ResolveVideoEncoderMethod "setMinForceKeyUnitInterval" o = VideoEncoderSetMinForceKeyUnitIntervalMethodInfo
    ResolveVideoEncoderMethod "setMinPts" o = VideoEncoderSetMinPtsMethodInfo
    ResolveVideoEncoderMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveVideoEncoderMethod "setOutputState" o = VideoEncoderSetOutputStateMethodInfo
    ResolveVideoEncoderMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveVideoEncoderMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVideoEncoderMethod "setQosEnabled" o = VideoEncoderSetQosEnabledMethodInfo
    ResolveVideoEncoderMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveVideoEncoderMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveVideoEncoderMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveVideoEncoderMethod t VideoEncoder, O.OverloadedMethod info VideoEncoder p) => OL.IsLabel t (VideoEncoder -> 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 ~ ResolveVideoEncoderMethod t VideoEncoder, O.OverloadedMethod info VideoEncoder p, R.HasField t VideoEncoder p) => R.HasField t VideoEncoder p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

-- | 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' videoEncoder #minForceKeyUnitInterval
-- @
getVideoEncoderMinForceKeyUnitInterval :: (MonadIO m, IsVideoEncoder o) => o -> m Word64
getVideoEncoderMinForceKeyUnitInterval :: forall (m :: * -> *) o.
(MonadIO m, IsVideoEncoder o) =>
o -> m Word64
getVideoEncoderMinForceKeyUnitInterval 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' videoEncoder [ #minForceKeyUnitInterval 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoEncoderMinForceKeyUnitInterval :: (MonadIO m, IsVideoEncoder o) => o -> Word64 -> m ()
setVideoEncoderMinForceKeyUnitInterval :: forall (m :: * -> *) o.
(MonadIO m, IsVideoEncoder o) =>
o -> Word64 -> m ()
setVideoEncoderMinForceKeyUnitInterval 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`.
constructVideoEncoderMinForceKeyUnitInterval :: (IsVideoEncoder o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructVideoEncoderMinForceKeyUnitInterval :: forall o (m :: * -> *).
(IsVideoEncoder o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructVideoEncoderMinForceKeyUnitInterval 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 VideoEncoderMinForceKeyUnitIntervalPropertyInfo
instance AttrInfo VideoEncoderMinForceKeyUnitIntervalPropertyInfo where
    type AttrAllowedOps VideoEncoderMinForceKeyUnitIntervalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoEncoderMinForceKeyUnitIntervalPropertyInfo = IsVideoEncoder
    type AttrSetTypeConstraint VideoEncoderMinForceKeyUnitIntervalPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint VideoEncoderMinForceKeyUnitIntervalPropertyInfo = (~) Word64
    type AttrTransferType VideoEncoderMinForceKeyUnitIntervalPropertyInfo = Word64
    type AttrGetType VideoEncoderMinForceKeyUnitIntervalPropertyInfo = Word64
    type AttrLabel VideoEncoderMinForceKeyUnitIntervalPropertyInfo = "min-force-key-unit-interval"
    type AttrOrigin VideoEncoderMinForceKeyUnitIntervalPropertyInfo = VideoEncoder
    attrGet = getVideoEncoderMinForceKeyUnitInterval
    attrSet = setVideoEncoderMinForceKeyUnitInterval
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoEncoderMinForceKeyUnitInterval
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoEncoder.minForceKeyUnitInterval"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.26/docs/GI-GstVideo-Objects-VideoEncoder.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' videoEncoder #qos
-- @
getVideoEncoderQos :: (MonadIO m, IsVideoEncoder o) => o -> m Bool
getVideoEncoderQos :: forall (m :: * -> *) o.
(MonadIO m, IsVideoEncoder o) =>
o -> m Bool
getVideoEncoderQos 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' videoEncoder [ #qos 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoEncoderQos :: (MonadIO m, IsVideoEncoder o) => o -> Bool -> m ()
setVideoEncoderQos :: forall (m :: * -> *) o.
(MonadIO m, IsVideoEncoder o) =>
o -> Bool -> m ()
setVideoEncoderQos 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`.
constructVideoEncoderQos :: (IsVideoEncoder o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructVideoEncoderQos :: forall o (m :: * -> *).
(IsVideoEncoder o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructVideoEncoderQos 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 VideoEncoderQosPropertyInfo
instance AttrInfo VideoEncoderQosPropertyInfo where
    type AttrAllowedOps VideoEncoderQosPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VideoEncoderQosPropertyInfo = IsVideoEncoder
    type AttrSetTypeConstraint VideoEncoderQosPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint VideoEncoderQosPropertyInfo = (~) Bool
    type AttrTransferType VideoEncoderQosPropertyInfo = Bool
    type AttrGetType VideoEncoderQosPropertyInfo = Bool
    type AttrLabel VideoEncoderQosPropertyInfo = "qos"
    type AttrOrigin VideoEncoderQosPropertyInfo = VideoEncoder
    attrGet = getVideoEncoderQos
    attrSet = setVideoEncoderQos
    attrTransfer _ v = do
        return v
    attrConstruct = constructVideoEncoderQos
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Objects.VideoEncoder.qos"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.26/docs/GI-GstVideo-Objects-VideoEncoder.html#g:attr:qos"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoEncoder
type instance O.AttributeList VideoEncoder = VideoEncoderAttributeList
type VideoEncoderAttributeList = ('[ '("minForceKeyUnitInterval", VideoEncoderMinForceKeyUnitIntervalPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("qos", VideoEncoderQosPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
videoEncoderMinForceKeyUnitInterval :: AttrLabelProxy "minForceKeyUnitInterval"
videoEncoderMinForceKeyUnitInterval = AttrLabelProxy

videoEncoderQos :: AttrLabelProxy "qos"
videoEncoderQos = AttrLabelProxy

#endif

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

#endif

-- method VideoEncoder::allocate_output_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of the buffer" , 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_encoder_allocate_output_buffer" gst_video_encoder_allocate_output_buffer :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Word64 ->                               -- size : TBasicType TUInt64
    IO (Ptr Gst.Buffer.Buffer)

-- | Helper function that allocates a buffer to hold an encoded video frame
-- for /@encoder@/\'s current t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'.
videoEncoderAllocateOutputBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> Word64
    -- ^ /@size@/: size of the buffer
    -> m Gst.Buffer.Buffer
    -- ^ __Returns:__ allocated buffer
videoEncoderAllocateOutputBuffer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Word64 -> m Buffer
videoEncoderAllocateOutputBuffer a
encoder Word64
size = IO Buffer -> m Buffer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr Buffer
result <- Ptr VideoEncoder -> Word64 -> IO (Ptr Buffer)
gst_video_encoder_allocate_output_buffer Ptr VideoEncoder
encoder' Word64
size
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoEncoderAllocateOutputBuffer" Ptr Buffer
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderAllocateOutputBufferMethodInfo
instance (signature ~ (Word64 -> m Gst.Buffer.Buffer), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderAllocateOutputBufferMethodInfo a signature where
    overloadedMethod = videoEncoderAllocateOutputBuffer

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


#endif

-- method VideoEncoder::allocate_output_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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 = "size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of the buffer" , 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_encoder_allocate_output_frame" gst_video_encoder_allocate_output_frame :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    Word64 ->                               -- size : TBasicType TUInt64
    IO CInt

-- | Helper function that allocates a buffer to hold an encoded video frame for /@encoder@/\'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.
videoEncoderAllocateOutputFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> Word64
    -- ^ /@size@/: size of the buffer
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ 'GI.Gst.Enums.FlowReturnOk' if an output buffer could be allocated
videoEncoderAllocateOutputFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> VideoCodecFrame -> Word64 -> m FlowReturn
videoEncoderAllocateOutputFrame a
encoder VideoCodecFrame
frame Word64
size = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    CInt
result <- Ptr VideoEncoder -> Ptr VideoCodecFrame -> Word64 -> IO CInt
gst_video_encoder_allocate_output_frame Ptr VideoEncoder
encoder' Ptr VideoCodecFrame
frame' Word64
size
    let result' :: FlowReturn
result' = (Int -> FlowReturn
forall a. Enum a => Int -> a
toEnum (Int -> FlowReturn) -> (CInt -> Int) -> CInt -> FlowReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    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 VideoEncoderAllocateOutputFrameMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> Word64 -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderAllocateOutputFrameMethodInfo a signature where
    overloadedMethod = videoEncoderAllocateOutputFrame

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


#endif

-- method VideoEncoder::finish_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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 "an encoded #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_encoder_finish_frame" gst_video_encoder_finish_frame :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | /@frame@/ must have a valid encoded data buffer, whose metadata fields
-- are then appropriately set according to frame data or no buffer at
-- all if the frame should be dropped.
-- It is subsequently pushed downstream or provided to /@prePush@/.
-- 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.
videoEncoderFinishFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: an encoded t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' resulting from sending data downstream
videoEncoderFinishFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoEncoderFinishFrame a
encoder 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed VideoCodecFrame
frame
    CInt
result <- Ptr VideoEncoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_encoder_finish_frame Ptr VideoEncoder
encoder' 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
encoder
    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 VideoEncoderFinishFrameMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderFinishFrameMethodInfo a signature where
    overloadedMethod = videoEncoderFinishFrame

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


#endif

-- method VideoEncoder::finish_subframe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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 being encoded"
--                 , 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_encoder_finish_subframe" gst_video_encoder_finish_subframe :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO CInt

-- | If multiple subframes are produced for one input frame then use this method
-- for each subframe, except for the last one. Before calling this function,
-- you need to fill frame->output_buffer with the encoded buffer to push.
-- 
-- You must call @/gst_video_encoder_finish_frame/@() for the last sub-frame
-- to tell the encoder that the frame has been fully encoded.
-- 
-- This function will change the metadata of /@frame@/ and frame->output_buffer
-- will be pushed downstream.
-- 
-- /Since: 1.18/
videoEncoderFinishSubframe ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' being encoded
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' resulting from pushing the buffer downstream.
videoEncoderFinishSubframe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> VideoCodecFrame -> m FlowReturn
videoEncoderFinishSubframe a
encoder 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    CInt
result <- Ptr VideoEncoder -> Ptr VideoCodecFrame -> IO CInt
gst_video_encoder_finish_subframe Ptr VideoEncoder
encoder' 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
encoder
    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 VideoEncoderFinishSubframeMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Gst.Enums.FlowReturn), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderFinishSubframeMethodInfo a signature where
    overloadedMethod = videoEncoderFinishSubframe

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


#endif

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

foreign import ccall "gst_video_encoder_get_allocator" gst_video_encoder_get_allocator :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    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.VideoEncoder.VideoEncoder' sub-classes to know the memory /@allocator@/
-- used by the base class and its /@params@/.
-- 
-- Unref the /@allocator@/ after use it.
videoEncoderGetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
videoEncoderGetAllocator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m (Allocator, AllocationParams)
videoEncoderGetAllocator a
encoder = IO (Allocator, AllocationParams) -> m (Allocator, AllocationParams)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocator, AllocationParams)
 -> m (Allocator, AllocationParams))
-> IO (Allocator, AllocationParams)
-> m (Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    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 VideoEncoder
-> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO ()
gst_video_encoder_get_allocator Ptr VideoEncoder
encoder' Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Allocator
allocator'' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator'
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, 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
encoder
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Allocator, AllocationParams) -> IO (Allocator, AllocationParams)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocator
allocator'', AllocationParams
params')

#if defined(ENABLE_OVERLOADING)
data VideoEncoderGetAllocatorMethodInfo
instance (signature ~ (m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetAllocatorMethodInfo a signature where
    overloadedMethod = videoEncoderGetAllocator

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


#endif

-- method VideoEncoder::get_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_get_frame" gst_video_encoder_get_frame :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Int32 ->                                -- frame_number : TBasicType TInt
    IO (Ptr GstVideo.VideoCodecFrame.VideoCodecFrame)

-- | Get a pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoEncoderGetFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> Int32
    -- ^ /@frameNumber@/: system_frame_number of a frame
    -> m GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ __Returns:__ pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame' identified by /@frameNumber@/.
videoEncoderGetFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Int32 -> m VideoCodecFrame
videoEncoderGetFrame a
encoder Int32
frameNumber = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecFrame
result <- Ptr VideoEncoder -> Int32 -> IO (Ptr VideoCodecFrame)
gst_video_encoder_get_frame Ptr VideoEncoder
encoder' Int32
frameNumber
    Text -> Ptr VideoCodecFrame -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoEncoderGetFrame" Ptr VideoCodecFrame
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    VideoCodecFrame -> IO VideoCodecFrame
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecFrame
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderGetFrameMethodInfo
instance (signature ~ (Int32 -> m GstVideo.VideoCodecFrame.VideoCodecFrame), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetFrameMethodInfo a signature where
    overloadedMethod = videoEncoderGetFrame

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


#endif

-- method VideoEncoder::get_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_get_frames" gst_video_encoder_get_frames :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    IO (Ptr (GList (Ptr GstVideo.VideoCodecFrame.VideoCodecFrame)))

-- | Get all pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoEncoderGetFrames ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> m [GstVideo.VideoCodecFrame.VideoCodecFrame]
    -- ^ __Returns:__ pending unfinished t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'.
videoEncoderGetFrames :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m [VideoCodecFrame]
videoEncoderGetFrames a
encoder = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr (GList (Ptr VideoCodecFrame))
result <- Ptr VideoEncoder -> IO (Ptr (GList (Ptr VideoCodecFrame)))
gst_video_encoder_get_frames Ptr VideoEncoder
encoder'
    [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
encoder
    [VideoCodecFrame] -> IO [VideoCodecFrame]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [VideoCodecFrame]
result''

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

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


#endif

-- method VideoEncoder::get_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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 maximum 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_encoder_get_latency" gst_video_encoder_get_latency :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr Word64 ->                           -- min_latency : TBasicType TUInt64
    Ptr Word64 ->                           -- max_latency : TBasicType TUInt64
    IO ()

-- | Query the configured encoding latency. Results will be returned via
-- /@minLatency@/ and /@maxLatency@/.
videoEncoderGetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> m ((Word64, Word64))
videoEncoderGetLatency :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m (Word64, Word64)
videoEncoderGetLatency a
encoder = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    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 VideoEncoder -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_video_encoder_get_latency Ptr VideoEncoder
encoder' 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
encoder
    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 VideoEncoderGetLatencyMethodInfo
instance (signature ~ (m ((Word64, Word64))), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetLatencyMethodInfo a signature where
    overloadedMethod = videoEncoderGetLatency

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


#endif

-- method VideoEncoder::get_max_encode_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_get_max_encode_time" gst_video_encoder_get_max_encode_time :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr GstVideo.VideoCodecFrame.VideoCodecFrame -> -- frame : TInterface (Name {namespace = "GstVideo", name = "VideoCodecFrame"})
    IO Int64

-- | Determines maximum possible encoding time for /@frame@/ that will
-- allow it to encode and arrive in time (as determined by QoS events).
-- In particular, a negative result means encoding in time is no longer possible
-- and should therefore occur as soon\/skippy as possible.
-- 
-- If no QoS events have been received from downstream, or if
-- [VideoEncoder:qos]("GI.GstVideo.Objects.VideoEncoder#g:attr:qos") is disabled this function returns 'GI.GLib.Constants.MAXINT64'.
-- 
-- /Since: 1.14/
videoEncoderGetMaxEncodeTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ /@frame@/: a t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
    -> m Int64
    -- ^ __Returns:__ max decoding time.
videoEncoderGetMaxEncodeTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> VideoCodecFrame -> m Int64
videoEncoderGetMaxEncodeTime a
encoder 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecFrame
frame' <- VideoCodecFrame -> IO (Ptr VideoCodecFrame)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoCodecFrame
frame
    Int64
result <- Ptr VideoEncoder -> Ptr VideoCodecFrame -> IO Int64
gst_video_encoder_get_max_encode_time Ptr VideoEncoder
encoder' Ptr VideoCodecFrame
frame'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    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 VideoEncoderGetMaxEncodeTimeMethodInfo
instance (signature ~ (GstVideo.VideoCodecFrame.VideoCodecFrame -> m Int64), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetMaxEncodeTimeMethodInfo a signature where
    overloadedMethod = videoEncoderGetMaxEncodeTime

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


#endif

-- method VideoEncoder::get_min_force_key_unit_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the encoder" , 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_encoder_get_min_force_key_unit_interval" gst_video_encoder_get_min_force_key_unit_interval :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    IO Word64

-- | Returns the minimum force-keyunit interval, see 'GI.GstVideo.Objects.VideoEncoder.videoEncoderSetMinForceKeyUnitInterval'
-- for more details.
-- 
-- /Since: 1.18/
videoEncoderGetMinForceKeyUnitInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: the encoder
    -> m Word64
    -- ^ __Returns:__ the minimum force-keyunit interval
videoEncoderGetMinForceKeyUnitInterval :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m Word64
videoEncoderGetMinForceKeyUnitInterval a
encoder = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Word64
result <- Ptr VideoEncoder -> IO Word64
gst_video_encoder_get_min_force_key_unit_interval Ptr VideoEncoder
encoder'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data VideoEncoderGetMinForceKeyUnitIntervalMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetMinForceKeyUnitIntervalMethodInfo a signature where
    overloadedMethod = videoEncoderGetMinForceKeyUnitInterval

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


#endif

-- method VideoEncoder::get_oldest_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_get_oldest_frame" gst_video_encoder_get_oldest_frame :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    IO (Ptr GstVideo.VideoCodecFrame.VideoCodecFrame)

-- | Get the oldest unfinished pending t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoEncoderGetOldestFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> m GstVideo.VideoCodecFrame.VideoCodecFrame
    -- ^ __Returns:__ oldest unfinished pending t'GI.GstVideo.Structs.VideoCodecFrame.VideoCodecFrame'
videoEncoderGetOldestFrame :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m VideoCodecFrame
videoEncoderGetOldestFrame a
encoder = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecFrame
result <- Ptr VideoEncoder -> IO (Ptr VideoCodecFrame)
gst_video_encoder_get_oldest_frame Ptr VideoEncoder
encoder'
    Text -> Ptr VideoCodecFrame -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoEncoderGetOldestFrame" Ptr VideoCodecFrame
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    VideoCodecFrame -> IO VideoCodecFrame
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecFrame
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderGetOldestFrameMethodInfo
instance (signature ~ (m GstVideo.VideoCodecFrame.VideoCodecFrame), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetOldestFrameMethodInfo a signature where
    overloadedMethod = videoEncoderGetOldestFrame

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


#endif

-- method VideoEncoder::get_output_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_get_output_state" gst_video_encoder_get_output_state :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    IO (Ptr GstVideo.VideoCodecState.VideoCodecState)

-- | Get the current t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'
videoEncoderGetOutputState ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> m GstVideo.VideoCodecState.VideoCodecState
    -- ^ __Returns:__ t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState' describing format of video data.
videoEncoderGetOutputState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m VideoCodecState
videoEncoderGetOutputState a
encoder = IO VideoCodecState -> m VideoCodecState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoCodecState -> m VideoCodecState)
-> IO VideoCodecState -> m VideoCodecState
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoCodecState
result <- Ptr VideoEncoder -> IO (Ptr VideoCodecState)
gst_video_encoder_get_output_state Ptr VideoEncoder
encoder'
    Text -> Ptr VideoCodecState -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoEncoderGetOutputState" Ptr VideoCodecState
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    VideoCodecState -> IO VideoCodecState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecState
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderGetOutputStateMethodInfo
instance (signature ~ (m GstVideo.VideoCodecState.VideoCodecState), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderGetOutputStateMethodInfo a signature where
    overloadedMethod = videoEncoderGetOutputState

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


#endif

-- method VideoEncoder::is_qos_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the encoder" , 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_encoder_is_qos_enabled" gst_video_encoder_is_qos_enabled :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    IO CInt

-- | Checks if /@encoder@/ is currently configured to handle Quality-of-Service
-- events from downstream.
-- 
-- /Since: 1.14/
videoEncoderIsQosEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: the encoder
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the encoder is configured to perform Quality-of-Service.
videoEncoderIsQosEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m Bool
videoEncoderIsQosEnabled a
encoder = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    CInt
result <- Ptr VideoEncoder -> IO CInt
gst_video_encoder_is_qos_enabled Ptr VideoEncoder
encoder'
    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
encoder
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderIsQosEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderIsQosEnabledMethodInfo a signature where
    overloadedMethod = videoEncoderIsQosEnabled

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


#endif

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

-- | Sets the video encoder tags and how they should be merged with any
-- upstream stream tags. This will override any tags previously-set
-- with 'GI.GstVideo.Objects.VideoEncoder.videoEncoderMergeTags'.
-- 
-- 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.
videoEncoderMergeTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> 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 ()
videoEncoderMergeTags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Maybe TagList -> TagMergeMode -> m ()
videoEncoderMergeTags a
encoder 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    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 VideoEncoder -> Ptr TagList -> CUInt -> IO ()
gst_video_encoder_merge_tags Ptr VideoEncoder
encoder' Ptr TagList
maybeTags CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    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 VideoEncoderMergeTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> Gst.Enums.TagMergeMode -> m ()), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderMergeTagsMethodInfo a signature where
    overloadedMethod = videoEncoderMergeTags

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


#endif

-- method VideoEncoder::negotiate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_negotiate" gst_video_encoder_negotiate :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    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.
videoEncoderNegotiate ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the negotiation succeeded, else 'P.False'.
videoEncoderNegotiate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> m Bool
videoEncoderNegotiate a
encoder = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    CInt
result <- Ptr VideoEncoder -> IO CInt
gst_video_encoder_negotiate Ptr VideoEncoder
encoder'
    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
encoder
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderNegotiateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderNegotiateMethodInfo a signature where
    overloadedMethod = videoEncoderNegotiate

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


#endif

-- method VideoEncoder::proxy_getcaps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , 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_encoder_proxy_getcaps" gst_video_encoder_proxy_getcaps :: 
    Ptr VideoEncoder ->                     -- enc : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    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 (e.g. muxers).
videoEncoderProxyGetcaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> 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
videoEncoderProxyGetcaps :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Maybe Caps -> Maybe Caps -> m Caps
videoEncoderProxyGetcaps a
enc 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 VideoEncoder
enc' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    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 VideoEncoder -> Ptr Caps -> Ptr Caps -> IO (Ptr Caps)
gst_video_encoder_proxy_getcaps Ptr VideoEncoder
enc' Ptr Caps
maybeCaps Ptr Caps
maybeFilter
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoEncoderProxyGetcaps" 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
enc
    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 VideoEncoderProxyGetcapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> Maybe (Gst.Caps.Caps) -> m Gst.Caps.Caps), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderProxyGetcapsMethodInfo a signature where
    overloadedMethod = videoEncoderProxyGetcaps

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


#endif

-- method VideoEncoder::set_headers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "headers"
--           , argType =
--               TGList (TInterface Name { namespace = "Gst" , name = "Buffer" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a list of #GstBuffer containing the codec header"
--                 , 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_encoder_set_headers" gst_video_encoder_set_headers :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr (GList (Ptr Gst.Buffer.Buffer)) ->  -- headers : TGList (TInterface (Name {namespace = "Gst", name = "Buffer"}))
    IO ()

-- | Set the codec headers to be sent downstream whenever requested.
videoEncoderSetHeaders ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> [Gst.Buffer.Buffer]
    -- ^ /@headers@/: a list of t'GI.Gst.Structs.Buffer.Buffer' containing the codec header
    -> m ()
videoEncoderSetHeaders :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> [Buffer] -> m ()
videoEncoderSetHeaders a
encoder [Buffer]
headers = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    [Ptr Buffer]
headers' <- (Buffer -> IO (Ptr Buffer)) -> [Buffer] -> IO [Ptr Buffer]
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 Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [Buffer]
headers
    Ptr (GList (Ptr Buffer))
headers'' <- [Ptr Buffer] -> IO (Ptr (GList (Ptr Buffer)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr Buffer]
headers'
    Ptr VideoEncoder -> Ptr (GList (Ptr Buffer)) -> IO ()
gst_video_encoder_set_headers Ptr VideoEncoder
encoder' Ptr (GList (Ptr Buffer))
headers''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    (Buffer -> IO ()) -> [Buffer] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Buffer]
headers
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoEncoderSetHeadersMethodInfo
instance (signature ~ ([Gst.Buffer.Buffer] -> m ()), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderSetHeadersMethodInfo a signature where
    overloadedMethod = videoEncoderSetHeaders

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


#endif

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

-- | Informs baseclass of encoding latency.
videoEncoderSetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> Word64
    -- ^ /@minLatency@/: minimum latency
    -> Word64
    -- ^ /@maxLatency@/: maximum latency
    -> m ()
videoEncoderSetLatency :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Word64 -> Word64 -> m ()
videoEncoderSetLatency a
encoder 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoEncoder -> Word64 -> Word64 -> IO ()
gst_video_encoder_set_latency Ptr VideoEncoder
encoder' Word64
minLatency Word64
maxLatency
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoEncoderSetLatencyMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ()), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderSetLatencyMethodInfo a signature where
    overloadedMethod = videoEncoderSetLatency

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


#endif

-- method VideoEncoder::set_min_force_key_unit_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the encoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "minimum interval" , 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_encoder_set_min_force_key_unit_interval" gst_video_encoder_set_min_force_key_unit_interval :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Word64 ->                               -- interval : TBasicType TUInt64
    IO ()

-- | Sets the minimum interval for requesting keyframes based on force-keyunit
-- events. Setting this to 0 will allow to handle every event, setting this to
-- 'GI.Gst.Constants.CLOCK_TIME_NONE' causes force-keyunit events to be ignored.
-- 
-- /Since: 1.18/
videoEncoderSetMinForceKeyUnitInterval ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: the encoder
    -> Word64
    -- ^ /@interval@/: minimum interval
    -> m ()
videoEncoderSetMinForceKeyUnitInterval :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Word64 -> m ()
videoEncoderSetMinForceKeyUnitInterval a
encoder Word64
interval = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoEncoder -> Word64 -> IO ()
gst_video_encoder_set_min_force_key_unit_interval Ptr VideoEncoder
encoder' Word64
interval
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoEncoderSetMinForceKeyUnitIntervalMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderSetMinForceKeyUnitIntervalMethodInfo a signature where
    overloadedMethod = videoEncoderSetMinForceKeyUnitInterval

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


#endif

-- method VideoEncoder::set_min_pts
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_pts"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "minimal PTS that will be passed to handle_frame"
--                 , 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_encoder_set_min_pts" gst_video_encoder_set_min_pts :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Word64 ->                               -- min_pts : TBasicType TUInt64
    IO ()

-- | Request minimal value for PTS passed to handle_frame.
-- 
-- For streams with reordered frames this can be used to ensure that there
-- is enough time to accommodate first DTS, which may be less than first PTS
-- 
-- /Since: 1.6/
videoEncoderSetMinPts ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> Word64
    -- ^ /@minPts@/: minimal PTS that will be passed to handle_frame
    -> m ()
videoEncoderSetMinPts :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Word64 -> m ()
videoEncoderSetMinPts a
encoder Word64
minPts = 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr VideoEncoder -> Word64 -> IO ()
gst_video_encoder_set_min_pts Ptr VideoEncoder
encoder' Word64
minPts
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoEncoderSetMinPtsMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderSetMinPtsMethodInfo a signature where
    overloadedMethod = videoEncoderSetMinPts

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


#endif

-- method VideoEncoder::set_output_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps to use for the output"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , 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_encoder_set_output_state" gst_video_encoder_set_output_state :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    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 caps as the output state
-- for the encoder.
-- Any previously set output state on /@encoder@/ will be replaced by the newly
-- created one.
-- 
-- The specified /@caps@/ should not contain any resolution, pixel-aspect-ratio,
-- framerate, codec-data, .... Those should be specified instead in the returned
-- t'GI.GstVideo.Structs.VideoCodecState.VideoCodecState'.
-- 
-- If the subclass wishes to copy over existing fields (like pixel aspect 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_encoder_finish_frame/@().
videoEncoderSetOutputState ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: a t'GI.GstVideo.Objects.VideoEncoder.VideoEncoder'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' to use for the output
    -> Maybe (GstVideo.VideoCodecState.VideoCodecState)
    -- ^ /@reference@/: An optional reference /@gstVideoCodecState@/
    -> m GstVideo.VideoCodecState.VideoCodecState
    -- ^ __Returns:__ the newly configured output state.
videoEncoderSetOutputState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Caps -> Maybe VideoCodecState -> m VideoCodecState
videoEncoderSetOutputState a
encoder Caps
caps Maybe VideoCodecState
reference = IO VideoCodecState -> m VideoCodecState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoCodecState -> m VideoCodecState)
-> IO VideoCodecState -> m VideoCodecState
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Caps
caps
    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 VideoEncoder
-> Ptr Caps -> Ptr VideoCodecState -> IO (Ptr VideoCodecState)
gst_video_encoder_set_output_state Ptr VideoEncoder
encoder' Ptr Caps
caps' Ptr VideoCodecState
maybeReference
    Text -> Ptr VideoCodecState -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoEncoderSetOutputState" Ptr VideoCodecState
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    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
    VideoCodecState -> IO VideoCodecState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoCodecState
result'

#if defined(ENABLE_OVERLOADING)
data VideoEncoderSetOutputStateMethodInfo
instance (signature ~ (Gst.Caps.Caps -> Maybe (GstVideo.VideoCodecState.VideoCodecState) -> m GstVideo.VideoCodecState.VideoCodecState), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderSetOutputStateMethodInfo a signature where
    overloadedMethod = videoEncoderSetOutputState

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


#endif

-- method VideoEncoder::set_qos_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the encoder" , 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 "the new qos value." , 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_encoder_set_qos_enabled" gst_video_encoder_set_qos_enabled :: 
    Ptr VideoEncoder ->                     -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoEncoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Configures /@encoder@/ to handle Quality-of-Service events from downstream.
-- 
-- /Since: 1.14/
videoEncoderSetQosEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsVideoEncoder a) =>
    a
    -- ^ /@encoder@/: the encoder
    -> Bool
    -- ^ /@enabled@/: the new qos value.
    -> m ()
videoEncoderSetQosEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVideoEncoder a) =>
a -> Bool -> m ()
videoEncoderSetQosEnabled a
encoder 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 VideoEncoder
encoder' <- a -> IO (Ptr VideoEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
encoder
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr VideoEncoder -> CInt -> IO ()
gst_video_encoder_set_qos_enabled Ptr VideoEncoder
encoder' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
encoder
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoEncoderSetQosEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsVideoEncoder a) => O.OverloadedMethod VideoEncoderSetQosEnabledMethodInfo a signature where
    overloadedMethod = videoEncoderSetQosEnabled

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


#endif