{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This base class is for audio encoders turning raw audio samples into
-- encoded audio data.
-- 
-- GstAudioEncoder and subclass should cooperate as follows.
-- 
-- == Configuration
-- 
--   * Initially, GstAudioEncoder calls /@start@/ when the encoder element
--     is activated, which allows subclass to perform any global setup.
-- 
--   * GstAudioEncoder calls /@setFormat@/ to inform subclass of the format
--     of input audio data that it is about to receive.  Subclass should
--     setup for encoding and configure various base class parameters
--     appropriately, notably those directing desired input data handling.
--     While unlikely, it might be called more than once, if changing input
--     parameters require reconfiguration.
-- 
--   * GstAudioEncoder calls /@stop@/ at end of all processing.
-- 
-- As of configuration stage, and throughout processing, GstAudioEncoder
-- maintains various parameters that provide required context,
-- e.g. describing the format of input audio data.
-- Conversely, subclass can and should configure these context parameters
-- to inform base class of its expectation w.r.t. buffer handling.
-- 
-- == Data processing
-- 
--     * Base class gathers input sample data (as directed by the context\'s
--       frame_samples and frame_max) and provides this to subclass\' /@handleFrame@/.
--     * If codec processing results in encoded data, subclass should call
--       'GI.GstAudio.Objects.AudioEncoder.audioEncoderFinishFrame' to have encoded data pushed
--       downstream. Alternatively, it might also call
--       'GI.GstAudio.Objects.AudioEncoder.audioEncoderFinishFrame' (with a NULL buffer and some number of
--       dropped samples) to indicate dropped (non-encoded) samples.
--     * Just prior to actually pushing a buffer downstream,
--       it is passed to /@prePush@/.
--     * During the parsing process GstAudioEncoderClass will handle both
--       srcpad and sinkpad events. Sink events will be passed to subclass
--       if /@event@/ callback has been provided.
-- 
-- == Shutdown phase
-- 
--   * GstAudioEncoder 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 also
-- needs to set the fixed caps on srcpad, when the format is ensured.  This
-- is typically when base class calls subclass\' /@setFormat@/ function, though
-- it might be delayed until calling /@gstAudioEncoderFinishFrame@/.
-- 
-- In summary, above process should have subclass concentrating on
-- codec data processing while leaving other matters to base class,
-- such as most notably timestamp handling.  While it may exert more control
-- in this area (see e.g. /@prePush@/), it is very much not recommended.
-- 
-- In particular, base class will either favor tracking upstream timestamps
-- (at the possible expense of jitter) or aim to arrange for a perfect stream of
-- output timestamps, depending on t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder':@/perfect-timestamp/@.
-- However, in the latter case, the input may not be so perfect or ideal, which
-- is handled as follows.  An input timestamp is compared with the expected
-- timestamp as dictated by input sample stream and if the deviation is less
-- than t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder':@/tolerance/@, the deviation is discarded.
-- Otherwise, it is considered a discontuinity and subsequent output timestamp
-- is resynced to the new position after performing configured discontinuity
-- processing.  In the non-perfect-timestamp case, an upstream variation
-- exceeding tolerance only leads to marking DISCONT on subsequent outgoing
-- (while timestamps are adjusted to upstream regardless of variation).
-- While DISCONT is also marked in the perfect-timestamp case, this one
-- optionally (see t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder':@/hard-resync/@)
-- performs some additional steps, such as clipping of (early) input samples
-- or draining all currently remaining input data, depending on the direction
-- of the discontuinity.
-- 
-- If perfect timestamps are arranged, it is also possible to request baseclass
-- (usually set by subclass) to provide additional buffer metadata (in OFFSET
-- and OFFSET_END) fields according to granule defined semantics currently
-- needed by oggmux.  Specifically, OFFSET is set to granulepos (= sample count
-- including buffer) and OFFSET_END to corresponding timestamp (as determined
-- by same sample count and sample rate).
-- 
-- Things that subclass need to take care of:
-- 
--   * Provide pad templates
--   * Set source pad caps when appropriate
--   * Inform base class of buffer processing needs using context\'s
--      frame_samples and frame_bytes.
--   * Set user-configurable properties to sane defaults for format and
--      implementing codec at hand, e.g. those controlling timestamp behaviour
--      and discontinuity processing.
--   * Accept data in /@handleFrame@/ and provide encoded results to
--      'GI.GstAudio.Objects.AudioEncoder.audioEncoderFinishFrame'.

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

module GI.GstAudio.Objects.AudioEncoder
    ( 

-- * Exported types
    AudioEncoder(..)                        ,
    IsAudioEncoder                          ,
    toAudioEncoder                          ,
    noAudioEncoder                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioEncoderMethod               ,
#endif


-- ** allocateOutputBuffer #method:allocateOutputBuffer#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderAllocateOutputBufferMethodInfo,
#endif
    audioEncoderAllocateOutputBuffer        ,


-- ** finishFrame #method:finishFrame#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderFinishFrameMethodInfo       ,
#endif
    audioEncoderFinishFrame                 ,


-- ** getAllocator #method:getAllocator#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetAllocatorMethodInfo      ,
#endif
    audioEncoderGetAllocator                ,


-- ** getAudioInfo #method:getAudioInfo#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetAudioInfoMethodInfo      ,
#endif
    audioEncoderGetAudioInfo                ,


-- ** getDrainable #method:getDrainable#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetDrainableMethodInfo      ,
#endif
    audioEncoderGetDrainable                ,


-- ** getFrameMax #method:getFrameMax#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetFrameMaxMethodInfo       ,
#endif
    audioEncoderGetFrameMax                 ,


-- ** getFrameSamplesMax #method:getFrameSamplesMax#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetFrameSamplesMaxMethodInfo,
#endif
    audioEncoderGetFrameSamplesMax          ,


-- ** getFrameSamplesMin #method:getFrameSamplesMin#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetFrameSamplesMinMethodInfo,
#endif
    audioEncoderGetFrameSamplesMin          ,


-- ** getHardMin #method:getHardMin#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetHardMinMethodInfo        ,
#endif
    audioEncoderGetHardMin                  ,


-- ** getHardResync #method:getHardResync#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetHardResyncMethodInfo     ,
#endif
    audioEncoderGetHardResync               ,


-- ** getLatency #method:getLatency#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetLatencyMethodInfo        ,
#endif
    audioEncoderGetLatency                  ,


-- ** getLookahead #method:getLookahead#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetLookaheadMethodInfo      ,
#endif
    audioEncoderGetLookahead                ,


-- ** getMarkGranule #method:getMarkGranule#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetMarkGranuleMethodInfo    ,
#endif
    audioEncoderGetMarkGranule              ,


-- ** getPerfectTimestamp #method:getPerfectTimestamp#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetPerfectTimestampMethodInfo,
#endif
    audioEncoderGetPerfectTimestamp         ,


-- ** getTolerance #method:getTolerance#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderGetToleranceMethodInfo      ,
#endif
    audioEncoderGetTolerance                ,


-- ** mergeTags #method:mergeTags#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderMergeTagsMethodInfo         ,
#endif
    audioEncoderMergeTags                   ,


-- ** negotiate #method:negotiate#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderNegotiateMethodInfo         ,
#endif
    audioEncoderNegotiate                   ,


-- ** proxyGetcaps #method:proxyGetcaps#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderProxyGetcapsMethodInfo      ,
#endif
    audioEncoderProxyGetcaps                ,


-- ** setAllocationCaps #method:setAllocationCaps#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetAllocationCapsMethodInfo ,
#endif
    audioEncoderSetAllocationCaps           ,


-- ** setDrainable #method:setDrainable#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetDrainableMethodInfo      ,
#endif
    audioEncoderSetDrainable                ,


-- ** setFrameMax #method:setFrameMax#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetFrameMaxMethodInfo       ,
#endif
    audioEncoderSetFrameMax                 ,


-- ** setFrameSamplesMax #method:setFrameSamplesMax#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetFrameSamplesMaxMethodInfo,
#endif
    audioEncoderSetFrameSamplesMax          ,


-- ** setFrameSamplesMin #method:setFrameSamplesMin#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetFrameSamplesMinMethodInfo,
#endif
    audioEncoderSetFrameSamplesMin          ,


-- ** setHardMin #method:setHardMin#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetHardMinMethodInfo        ,
#endif
    audioEncoderSetHardMin                  ,


-- ** setHardResync #method:setHardResync#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetHardResyncMethodInfo     ,
#endif
    audioEncoderSetHardResync               ,


-- ** setHeaders #method:setHeaders#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetHeadersMethodInfo        ,
#endif
    audioEncoderSetHeaders                  ,


-- ** setLatency #method:setLatency#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetLatencyMethodInfo        ,
#endif
    audioEncoderSetLatency                  ,


-- ** setLookahead #method:setLookahead#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetLookaheadMethodInfo      ,
#endif
    audioEncoderSetLookahead                ,


-- ** setMarkGranule #method:setMarkGranule#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetMarkGranuleMethodInfo    ,
#endif
    audioEncoderSetMarkGranule              ,


-- ** setOutputFormat #method:setOutputFormat#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetOutputFormatMethodInfo   ,
#endif
    audioEncoderSetOutputFormat             ,


-- ** setPerfectTimestamp #method:setPerfectTimestamp#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetPerfectTimestampMethodInfo,
#endif
    audioEncoderSetPerfectTimestamp         ,


-- ** setTolerance #method:setTolerance#

#if defined(ENABLE_OVERLOADING)
    AudioEncoderSetToleranceMethodInfo      ,
#endif
    audioEncoderSetTolerance                ,




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

#if defined(ENABLE_OVERLOADING)
    AudioEncoderHardResyncPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioEncoderHardResync                  ,
#endif
    constructAudioEncoderHardResync         ,
    getAudioEncoderHardResync               ,
    setAudioEncoderHardResync               ,


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

#if defined(ENABLE_OVERLOADING)
    AudioEncoderMarkGranulePropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioEncoderMarkGranule                 ,
#endif
    getAudioEncoderMarkGranule              ,


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

#if defined(ENABLE_OVERLOADING)
    AudioEncoderPerfectTimestampPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    audioEncoderPerfectTimestamp            ,
#endif
    constructAudioEncoderPerfectTimestamp   ,
    getAudioEncoderPerfectTimestamp         ,
    setAudioEncoderPerfectTimestamp         ,


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

#if defined(ENABLE_OVERLOADING)
    AudioEncoderTolerancePropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioEncoderTolerance                   ,
#endif
    constructAudioEncoderTolerance          ,
    getAudioEncoderTolerance                ,
    setAudioEncoderTolerance                ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.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.GstAudio.Structs.AudioInfo as GstAudio.AudioInfo

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

instance GObject AudioEncoder where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_audio_encoder_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `AudioEncoder`.
noAudioEncoder :: Maybe AudioEncoder
noAudioEncoder :: Maybe AudioEncoder
noAudioEncoder = Maybe AudioEncoder
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioEncoderMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioEncoderMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveAudioEncoderMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveAudioEncoderMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveAudioEncoderMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveAudioEncoderMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveAudioEncoderMethod "allocateOutputBuffer" o = AudioEncoderAllocateOutputBufferMethodInfo
    ResolveAudioEncoderMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAudioEncoderMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAudioEncoderMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveAudioEncoderMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveAudioEncoderMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveAudioEncoderMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveAudioEncoderMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveAudioEncoderMethod "deletePreset" o = Gst.Preset.PresetDeletePresetMethodInfo
    ResolveAudioEncoderMethod "finishFrame" o = AudioEncoderFinishFrameMethodInfo
    ResolveAudioEncoderMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAudioEncoderMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveAudioEncoderMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveAudioEncoderMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveAudioEncoderMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAudioEncoderMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAudioEncoderMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveAudioEncoderMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveAudioEncoderMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveAudioEncoderMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveAudioEncoderMethod "isEditable" o = Gst.Preset.PresetIsEditableMethodInfo
    ResolveAudioEncoderMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAudioEncoderMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveAudioEncoderMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveAudioEncoderMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveAudioEncoderMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveAudioEncoderMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveAudioEncoderMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveAudioEncoderMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveAudioEncoderMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveAudioEncoderMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveAudioEncoderMethod "loadPreset" o = Gst.Preset.PresetLoadPresetMethodInfo
    ResolveAudioEncoderMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveAudioEncoderMethod "mergeTags" o = AudioEncoderMergeTagsMethodInfo
    ResolveAudioEncoderMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveAudioEncoderMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveAudioEncoderMethod "negotiate" o = AudioEncoderNegotiateMethodInfo
    ResolveAudioEncoderMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveAudioEncoderMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAudioEncoderMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAudioEncoderMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveAudioEncoderMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveAudioEncoderMethod "proxyGetcaps" o = AudioEncoderProxyGetcapsMethodInfo
    ResolveAudioEncoderMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveAudioEncoderMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveAudioEncoderMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveAudioEncoderMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveAudioEncoderMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveAudioEncoderMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAudioEncoderMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveAudioEncoderMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveAudioEncoderMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveAudioEncoderMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveAudioEncoderMethod "renamePreset" o = Gst.Preset.PresetRenamePresetMethodInfo
    ResolveAudioEncoderMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveAudioEncoderMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAudioEncoderMethod "savePreset" o = Gst.Preset.PresetSavePresetMethodInfo
    ResolveAudioEncoderMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveAudioEncoderMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveAudioEncoderMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveAudioEncoderMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAudioEncoderMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAudioEncoderMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveAudioEncoderMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveAudioEncoderMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveAudioEncoderMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAudioEncoderMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveAudioEncoderMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveAudioEncoderMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveAudioEncoderMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveAudioEncoderMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAudioEncoderMethod "getAllocator" o = AudioEncoderGetAllocatorMethodInfo
    ResolveAudioEncoderMethod "getAudioInfo" o = AudioEncoderGetAudioInfoMethodInfo
    ResolveAudioEncoderMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveAudioEncoderMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveAudioEncoderMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveAudioEncoderMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveAudioEncoderMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveAudioEncoderMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveAudioEncoderMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveAudioEncoderMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveAudioEncoderMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveAudioEncoderMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveAudioEncoderMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAudioEncoderMethod "getDrainable" o = AudioEncoderGetDrainableMethodInfo
    ResolveAudioEncoderMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveAudioEncoderMethod "getFrameMax" o = AudioEncoderGetFrameMaxMethodInfo
    ResolveAudioEncoderMethod "getFrameSamplesMax" o = AudioEncoderGetFrameSamplesMaxMethodInfo
    ResolveAudioEncoderMethod "getFrameSamplesMin" o = AudioEncoderGetFrameSamplesMinMethodInfo
    ResolveAudioEncoderMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveAudioEncoderMethod "getHardMin" o = AudioEncoderGetHardMinMethodInfo
    ResolveAudioEncoderMethod "getHardResync" o = AudioEncoderGetHardResyncMethodInfo
    ResolveAudioEncoderMethod "getLatency" o = AudioEncoderGetLatencyMethodInfo
    ResolveAudioEncoderMethod "getLookahead" o = AudioEncoderGetLookaheadMethodInfo
    ResolveAudioEncoderMethod "getMarkGranule" o = AudioEncoderGetMarkGranuleMethodInfo
    ResolveAudioEncoderMethod "getMeta" o = Gst.Preset.PresetGetMetaMethodInfo
    ResolveAudioEncoderMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveAudioEncoderMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveAudioEncoderMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveAudioEncoderMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveAudioEncoderMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveAudioEncoderMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveAudioEncoderMethod "getPerfectTimestamp" o = AudioEncoderGetPerfectTimestampMethodInfo
    ResolveAudioEncoderMethod "getPresetNames" o = Gst.Preset.PresetGetPresetNamesMethodInfo
    ResolveAudioEncoderMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAudioEncoderMethod "getPropertyNames" o = Gst.Preset.PresetGetPropertyNamesMethodInfo
    ResolveAudioEncoderMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAudioEncoderMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveAudioEncoderMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveAudioEncoderMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveAudioEncoderMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveAudioEncoderMethod "getTolerance" o = AudioEncoderGetToleranceMethodInfo
    ResolveAudioEncoderMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveAudioEncoderMethod "setAllocationCaps" o = AudioEncoderSetAllocationCapsMethodInfo
    ResolveAudioEncoderMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveAudioEncoderMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveAudioEncoderMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveAudioEncoderMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveAudioEncoderMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveAudioEncoderMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveAudioEncoderMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveAudioEncoderMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAudioEncoderMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAudioEncoderMethod "setDrainable" o = AudioEncoderSetDrainableMethodInfo
    ResolveAudioEncoderMethod "setFrameMax" o = AudioEncoderSetFrameMaxMethodInfo
    ResolveAudioEncoderMethod "setFrameSamplesMax" o = AudioEncoderSetFrameSamplesMaxMethodInfo
    ResolveAudioEncoderMethod "setFrameSamplesMin" o = AudioEncoderSetFrameSamplesMinMethodInfo
    ResolveAudioEncoderMethod "setHardMin" o = AudioEncoderSetHardMinMethodInfo
    ResolveAudioEncoderMethod "setHardResync" o = AudioEncoderSetHardResyncMethodInfo
    ResolveAudioEncoderMethod "setHeaders" o = AudioEncoderSetHeadersMethodInfo
    ResolveAudioEncoderMethod "setLatency" o = AudioEncoderSetLatencyMethodInfo
    ResolveAudioEncoderMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveAudioEncoderMethod "setLookahead" o = AudioEncoderSetLookaheadMethodInfo
    ResolveAudioEncoderMethod "setMarkGranule" o = AudioEncoderSetMarkGranuleMethodInfo
    ResolveAudioEncoderMethod "setMeta" o = Gst.Preset.PresetSetMetaMethodInfo
    ResolveAudioEncoderMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveAudioEncoderMethod "setOutputFormat" o = AudioEncoderSetOutputFormatMethodInfo
    ResolveAudioEncoderMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveAudioEncoderMethod "setPerfectTimestamp" o = AudioEncoderSetPerfectTimestampMethodInfo
    ResolveAudioEncoderMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAudioEncoderMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveAudioEncoderMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveAudioEncoderMethod "setTolerance" o = AudioEncoderSetToleranceMethodInfo
    ResolveAudioEncoderMethod l o = O.MethodResolutionFailed l o

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data AudioEncoderHardResyncPropertyInfo
instance AttrInfo AudioEncoderHardResyncPropertyInfo where
    type AttrAllowedOps AudioEncoderHardResyncPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioEncoderHardResyncPropertyInfo = IsAudioEncoder
    type AttrSetTypeConstraint AudioEncoderHardResyncPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AudioEncoderHardResyncPropertyInfo = (~) Bool
    type AttrTransferType AudioEncoderHardResyncPropertyInfo = Bool
    type AttrGetType AudioEncoderHardResyncPropertyInfo = Bool
    type AttrLabel AudioEncoderHardResyncPropertyInfo = "hard-resync"
    type AttrOrigin AudioEncoderHardResyncPropertyInfo = AudioEncoder
    attrGet = getAudioEncoderHardResync
    attrSet = setAudioEncoderHardResync
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioEncoderHardResync
    attrClear = undefined
#endif

-- VVV Prop "mark-granule"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Just False)

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

#if defined(ENABLE_OVERLOADING)
data AudioEncoderMarkGranulePropertyInfo
instance AttrInfo AudioEncoderMarkGranulePropertyInfo where
    type AttrAllowedOps AudioEncoderMarkGranulePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint AudioEncoderMarkGranulePropertyInfo = IsAudioEncoder
    type AttrSetTypeConstraint AudioEncoderMarkGranulePropertyInfo = (~) ()
    type AttrTransferTypeConstraint AudioEncoderMarkGranulePropertyInfo = (~) ()
    type AttrTransferType AudioEncoderMarkGranulePropertyInfo = ()
    type AttrGetType AudioEncoderMarkGranulePropertyInfo = Bool
    type AttrLabel AudioEncoderMarkGranulePropertyInfo = "mark-granule"
    type AttrOrigin AudioEncoderMarkGranulePropertyInfo = AudioEncoder
    attrGet = getAudioEncoderMarkGranule
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data AudioEncoderPerfectTimestampPropertyInfo
instance AttrInfo AudioEncoderPerfectTimestampPropertyInfo where
    type AttrAllowedOps AudioEncoderPerfectTimestampPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioEncoderPerfectTimestampPropertyInfo = IsAudioEncoder
    type AttrSetTypeConstraint AudioEncoderPerfectTimestampPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AudioEncoderPerfectTimestampPropertyInfo = (~) Bool
    type AttrTransferType AudioEncoderPerfectTimestampPropertyInfo = Bool
    type AttrGetType AudioEncoderPerfectTimestampPropertyInfo = Bool
    type AttrLabel AudioEncoderPerfectTimestampPropertyInfo = "perfect-timestamp"
    type AttrOrigin AudioEncoderPerfectTimestampPropertyInfo = AudioEncoder
    attrGet = getAudioEncoderPerfectTimestamp
    attrSet = setAudioEncoderPerfectTimestamp
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioEncoderPerfectTimestamp
    attrClear = undefined
#endif

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

-- | Get the value of the “@tolerance@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioEncoder #tolerance
-- @
getAudioEncoderTolerance :: (MonadIO m, IsAudioEncoder o) => o -> m Int64
getAudioEncoderTolerance :: o -> m Int64
getAudioEncoderTolerance obj :: o
obj = IO Int64 -> m Int64
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
$ o -> String -> IO Int64
forall a. GObject a => a -> String -> IO Int64
B.Properties.getObjectPropertyInt64 o
obj "tolerance"

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

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

#if defined(ENABLE_OVERLOADING)
data AudioEncoderTolerancePropertyInfo
instance AttrInfo AudioEncoderTolerancePropertyInfo where
    type AttrAllowedOps AudioEncoderTolerancePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioEncoderTolerancePropertyInfo = IsAudioEncoder
    type AttrSetTypeConstraint AudioEncoderTolerancePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint AudioEncoderTolerancePropertyInfo = (~) Int64
    type AttrTransferType AudioEncoderTolerancePropertyInfo = Int64
    type AttrGetType AudioEncoderTolerancePropertyInfo = Int64
    type AttrLabel AudioEncoderTolerancePropertyInfo = "tolerance"
    type AttrOrigin AudioEncoderTolerancePropertyInfo = AudioEncoder
    attrGet = getAudioEncoderTolerance
    attrSet = setAudioEncoderTolerance
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioEncoderTolerance
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioEncoder
type instance O.AttributeList AudioEncoder = AudioEncoderAttributeList
type AudioEncoderAttributeList = ('[ '("hardResync", AudioEncoderHardResyncPropertyInfo), '("markGranule", AudioEncoderMarkGranulePropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("perfectTimestamp", AudioEncoderPerfectTimestampPropertyInfo), '("tolerance", AudioEncoderTolerancePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
audioEncoderHardResync :: AttrLabelProxy "hardResync"
audioEncoderHardResync = AttrLabelProxy

audioEncoderMarkGranule :: AttrLabelProxy "markGranule"
audioEncoderMarkGranule = AttrLabelProxy

audioEncoderPerfectTimestamp :: AttrLabelProxy "perfectTimestamp"
audioEncoderPerfectTimestamp = AttrLabelProxy

audioEncoderTolerance :: AttrLabelProxy "tolerance"
audioEncoderTolerance = AttrLabelProxy

#endif

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

#endif

-- method AudioEncoder::allocate_output_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_allocate_output_buffer" gst_audio_encoder_allocate_output_buffer :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Word64 ->                               -- size : TBasicType TUInt64
    IO (Ptr Gst.Buffer.Buffer)

-- | Helper function that allocates a buffer to hold an encoded audio frame
-- for /@enc@/\'s current output format.
audioEncoderAllocateOutputBuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Word64
    -- ^ /@size@/: size of the buffer
    -> m Gst.Buffer.Buffer
    -- ^ __Returns:__ allocated buffer
audioEncoderAllocateOutputBuffer :: a -> Word64 -> m Buffer
audioEncoderAllocateOutputBuffer enc :: a
enc size :: Word64
size = IO Buffer -> m Buffer
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 AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr Buffer
result <- Ptr AudioEncoder -> Word64 -> IO (Ptr Buffer)
gst_audio_encoder_allocate_output_buffer Ptr AudioEncoder
enc' Word64
size
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "audioEncoderAllocateOutputBuffer" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, BoxedObject 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
enc
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderAllocateOutputBufferMethodInfo
instance (signature ~ (Word64 -> m Gst.Buffer.Buffer), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderAllocateOutputBufferMethodInfo a signature where
    overloadedMethod = audioEncoderAllocateOutputBuffer

#endif

-- method AudioEncoder::finish_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "encoded data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "samples"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "number of samples (per channel) represented by encoded data"
--                 , 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_audio_encoder_finish_frame" gst_audio_encoder_finish_frame :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int32 ->                                -- samples : TBasicType TInt
    IO CInt

-- | Collects encoded data and pushes encoded data downstream.
-- Source pad caps must be set when this is called.
-- 
-- If /@samples@/ \< 0, then best estimate is all samples provided to encoder
-- (subclass) so far.  /@buf@/ may be NULL, in which case next number of /@samples@/
-- are considered discarded, e.g. as a result of discontinuous transmission,
-- and a discontinuity is marked.
-- 
-- Note that samples received in t'GI.GstAudio.Structs.AudioEncoderClass.AudioEncoderClass'.@/handle_frame/@()
-- may be invalidated by a call to this function.
audioEncoderFinishFrame ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: encoded data
    -> Int32
    -- ^ /@samples@/: number of samples (per channel) represented by encoded data
    -> m Gst.Enums.FlowReturn
    -- ^ __Returns:__ a t'GI.Gst.Enums.FlowReturn' that should be escalated to caller (of caller)
audioEncoderFinishFrame :: a -> Buffer -> Int32 -> m FlowReturn
audioEncoderFinishFrame enc :: a
enc buffer :: Buffer
buffer samples :: Int32
samples = IO FlowReturn -> m FlowReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlowReturn -> m FlowReturn) -> IO FlowReturn -> m FlowReturn
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    CInt
result <- Ptr AudioEncoder -> Ptr Buffer -> Int32 -> IO CInt
gst_audio_encoder_finish_frame Ptr AudioEncoder
enc' Ptr Buffer
buffer' Int32
samples
    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
enc
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    FlowReturn -> IO FlowReturn
forall (m :: * -> *) a. Monad m => a -> m a
return FlowReturn
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderFinishFrameMethodInfo
instance (signature ~ (Gst.Buffer.Buffer -> Int32 -> m Gst.Enums.FlowReturn), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderFinishFrameMethodInfo a signature where
    overloadedMethod = audioEncoderFinishFrame

#endif

-- method AudioEncoder::get_allocator
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_get_allocator" gst_audio_encoder_get_allocator :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    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.GstAudio.Objects.AudioEncoder.AudioEncoder' sub-classes to know the memory /@allocator@/
-- used by the base class and its /@params@/.
-- 
-- Unref the /@allocator@/ after use it.
audioEncoderGetAllocator ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m ((Gst.Allocator.Allocator, Gst.AllocationParams.AllocationParams))
audioEncoderGetAllocator :: a -> m (Allocator, AllocationParams)
audioEncoderGetAllocator enc :: a
enc = IO (Allocator, AllocationParams) -> m (Allocator, AllocationParams)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Allocator, AllocationParams)
 -> m (Allocator, AllocationParams))
-> IO (Allocator, AllocationParams)
-> m (Allocator, AllocationParams)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr (Ptr Allocator)
allocator <- IO (Ptr (Ptr Allocator))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Allocator.Allocator))
    Ptr AllocationParams
params <- Int -> IO (Ptr AllocationParams)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 64 :: IO (Ptr Gst.AllocationParams.AllocationParams)
    Ptr AudioEncoder
-> Ptr (Ptr Allocator) -> Ptr AllocationParams -> IO ()
gst_audio_encoder_get_allocator Ptr AudioEncoder
enc' Ptr (Ptr Allocator)
allocator Ptr AllocationParams
params
    Ptr Allocator
allocator' <- Ptr (Ptr Allocator) -> IO (Ptr Allocator)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Allocator)
allocator
    Allocator
allocator'' <- ((ManagedPtr Allocator -> Allocator)
-> Ptr Allocator -> IO Allocator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Allocator -> Allocator
Gst.Allocator.Allocator) Ptr Allocator
allocator'
    AllocationParams
params' <- ((ManagedPtr AllocationParams -> AllocationParams)
-> Ptr AllocationParams -> IO AllocationParams
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AllocationParams -> AllocationParams
Gst.AllocationParams.AllocationParams) Ptr AllocationParams
params
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Ptr (Ptr Allocator) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Allocator)
allocator
    (Allocator, AllocationParams) -> IO (Allocator, AllocationParams)
forall (m :: * -> *) a. Monad m => a -> m a
return (Allocator
allocator'', AllocationParams
params')

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

#endif

-- method AudioEncoder::get_audio_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GstAudio" , name = "AudioInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_get_audio_info" gst_audio_encoder_get_audio_info :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO (Ptr GstAudio.AudioInfo.AudioInfo)

-- | /No description available in the introspection data./
audioEncoderGetAudioInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m GstAudio.AudioInfo.AudioInfo
    -- ^ __Returns:__ a t'GI.GstAudio.Structs.AudioInfo.AudioInfo' describing the input audio format
audioEncoderGetAudioInfo :: a -> m AudioInfo
audioEncoderGetAudioInfo enc :: a
enc = IO AudioInfo -> m AudioInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioInfo -> m AudioInfo) -> IO AudioInfo -> m AudioInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioInfo
result <- Ptr AudioEncoder -> IO (Ptr AudioInfo)
gst_audio_encoder_get_audio_info Ptr AudioEncoder
enc'
    Text -> Ptr AudioInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "audioEncoderGetAudioInfo" Ptr AudioInfo
result
    AudioInfo
result' <- ((ManagedPtr AudioInfo -> AudioInfo)
-> Ptr AudioInfo -> IO AudioInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AudioInfo -> AudioInfo
GstAudio.AudioInfo.AudioInfo) Ptr AudioInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    AudioInfo -> IO AudioInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AudioInfo
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetAudioInfoMethodInfo
instance (signature ~ (m GstAudio.AudioInfo.AudioInfo), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetAudioInfoMethodInfo a signature where
    overloadedMethod = audioEncoderGetAudioInfo

#endif

-- method AudioEncoder::get_drainable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_get_drainable" gst_audio_encoder_get_drainable :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO CInt

-- | Queries encoder drain handling.
audioEncoderGetDrainable ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Bool
    -- ^ __Returns:__ TRUE if drainable handling is enabled.
    -- 
    -- MT safe.
audioEncoderGetDrainable :: a -> m Bool
audioEncoderGetDrainable enc :: a
enc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    CInt
result <- Ptr AudioEncoder -> IO CInt
gst_audio_encoder_get_drainable Ptr AudioEncoder
enc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetDrainableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetDrainableMethodInfo a signature where
    overloadedMethod = audioEncoderGetDrainable

#endif

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

foreign import ccall "gst_audio_encoder_get_frame_max" gst_audio_encoder_get_frame_max :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO Int32

-- | /No description available in the introspection data./
audioEncoderGetFrameMax ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Int32
    -- ^ __Returns:__ currently configured maximum handled frames
audioEncoderGetFrameMax :: a -> m Int32
audioEncoderGetFrameMax enc :: a
enc = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Int32
result <- Ptr AudioEncoder -> IO Int32
gst_audio_encoder_get_frame_max Ptr AudioEncoder
enc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetFrameMaxMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetFrameMaxMethodInfo a signature where
    overloadedMethod = audioEncoderGetFrameMax

#endif

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

foreign import ccall "gst_audio_encoder_get_frame_samples_max" gst_audio_encoder_get_frame_samples_max :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO Int32

-- | /No description available in the introspection data./
audioEncoderGetFrameSamplesMax ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Int32
    -- ^ __Returns:__ currently maximum requested samples per frame
audioEncoderGetFrameSamplesMax :: a -> m Int32
audioEncoderGetFrameSamplesMax enc :: a
enc = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Int32
result <- Ptr AudioEncoder -> IO Int32
gst_audio_encoder_get_frame_samples_max Ptr AudioEncoder
enc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetFrameSamplesMaxMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetFrameSamplesMaxMethodInfo a signature where
    overloadedMethod = audioEncoderGetFrameSamplesMax

#endif

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

foreign import ccall "gst_audio_encoder_get_frame_samples_min" gst_audio_encoder_get_frame_samples_min :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO Int32

-- | /No description available in the introspection data./
audioEncoderGetFrameSamplesMin ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Int32
    -- ^ __Returns:__ currently minimum requested samples per frame
audioEncoderGetFrameSamplesMin :: a -> m Int32
audioEncoderGetFrameSamplesMin enc :: a
enc = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Int32
result <- Ptr AudioEncoder -> IO Int32
gst_audio_encoder_get_frame_samples_min Ptr AudioEncoder
enc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetFrameSamplesMinMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetFrameSamplesMinMethodInfo a signature where
    overloadedMethod = audioEncoderGetFrameSamplesMin

#endif

-- method AudioEncoder::get_hard_min
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_get_hard_min" gst_audio_encoder_get_hard_min :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO CInt

-- | Queries encoder hard minimum handling.
audioEncoderGetHardMin ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Bool
    -- ^ __Returns:__ TRUE if hard minimum handling is enabled.
    -- 
    -- MT safe.
audioEncoderGetHardMin :: a -> m Bool
audioEncoderGetHardMin enc :: a
enc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    CInt
result <- Ptr AudioEncoder -> IO CInt
gst_audio_encoder_get_hard_min Ptr AudioEncoder
enc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetHardMinMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetHardMinMethodInfo a signature where
    overloadedMethod = audioEncoderGetHardMin

#endif

-- method AudioEncoder::get_hard_resync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_audio_encoder_get_hard_resync" gst_audio_encoder_get_hard_resync :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO CInt

-- | /No description available in the introspection data./
audioEncoderGetHardResync ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -> m Bool
audioEncoderGetHardResync :: a -> m Bool
audioEncoderGetHardResync enc :: a
enc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    CInt
result <- Ptr AudioEncoder -> IO CInt
gst_audio_encoder_get_hard_resync Ptr AudioEncoder
enc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetHardResyncMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetHardResyncMethodInfo a signature where
    overloadedMethod = audioEncoderGetHardResync

#endif

-- method AudioEncoder::get_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to storage to hold minimum latency"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "max"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to storage to hold maximum latency"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_get_latency" gst_audio_encoder_get_latency :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Ptr Word64 ->                           -- min : TBasicType TUInt64
    Ptr Word64 ->                           -- max : TBasicType TUInt64
    IO ()

-- | Sets the variables pointed to by /@min@/ and /@max@/ to the currently configured
-- latency.
audioEncoderGetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m ((Word64, Word64))
audioEncoderGetLatency :: a -> m (Word64, Word64)
audioEncoderGetLatency enc :: a
enc = IO (Word64, Word64) -> m (Word64, Word64)
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 AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr Word64
min <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
max <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr AudioEncoder -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_audio_encoder_get_latency Ptr AudioEncoder
enc' Ptr Word64
min Ptr Word64
max
    Word64
min' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
min
    Word64
max' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
max
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
min
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
max
    (Word64, Word64) -> IO (Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
min', Word64
max')

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetLatencyMethodInfo
instance (signature ~ (m ((Word64, Word64))), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetLatencyMethodInfo a signature where
    overloadedMethod = audioEncoderGetLatency

#endif

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

foreign import ccall "gst_audio_encoder_get_lookahead" gst_audio_encoder_get_lookahead :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO Int32

-- | /No description available in the introspection data./
audioEncoderGetLookahead ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Int32
    -- ^ __Returns:__ currently configured encoder lookahead
audioEncoderGetLookahead :: a -> m Int32
audioEncoderGetLookahead enc :: a
enc = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Int32
result <- Ptr AudioEncoder -> IO Int32
gst_audio_encoder_get_lookahead Ptr AudioEncoder
enc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetLookaheadMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetLookaheadMethodInfo a signature where
    overloadedMethod = audioEncoderGetLookahead

#endif

-- method AudioEncoder::get_mark_granule
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_get_mark_granule" gst_audio_encoder_get_mark_granule :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO CInt

-- | Queries if the encoder will handle granule marking.
audioEncoderGetMarkGranule ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Bool
    -- ^ __Returns:__ TRUE if granule marking is enabled.
    -- 
    -- MT safe.
audioEncoderGetMarkGranule :: a -> m Bool
audioEncoderGetMarkGranule enc :: a
enc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    CInt
result <- Ptr AudioEncoder -> IO CInt
gst_audio_encoder_get_mark_granule Ptr AudioEncoder
enc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetMarkGranuleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetMarkGranuleMethodInfo a signature where
    overloadedMethod = audioEncoderGetMarkGranule

#endif

-- method AudioEncoder::get_perfect_timestamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_get_perfect_timestamp" gst_audio_encoder_get_perfect_timestamp :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO CInt

-- | Queries encoder perfect timestamp behaviour.
audioEncoderGetPerfectTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Bool
    -- ^ __Returns:__ TRUE if perfect timestamp setting enabled.
    -- 
    -- MT safe.
audioEncoderGetPerfectTimestamp :: a -> m Bool
audioEncoderGetPerfectTimestamp enc :: a
enc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    CInt
result <- Ptr AudioEncoder -> IO CInt
gst_audio_encoder_get_perfect_timestamp Ptr AudioEncoder
enc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetPerfectTimestampMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetPerfectTimestampMethodInfo a signature where
    overloadedMethod = audioEncoderGetPerfectTimestamp

#endif

-- method AudioEncoder::get_tolerance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_get_tolerance" gst_audio_encoder_get_tolerance :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO Word64

-- | Queries current audio jitter tolerance threshold.
audioEncoderGetTolerance ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Word64
    -- ^ __Returns:__ encoder audio jitter tolerance threshold.
    -- 
    -- MT safe.
audioEncoderGetTolerance :: a -> m Word64
audioEncoderGetTolerance enc :: a
enc = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Word64
result <- Ptr AudioEncoder -> IO Word64
gst_audio_encoder_get_tolerance Ptr AudioEncoder
enc'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioEncoderGetToleranceMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderGetToleranceMethodInfo a signature where
    overloadedMethod = audioEncoderGetTolerance

#endif

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

-- | Sets the audio encoder tags and how they should be merged with any
-- upstream stream tags. This will override any tags previously-set
-- with 'GI.GstAudio.Objects.AudioEncoder.audioEncoderMergeTags'.
-- 
-- 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.
audioEncoderMergeTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> 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 ()
audioEncoderMergeTags :: a -> Maybe TagList -> TagMergeMode -> m ()
audioEncoderMergeTags enc :: a
enc tags :: Maybe TagList
tags mode :: TagMergeMode
mode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just jTags :: TagList
jTags -> do
            Ptr TagList
jTags' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
jTags
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTags'
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TagMergeMode -> Int) -> TagMergeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagMergeMode -> Int
forall a. Enum a => a -> Int
fromEnum) TagMergeMode
mode
    Ptr AudioEncoder -> Ptr TagList -> CUInt -> IO ()
gst_audio_encoder_merge_tags Ptr AudioEncoder
enc' Ptr TagList
maybeTags CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tags TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method AudioEncoder::negotiate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_negotiate" gst_audio_encoder_negotiate :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    IO CInt

-- | Negotiate with downstream elements to currently configured t'GI.Gst.Structs.Caps.Caps'.
-- Unmark GST_PAD_FLAG_NEED_RECONFIGURE in any case. But mark it again if
-- negotiate fails.
audioEncoderNegotiate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the negotiation succeeded, else 'P.False'.
audioEncoderNegotiate :: a -> m Bool
audioEncoderNegotiate enc :: a
enc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    CInt
result <- Ptr AudioEncoder -> IO CInt
gst_audio_encoder_negotiate Ptr AudioEncoder
enc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderNegotiateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderNegotiateMethodInfo a signature where
    overloadedMethod = audioEncoderNegotiate

#endif

-- method AudioEncoder::proxy_getcaps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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_audio_encoder_proxy_getcaps" gst_audio_encoder_proxy_getcaps :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    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 channel\/rate combinations supported by downstream elements
-- (e.g. muxers).
audioEncoderProxyGetcaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> 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
audioEncoderProxyGetcaps :: a -> Maybe Caps -> Maybe Caps -> m Caps
audioEncoderProxyGetcaps enc :: a
enc caps :: Maybe Caps
caps filter :: Maybe Caps
filter = IO Caps -> m Caps
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 AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just jCaps :: 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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Caps
maybeFilter <- case Maybe Caps
filter of
        Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just jFilter :: 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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jFilter'
    Ptr Caps
result <- Ptr AudioEncoder -> Ptr Caps -> Ptr Caps -> IO (Ptr Caps)
gst_audio_encoder_proxy_getcaps Ptr AudioEncoder
enc' Ptr Caps
maybeCaps Ptr Caps
maybeFilter
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "audioEncoderProxyGetcaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject 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 (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data AudioEncoderProxyGetcapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> Maybe (Gst.Caps.Caps) -> m Gst.Caps.Caps), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderProxyGetcapsMethodInfo a signature where
    overloadedMethod = audioEncoderProxyGetcaps

#endif

-- method AudioEncoder::set_allocation_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allocation_caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_set_allocation_caps" gst_audio_encoder_set_allocation_caps :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Ptr Gst.Caps.Caps ->                    -- allocation_caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Sets a caps in allocation query which are different from the set
-- pad\'s caps. Use this function before calling
-- 'GI.GstAudio.Objects.AudioEncoder.audioEncoderNegotiate'. Setting to 'P.Nothing' the allocation
-- query will use the caps from the pad.
-- 
-- /Since: 1.10/
audioEncoderSetAllocationCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@allocationCaps@/: a t'GI.Gst.Structs.Caps.Caps' or 'P.Nothing'
    -> m ()
audioEncoderSetAllocationCaps :: a -> Maybe Caps -> m ()
audioEncoderSetAllocationCaps enc :: a
enc allocationCaps :: Maybe Caps
allocationCaps = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr Caps
maybeAllocationCaps <- case Maybe Caps
allocationCaps of
        Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just jAllocationCaps :: Caps
jAllocationCaps -> do
            Ptr Caps
jAllocationCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jAllocationCaps
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jAllocationCaps'
    Ptr AudioEncoder -> Ptr Caps -> IO ()
gst_audio_encoder_set_allocation_caps Ptr AudioEncoder
enc' Ptr Caps
maybeAllocationCaps
    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
allocationCaps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetAllocationCapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetAllocationCapsMethodInfo a signature where
    overloadedMethod = audioEncoderSetAllocationCaps

#endif

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

foreign import ccall "gst_audio_encoder_set_drainable" gst_audio_encoder_set_drainable :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Configures encoder drain handling.  If drainable, subclass might
-- be handed a NULL buffer to have it return any leftover encoded data.
-- Otherwise, it is not considered so capable and will only ever be passed
-- real data.
-- 
-- MT safe.
audioEncoderSetDrainable ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Bool
    -- ^ /@enabled@/: new state
    -> m ()
audioEncoderSetDrainable :: a -> Bool -> m ()
audioEncoderSetDrainable enc :: a
enc enabled :: Bool
enabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    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 AudioEncoder -> CInt -> IO ()
gst_audio_encoder_set_drainable Ptr AudioEncoder
enc' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetDrainableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetDrainableMethodInfo a signature where
    overloadedMethod = audioEncoderSetDrainable

#endif

-- method AudioEncoder::set_frame_max
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of frames" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_set_frame_max" gst_audio_encoder_set_frame_max :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Int32 ->                                -- num : TBasicType TInt
    IO ()

-- | Sets max number of frames accepted at once (assumed minimally 1).
-- Requires /@frameSamplesMin@/ and /@frameSamplesMax@/ to be the equal.
-- 
-- Note: This value will be reset to 0 every time before
-- t'GI.GstAudio.Structs.AudioEncoderClass.AudioEncoderClass'.@/set_format/@() is called.
audioEncoderSetFrameMax ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Int32
    -- ^ /@num@/: number of frames
    -> m ()
audioEncoderSetFrameMax :: a -> Int32 -> m ()
audioEncoderSetFrameMax enc :: a
enc num :: Int32
num = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioEncoder -> Int32 -> IO ()
gst_audio_encoder_set_frame_max Ptr AudioEncoder
enc' Int32
num
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetFrameMaxMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetFrameMaxMethodInfo a signature where
    overloadedMethod = audioEncoderSetFrameMax

#endif

-- method AudioEncoder::set_frame_samples_max
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of samples per 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_audio_encoder_set_frame_samples_max" gst_audio_encoder_set_frame_samples_max :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Int32 ->                                -- num : TBasicType TInt
    IO ()

-- | Sets number of samples (per channel) subclass needs to be handed,
-- at most or will be handed all available if 0.
-- 
-- If an exact number of samples is required, 'GI.GstAudio.Objects.AudioEncoder.audioEncoderSetFrameSamplesMin'
-- must be called with the same number.
-- 
-- Note: This value will be reset to 0 every time before
-- t'GI.GstAudio.Structs.AudioEncoderClass.AudioEncoderClass'.@/set_format/@() is called.
audioEncoderSetFrameSamplesMax ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Int32
    -- ^ /@num@/: number of samples per frame
    -> m ()
audioEncoderSetFrameSamplesMax :: a -> Int32 -> m ()
audioEncoderSetFrameSamplesMax enc :: a
enc num :: Int32
num = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioEncoder -> Int32 -> IO ()
gst_audio_encoder_set_frame_samples_max Ptr AudioEncoder
enc' Int32
num
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetFrameSamplesMaxMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetFrameSamplesMaxMethodInfo a signature where
    overloadedMethod = audioEncoderSetFrameSamplesMax

#endif

-- method AudioEncoder::set_frame_samples_min
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of samples per 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_audio_encoder_set_frame_samples_min" gst_audio_encoder_set_frame_samples_min :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Int32 ->                                -- num : TBasicType TInt
    IO ()

-- | Sets number of samples (per channel) subclass needs to be handed,
-- at least or will be handed all available if 0.
-- 
-- If an exact number of samples is required, 'GI.GstAudio.Objects.AudioEncoder.audioEncoderSetFrameSamplesMax'
-- must be called with the same number.
-- 
-- Note: This value will be reset to 0 every time before
-- t'GI.GstAudio.Structs.AudioEncoderClass.AudioEncoderClass'.@/set_format/@() is called.
audioEncoderSetFrameSamplesMin ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Int32
    -- ^ /@num@/: number of samples per frame
    -> m ()
audioEncoderSetFrameSamplesMin :: a -> Int32 -> m ()
audioEncoderSetFrameSamplesMin enc :: a
enc num :: Int32
num = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioEncoder -> Int32 -> IO ()
gst_audio_encoder_set_frame_samples_min Ptr AudioEncoder
enc' Int32
num
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetFrameSamplesMinMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetFrameSamplesMinMethodInfo a signature where
    overloadedMethod = audioEncoderSetFrameSamplesMin

#endif

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

foreign import ccall "gst_audio_encoder_set_hard_min" gst_audio_encoder_set_hard_min :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Configures encoder hard minimum handling.  If enabled, subclass
-- will never be handed less samples than it configured, which otherwise
-- might occur near end-of-data handling.  Instead, the leftover samples
-- will simply be discarded.
-- 
-- MT safe.
audioEncoderSetHardMin ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Bool
    -- ^ /@enabled@/: new state
    -> m ()
audioEncoderSetHardMin :: a -> Bool -> m ()
audioEncoderSetHardMin enc :: a
enc enabled :: Bool
enabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    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 AudioEncoder -> CInt -> IO ()
gst_audio_encoder_set_hard_min Ptr AudioEncoder
enc' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetHardMinMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetHardMinMethodInfo a signature where
    overloadedMethod = audioEncoderSetHardMin

#endif

-- method AudioEncoder::set_hard_resync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_set_hard_resync" gst_audio_encoder_set_hard_resync :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | /No description available in the introspection data./
audioEncoderSetHardResync ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -> Bool
    -> m ()
audioEncoderSetHardResync :: a -> Bool -> m ()
audioEncoderSetHardResync enc :: a
enc enabled :: Bool
enabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    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 AudioEncoder -> CInt -> IO ()
gst_audio_encoder_set_hard_resync Ptr AudioEncoder
enc' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetHardResyncMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetHardResyncMethodInfo a signature where
    overloadedMethod = audioEncoderSetHardResync

#endif

-- method AudioEncoder::set_headers
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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\n  #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_audio_encoder_set_headers" gst_audio_encoder_set_headers :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    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.
audioEncoderSetHeaders ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> [Gst.Buffer.Buffer]
    -- ^ /@headers@/: a list of
    --   t'GI.Gst.Structs.Buffer.Buffer' containing the codec header
    -> m ()
audioEncoderSetHeaders :: a -> [Buffer] -> m ()
audioEncoderSetHeaders enc :: a
enc headers :: [Buffer]
headers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    [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)
mapM Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, BoxedObject 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 AudioEncoder -> Ptr (GList (Ptr Buffer)) -> IO ()
gst_audio_encoder_set_headers Ptr AudioEncoder
enc' Ptr (GList (Ptr Buffer))
headers''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    (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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetHeadersMethodInfo
instance (signature ~ ([Gst.Buffer.Buffer] -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetHeadersMethodInfo a signature where
    overloadedMethod = audioEncoderSetHeaders

#endif

-- method AudioEncoder::set_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min"
--           , 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"
--           , 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_audio_encoder_set_latency" gst_audio_encoder_set_latency :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Word64 ->                               -- min : TBasicType TUInt64
    Word64 ->                               -- max : TBasicType TUInt64
    IO ()

-- | Sets encoder latency.
audioEncoderSetLatency ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Word64
    -- ^ /@min@/: minimum latency
    -> Word64
    -- ^ /@max@/: maximum latency
    -> m ()
audioEncoderSetLatency :: a -> Word64 -> Word64 -> m ()
audioEncoderSetLatency enc :: a
enc min :: Word64
min max :: Word64
max = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioEncoder -> Word64 -> Word64 -> IO ()
gst_audio_encoder_set_latency Ptr AudioEncoder
enc' Word64
min Word64
max
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetLatencyMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetLatencyMethodInfo a signature where
    overloadedMethod = audioEncoderSetLatency

#endif

-- method AudioEncoder::set_lookahead
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "lookahead" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_set_lookahead" gst_audio_encoder_set_lookahead :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Int32 ->                                -- num : TBasicType TInt
    IO ()

-- | Sets encoder lookahead (in units of input rate samples)
-- 
-- Note: This value will be reset to 0 every time before
-- t'GI.GstAudio.Structs.AudioEncoderClass.AudioEncoderClass'.@/set_format/@() is called.
audioEncoderSetLookahead ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Int32
    -- ^ /@num@/: lookahead
    -> m ()
audioEncoderSetLookahead :: a -> Int32 -> m ()
audioEncoderSetLookahead enc :: a
enc num :: Int32
num = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioEncoder -> Int32 -> IO ()
gst_audio_encoder_set_lookahead Ptr AudioEncoder
enc' Int32
num
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetLookaheadMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetLookaheadMethodInfo a signature where
    overloadedMethod = audioEncoderSetLookahead

#endif

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

foreign import ccall "gst_audio_encoder_set_mark_granule" gst_audio_encoder_set_mark_granule :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Enable or disable encoder granule handling.
-- 
-- MT safe.
audioEncoderSetMarkGranule ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Bool
    -- ^ /@enabled@/: new state
    -> m ()
audioEncoderSetMarkGranule :: a -> Bool -> m ()
audioEncoderSetMarkGranule enc :: a
enc enabled :: Bool
enabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    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 AudioEncoder -> CInt -> IO ()
gst_audio_encoder_set_mark_granule Ptr AudioEncoder
enc' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetMarkGranuleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetMarkGranuleMethodInfo a signature where
    overloadedMethod = audioEncoderSetMarkGranule

#endif

-- method AudioEncoder::set_output_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , 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 "#GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_set_output_format" gst_audio_encoder_set_output_format :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Configure output caps on the srcpad of /@enc@/.
audioEncoderSetOutputFormat ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' on success.
audioEncoderSetOutputFormat :: a -> Caps -> m Bool
audioEncoderSetOutputFormat enc :: a
enc caps :: Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr AudioEncoder -> Ptr Caps -> IO CInt
gst_audio_encoder_set_output_format Ptr AudioEncoder
enc' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif

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

foreign import ccall "gst_audio_encoder_set_perfect_timestamp" gst_audio_encoder_set_perfect_timestamp :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Enable or disable encoder perfect output timestamp preference.
-- 
-- MT safe.
audioEncoderSetPerfectTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Bool
    -- ^ /@enabled@/: new state
    -> m ()
audioEncoderSetPerfectTimestamp :: a -> Bool -> m ()
audioEncoderSetPerfectTimestamp enc :: a
enc enabled :: Bool
enabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    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 AudioEncoder -> CInt -> IO ()
gst_audio_encoder_set_perfect_timestamp Ptr AudioEncoder
enc' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetPerfectTimestampMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetPerfectTimestampMethodInfo a signature where
    overloadedMethod = audioEncoderSetPerfectTimestamp

#endif

-- method AudioEncoder::set_tolerance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "enc"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioEncoder" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tolerance"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new tolerance" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_encoder_set_tolerance" gst_audio_encoder_set_tolerance :: 
    Ptr AudioEncoder ->                     -- enc : TInterface (Name {namespace = "GstAudio", name = "AudioEncoder"})
    Word64 ->                               -- tolerance : TBasicType TUInt64
    IO ()

-- | Configures encoder audio jitter tolerance threshold.
-- 
-- MT safe.
audioEncoderSetTolerance ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioEncoder a) =>
    a
    -- ^ /@enc@/: a t'GI.GstAudio.Objects.AudioEncoder.AudioEncoder'
    -> Word64
    -- ^ /@tolerance@/: new tolerance
    -> m ()
audioEncoderSetTolerance :: a -> Word64 -> m ()
audioEncoderSetTolerance enc :: a
enc tolerance :: Word64
tolerance = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioEncoder
enc' <- a -> IO (Ptr AudioEncoder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
enc
    Ptr AudioEncoder -> Word64 -> IO ()
gst_audio_encoder_set_tolerance Ptr AudioEncoder
enc' Word64
tolerance
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
enc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioEncoderSetToleranceMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsAudioEncoder a) => O.MethodInfo AudioEncoderSetToleranceMethodInfo a signature where
    overloadedMethod = audioEncoderSetTolerance

#endif