{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This is the base class for audio sinks. Subclasses need to implement the
-- [create_ringbuffer](#signal:create_ringbuffer) vmethod. This base class will then take care of
-- writing samples to the ringbuffer, synchronisation, clipping and flushing.

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

module GI.GstAudio.Objects.AudioBaseSink
    ( 

-- * Exported types
    AudioBaseSink(..)                       ,
    IsAudioBaseSink                         ,
    toAudioBaseSink                         ,
    noAudioBaseSink                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioBaseSinkMethod              ,
#endif


-- ** createRingbuffer #method:createRingbuffer#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkCreateRingbufferMethodInfo ,
#endif
    audioBaseSinkCreateRingbuffer           ,


-- ** getAlignmentThreshold #method:getAlignmentThreshold#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkGetAlignmentThresholdMethodInfo,
#endif
    audioBaseSinkGetAlignmentThreshold      ,


-- ** getDiscontWait #method:getDiscontWait#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkGetDiscontWaitMethodInfo   ,
#endif
    audioBaseSinkGetDiscontWait             ,


-- ** getDriftTolerance #method:getDriftTolerance#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkGetDriftToleranceMethodInfo,
#endif
    audioBaseSinkGetDriftTolerance          ,


-- ** getProvideClock #method:getProvideClock#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkGetProvideClockMethodInfo  ,
#endif
    audioBaseSinkGetProvideClock            ,


-- ** getSlaveMethod #method:getSlaveMethod#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkGetSlaveMethodMethodInfo   ,
#endif
    audioBaseSinkGetSlaveMethod             ,


-- ** reportDeviceFailure #method:reportDeviceFailure#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkReportDeviceFailureMethodInfo,
#endif
    audioBaseSinkReportDeviceFailure        ,


-- ** setAlignmentThreshold #method:setAlignmentThreshold#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSetAlignmentThresholdMethodInfo,
#endif
    audioBaseSinkSetAlignmentThreshold      ,


-- ** setCustomSlavingCallback #method:setCustomSlavingCallback#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSetCustomSlavingCallbackMethodInfo,
#endif
    audioBaseSinkSetCustomSlavingCallback   ,


-- ** setDiscontWait #method:setDiscontWait#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSetDiscontWaitMethodInfo   ,
#endif
    audioBaseSinkSetDiscontWait             ,


-- ** setDriftTolerance #method:setDriftTolerance#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSetDriftToleranceMethodInfo,
#endif
    audioBaseSinkSetDriftTolerance          ,


-- ** setProvideClock #method:setProvideClock#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSetProvideClockMethodInfo  ,
#endif
    audioBaseSinkSetProvideClock            ,


-- ** setSlaveMethod #method:setSlaveMethod#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSetSlaveMethodMethodInfo   ,
#endif
    audioBaseSinkSetSlaveMethod             ,




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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkAlignmentThresholdPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkAlignmentThreshold         ,
#endif
    constructAudioBaseSinkAlignmentThreshold,
    getAudioBaseSinkAlignmentThreshold      ,
    setAudioBaseSinkAlignmentThreshold      ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkBufferTimePropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkBufferTime                 ,
#endif
    constructAudioBaseSinkBufferTime        ,
    getAudioBaseSinkBufferTime              ,
    setAudioBaseSinkBufferTime              ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkCanActivatePullPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkCanActivatePull            ,
#endif
    constructAudioBaseSinkCanActivatePull   ,
    getAudioBaseSinkCanActivatePull         ,
    setAudioBaseSinkCanActivatePull         ,


-- ** discontWait #attr:discontWait#
-- | A window of time in nanoseconds to wait before creating a discontinuity as
-- a result of breaching the drift-tolerance.

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkDiscontWaitPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkDiscontWait                ,
#endif
    constructAudioBaseSinkDiscontWait       ,
    getAudioBaseSinkDiscontWait             ,
    setAudioBaseSinkDiscontWait             ,


-- ** driftTolerance #attr:driftTolerance#
-- | Controls the amount of time in microseconds that clocks are allowed
-- to drift before resynchronisation happens.

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkDriftTolerancePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkDriftTolerance             ,
#endif
    constructAudioBaseSinkDriftTolerance    ,
    getAudioBaseSinkDriftTolerance          ,
    setAudioBaseSinkDriftTolerance          ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkLatencyTimePropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkLatencyTime                ,
#endif
    constructAudioBaseSinkLatencyTime       ,
    getAudioBaseSinkLatencyTime             ,
    setAudioBaseSinkLatencyTime             ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkProvideClockPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkProvideClock               ,
#endif
    constructAudioBaseSinkProvideClock      ,
    getAudioBaseSinkProvideClock            ,
    setAudioBaseSinkProvideClock            ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSinkSlaveMethodPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSinkSlaveMethod                ,
#endif
    constructAudioBaseSinkSlaveMethod       ,
    getAudioBaseSinkSlaveMethod             ,
    setAudioBaseSinkSlaveMethod             ,




    ) 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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.GstAudio.Callbacks as GstAudio.Callbacks
import {-# SOURCE #-} qualified GI.GstAudio.Enums as GstAudio.Enums
import {-# SOURCE #-} qualified GI.GstAudio.Objects.AudioRingBuffer as GstAudio.AudioRingBuffer
import qualified GI.GstBase.Objects.BaseSink as GstBase.BaseSink

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

instance GObject AudioBaseSink where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_audio_base_sink_get_type
    

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

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

instance O.HasParentTypes AudioBaseSink
type instance O.ParentTypes AudioBaseSink = '[GstBase.BaseSink.BaseSink, Gst.Element.Element, Gst.Object.Object, GObject.Object.Object]

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

-- | A convenience alias for `Nothing` :: `Maybe` `AudioBaseSink`.
noAudioBaseSink :: Maybe AudioBaseSink
noAudioBaseSink :: Maybe AudioBaseSink
noAudioBaseSink = Maybe AudioBaseSink
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioBaseSinkMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioBaseSinkMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveAudioBaseSinkMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveAudioBaseSinkMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveAudioBaseSinkMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveAudioBaseSinkMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveAudioBaseSinkMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAudioBaseSinkMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAudioBaseSinkMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveAudioBaseSinkMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveAudioBaseSinkMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveAudioBaseSinkMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveAudioBaseSinkMethod "createRingbuffer" o = AudioBaseSinkCreateRingbufferMethodInfo
    ResolveAudioBaseSinkMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveAudioBaseSinkMethod "doPreroll" o = GstBase.BaseSink.BaseSinkDoPrerollMethodInfo
    ResolveAudioBaseSinkMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAudioBaseSinkMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveAudioBaseSinkMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveAudioBaseSinkMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveAudioBaseSinkMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAudioBaseSinkMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAudioBaseSinkMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveAudioBaseSinkMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveAudioBaseSinkMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveAudioBaseSinkMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveAudioBaseSinkMethod "isAsyncEnabled" o = GstBase.BaseSink.BaseSinkIsAsyncEnabledMethodInfo
    ResolveAudioBaseSinkMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAudioBaseSinkMethod "isLastSampleEnabled" o = GstBase.BaseSink.BaseSinkIsLastSampleEnabledMethodInfo
    ResolveAudioBaseSinkMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveAudioBaseSinkMethod "isQosEnabled" o = GstBase.BaseSink.BaseSinkIsQosEnabledMethodInfo
    ResolveAudioBaseSinkMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveAudioBaseSinkMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveAudioBaseSinkMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveAudioBaseSinkMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveAudioBaseSinkMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveAudioBaseSinkMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveAudioBaseSinkMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveAudioBaseSinkMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveAudioBaseSinkMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveAudioBaseSinkMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveAudioBaseSinkMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveAudioBaseSinkMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveAudioBaseSinkMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAudioBaseSinkMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAudioBaseSinkMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveAudioBaseSinkMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveAudioBaseSinkMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveAudioBaseSinkMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveAudioBaseSinkMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveAudioBaseSinkMethod "queryLatency" o = GstBase.BaseSink.BaseSinkQueryLatencyMethodInfo
    ResolveAudioBaseSinkMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveAudioBaseSinkMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveAudioBaseSinkMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAudioBaseSinkMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveAudioBaseSinkMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveAudioBaseSinkMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveAudioBaseSinkMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveAudioBaseSinkMethod "reportDeviceFailure" o = AudioBaseSinkReportDeviceFailureMethodInfo
    ResolveAudioBaseSinkMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveAudioBaseSinkMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAudioBaseSinkMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveAudioBaseSinkMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveAudioBaseSinkMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveAudioBaseSinkMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAudioBaseSinkMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAudioBaseSinkMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveAudioBaseSinkMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveAudioBaseSinkMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveAudioBaseSinkMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAudioBaseSinkMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveAudioBaseSinkMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveAudioBaseSinkMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveAudioBaseSinkMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveAudioBaseSinkMethod "wait" o = GstBase.BaseSink.BaseSinkWaitMethodInfo
    ResolveAudioBaseSinkMethod "waitClock" o = GstBase.BaseSink.BaseSinkWaitClockMethodInfo
    ResolveAudioBaseSinkMethod "waitPreroll" o = GstBase.BaseSink.BaseSinkWaitPrerollMethodInfo
    ResolveAudioBaseSinkMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAudioBaseSinkMethod "getAlignmentThreshold" o = AudioBaseSinkGetAlignmentThresholdMethodInfo
    ResolveAudioBaseSinkMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveAudioBaseSinkMethod "getBlocksize" o = GstBase.BaseSink.BaseSinkGetBlocksizeMethodInfo
    ResolveAudioBaseSinkMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveAudioBaseSinkMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveAudioBaseSinkMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveAudioBaseSinkMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveAudioBaseSinkMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveAudioBaseSinkMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveAudioBaseSinkMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveAudioBaseSinkMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveAudioBaseSinkMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveAudioBaseSinkMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAudioBaseSinkMethod "getDiscontWait" o = AudioBaseSinkGetDiscontWaitMethodInfo
    ResolveAudioBaseSinkMethod "getDriftTolerance" o = AudioBaseSinkGetDriftToleranceMethodInfo
    ResolveAudioBaseSinkMethod "getDropOutOfSegment" o = GstBase.BaseSink.BaseSinkGetDropOutOfSegmentMethodInfo
    ResolveAudioBaseSinkMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveAudioBaseSinkMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveAudioBaseSinkMethod "getLastSample" o = GstBase.BaseSink.BaseSinkGetLastSampleMethodInfo
    ResolveAudioBaseSinkMethod "getLatency" o = GstBase.BaseSink.BaseSinkGetLatencyMethodInfo
    ResolveAudioBaseSinkMethod "getMaxBitrate" o = GstBase.BaseSink.BaseSinkGetMaxBitrateMethodInfo
    ResolveAudioBaseSinkMethod "getMaxLateness" o = GstBase.BaseSink.BaseSinkGetMaxLatenessMethodInfo
    ResolveAudioBaseSinkMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveAudioBaseSinkMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveAudioBaseSinkMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveAudioBaseSinkMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveAudioBaseSinkMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveAudioBaseSinkMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveAudioBaseSinkMethod "getProcessingDeadline" o = GstBase.BaseSink.BaseSinkGetProcessingDeadlineMethodInfo
    ResolveAudioBaseSinkMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAudioBaseSinkMethod "getProvideClock" o = AudioBaseSinkGetProvideClockMethodInfo
    ResolveAudioBaseSinkMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAudioBaseSinkMethod "getRenderDelay" o = GstBase.BaseSink.BaseSinkGetRenderDelayMethodInfo
    ResolveAudioBaseSinkMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveAudioBaseSinkMethod "getSlaveMethod" o = AudioBaseSinkGetSlaveMethodMethodInfo
    ResolveAudioBaseSinkMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveAudioBaseSinkMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveAudioBaseSinkMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveAudioBaseSinkMethod "getSync" o = GstBase.BaseSink.BaseSinkGetSyncMethodInfo
    ResolveAudioBaseSinkMethod "getThrottleTime" o = GstBase.BaseSink.BaseSinkGetThrottleTimeMethodInfo
    ResolveAudioBaseSinkMethod "getTsOffset" o = GstBase.BaseSink.BaseSinkGetTsOffsetMethodInfo
    ResolveAudioBaseSinkMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveAudioBaseSinkMethod "setAlignmentThreshold" o = AudioBaseSinkSetAlignmentThresholdMethodInfo
    ResolveAudioBaseSinkMethod "setAsyncEnabled" o = GstBase.BaseSink.BaseSinkSetAsyncEnabledMethodInfo
    ResolveAudioBaseSinkMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveAudioBaseSinkMethod "setBlocksize" o = GstBase.BaseSink.BaseSinkSetBlocksizeMethodInfo
    ResolveAudioBaseSinkMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveAudioBaseSinkMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveAudioBaseSinkMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveAudioBaseSinkMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveAudioBaseSinkMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveAudioBaseSinkMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveAudioBaseSinkMethod "setCustomSlavingCallback" o = AudioBaseSinkSetCustomSlavingCallbackMethodInfo
    ResolveAudioBaseSinkMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAudioBaseSinkMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAudioBaseSinkMethod "setDiscontWait" o = AudioBaseSinkSetDiscontWaitMethodInfo
    ResolveAudioBaseSinkMethod "setDriftTolerance" o = AudioBaseSinkSetDriftToleranceMethodInfo
    ResolveAudioBaseSinkMethod "setDropOutOfSegment" o = GstBase.BaseSink.BaseSinkSetDropOutOfSegmentMethodInfo
    ResolveAudioBaseSinkMethod "setLastSampleEnabled" o = GstBase.BaseSink.BaseSinkSetLastSampleEnabledMethodInfo
    ResolveAudioBaseSinkMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveAudioBaseSinkMethod "setMaxBitrate" o = GstBase.BaseSink.BaseSinkSetMaxBitrateMethodInfo
    ResolveAudioBaseSinkMethod "setMaxLateness" o = GstBase.BaseSink.BaseSinkSetMaxLatenessMethodInfo
    ResolveAudioBaseSinkMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveAudioBaseSinkMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveAudioBaseSinkMethod "setProcessingDeadline" o = GstBase.BaseSink.BaseSinkSetProcessingDeadlineMethodInfo
    ResolveAudioBaseSinkMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAudioBaseSinkMethod "setProvideClock" o = AudioBaseSinkSetProvideClockMethodInfo
    ResolveAudioBaseSinkMethod "setQosEnabled" o = GstBase.BaseSink.BaseSinkSetQosEnabledMethodInfo
    ResolveAudioBaseSinkMethod "setRenderDelay" o = GstBase.BaseSink.BaseSinkSetRenderDelayMethodInfo
    ResolveAudioBaseSinkMethod "setSlaveMethod" o = AudioBaseSinkSetSlaveMethodMethodInfo
    ResolveAudioBaseSinkMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveAudioBaseSinkMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveAudioBaseSinkMethod "setSync" o = GstBase.BaseSink.BaseSinkSetSyncMethodInfo
    ResolveAudioBaseSinkMethod "setThrottleTime" o = GstBase.BaseSink.BaseSinkSetThrottleTimeMethodInfo
    ResolveAudioBaseSinkMethod "setTsOffset" o = GstBase.BaseSink.BaseSinkSetTsOffsetMethodInfo
    ResolveAudioBaseSinkMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "alignment-threshold"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkAlignmentThresholdPropertyInfo
instance AttrInfo AudioBaseSinkAlignmentThresholdPropertyInfo where
    type AttrAllowedOps AudioBaseSinkAlignmentThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkAlignmentThresholdPropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkAlignmentThresholdPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint AudioBaseSinkAlignmentThresholdPropertyInfo = (~) Word64
    type AttrTransferType AudioBaseSinkAlignmentThresholdPropertyInfo = Word64
    type AttrGetType AudioBaseSinkAlignmentThresholdPropertyInfo = Word64
    type AttrLabel AudioBaseSinkAlignmentThresholdPropertyInfo = "alignment-threshold"
    type AttrOrigin AudioBaseSinkAlignmentThresholdPropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkAlignmentThreshold
    attrSet = setAudioBaseSinkAlignmentThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkAlignmentThreshold
    attrClear = undefined
#endif

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

-- | Get the value of the “@buffer-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBaseSink #bufferTime
-- @
getAudioBaseSinkBufferTime :: (MonadIO m, IsAudioBaseSink o) => o -> m Int64
getAudioBaseSinkBufferTime :: o -> m Int64
getAudioBaseSinkBufferTime 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 "buffer-time"

-- | Set the value of the “@buffer-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBaseSink [ #bufferTime 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSinkBufferTime :: (MonadIO m, IsAudioBaseSink o) => o -> Int64 -> m ()
setAudioBaseSinkBufferTime :: o -> Int64 -> m ()
setAudioBaseSinkBufferTime 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 "buffer-time" Int64
val

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkBufferTimePropertyInfo
instance AttrInfo AudioBaseSinkBufferTimePropertyInfo where
    type AttrAllowedOps AudioBaseSinkBufferTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkBufferTimePropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkBufferTimePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint AudioBaseSinkBufferTimePropertyInfo = (~) Int64
    type AttrTransferType AudioBaseSinkBufferTimePropertyInfo = Int64
    type AttrGetType AudioBaseSinkBufferTimePropertyInfo = Int64
    type AttrLabel AudioBaseSinkBufferTimePropertyInfo = "buffer-time"
    type AttrOrigin AudioBaseSinkBufferTimePropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkBufferTime
    attrSet = setAudioBaseSinkBufferTime
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkBufferTime
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkCanActivatePullPropertyInfo
instance AttrInfo AudioBaseSinkCanActivatePullPropertyInfo where
    type AttrAllowedOps AudioBaseSinkCanActivatePullPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkCanActivatePullPropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkCanActivatePullPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AudioBaseSinkCanActivatePullPropertyInfo = (~) Bool
    type AttrTransferType AudioBaseSinkCanActivatePullPropertyInfo = Bool
    type AttrGetType AudioBaseSinkCanActivatePullPropertyInfo = Bool
    type AttrLabel AudioBaseSinkCanActivatePullPropertyInfo = "can-activate-pull"
    type AttrOrigin AudioBaseSinkCanActivatePullPropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkCanActivatePull
    attrSet = setAudioBaseSinkCanActivatePull
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkCanActivatePull
    attrClear = undefined
#endif

-- VVV Prop "discont-wait"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkDiscontWaitPropertyInfo
instance AttrInfo AudioBaseSinkDiscontWaitPropertyInfo where
    type AttrAllowedOps AudioBaseSinkDiscontWaitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkDiscontWaitPropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkDiscontWaitPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint AudioBaseSinkDiscontWaitPropertyInfo = (~) Word64
    type AttrTransferType AudioBaseSinkDiscontWaitPropertyInfo = Word64
    type AttrGetType AudioBaseSinkDiscontWaitPropertyInfo = Word64
    type AttrLabel AudioBaseSinkDiscontWaitPropertyInfo = "discont-wait"
    type AttrOrigin AudioBaseSinkDiscontWaitPropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkDiscontWait
    attrSet = setAudioBaseSinkDiscontWait
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkDiscontWait
    attrClear = undefined
#endif

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

-- | Get the value of the “@drift-tolerance@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBaseSink #driftTolerance
-- @
getAudioBaseSinkDriftTolerance :: (MonadIO m, IsAudioBaseSink o) => o -> m Int64
getAudioBaseSinkDriftTolerance :: o -> m Int64
getAudioBaseSinkDriftTolerance 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 "drift-tolerance"

-- | Set the value of the “@drift-tolerance@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBaseSink [ #driftTolerance 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSinkDriftTolerance :: (MonadIO m, IsAudioBaseSink o) => o -> Int64 -> m ()
setAudioBaseSinkDriftTolerance :: o -> Int64 -> m ()
setAudioBaseSinkDriftTolerance 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 "drift-tolerance" Int64
val

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkDriftTolerancePropertyInfo
instance AttrInfo AudioBaseSinkDriftTolerancePropertyInfo where
    type AttrAllowedOps AudioBaseSinkDriftTolerancePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkDriftTolerancePropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkDriftTolerancePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint AudioBaseSinkDriftTolerancePropertyInfo = (~) Int64
    type AttrTransferType AudioBaseSinkDriftTolerancePropertyInfo = Int64
    type AttrGetType AudioBaseSinkDriftTolerancePropertyInfo = Int64
    type AttrLabel AudioBaseSinkDriftTolerancePropertyInfo = "drift-tolerance"
    type AttrOrigin AudioBaseSinkDriftTolerancePropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkDriftTolerance
    attrSet = setAudioBaseSinkDriftTolerance
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkDriftTolerance
    attrClear = undefined
#endif

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

-- | Get the value of the “@latency-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBaseSink #latencyTime
-- @
getAudioBaseSinkLatencyTime :: (MonadIO m, IsAudioBaseSink o) => o -> m Int64
getAudioBaseSinkLatencyTime :: o -> m Int64
getAudioBaseSinkLatencyTime 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 "latency-time"

-- | Set the value of the “@latency-time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBaseSink [ #latencyTime 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSinkLatencyTime :: (MonadIO m, IsAudioBaseSink o) => o -> Int64 -> m ()
setAudioBaseSinkLatencyTime :: o -> Int64 -> m ()
setAudioBaseSinkLatencyTime 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 "latency-time" Int64
val

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkLatencyTimePropertyInfo
instance AttrInfo AudioBaseSinkLatencyTimePropertyInfo where
    type AttrAllowedOps AudioBaseSinkLatencyTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkLatencyTimePropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkLatencyTimePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint AudioBaseSinkLatencyTimePropertyInfo = (~) Int64
    type AttrTransferType AudioBaseSinkLatencyTimePropertyInfo = Int64
    type AttrGetType AudioBaseSinkLatencyTimePropertyInfo = Int64
    type AttrLabel AudioBaseSinkLatencyTimePropertyInfo = "latency-time"
    type AttrOrigin AudioBaseSinkLatencyTimePropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkLatencyTime
    attrSet = setAudioBaseSinkLatencyTime
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkLatencyTime
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkProvideClockPropertyInfo
instance AttrInfo AudioBaseSinkProvideClockPropertyInfo where
    type AttrAllowedOps AudioBaseSinkProvideClockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkProvideClockPropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkProvideClockPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AudioBaseSinkProvideClockPropertyInfo = (~) Bool
    type AttrTransferType AudioBaseSinkProvideClockPropertyInfo = Bool
    type AttrGetType AudioBaseSinkProvideClockPropertyInfo = Bool
    type AttrLabel AudioBaseSinkProvideClockPropertyInfo = "provide-clock"
    type AttrOrigin AudioBaseSinkProvideClockPropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkProvideClock
    attrSet = setAudioBaseSinkProvideClock
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkProvideClock
    attrClear = undefined
#endif

-- VVV Prop "slave-method"
   -- Type: TInterface (Name {namespace = "GstAudio", name = "AudioBaseSinkSlaveMethod"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@slave-method@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBaseSink #slaveMethod
-- @
getAudioBaseSinkSlaveMethod :: (MonadIO m, IsAudioBaseSink o) => o -> m GstAudio.Enums.AudioBaseSinkSlaveMethod
getAudioBaseSinkSlaveMethod :: o -> m AudioBaseSinkSlaveMethod
getAudioBaseSinkSlaveMethod obj :: o
obj = IO AudioBaseSinkSlaveMethod -> m AudioBaseSinkSlaveMethod
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioBaseSinkSlaveMethod -> m AudioBaseSinkSlaveMethod)
-> IO AudioBaseSinkSlaveMethod -> m AudioBaseSinkSlaveMethod
forall a b. (a -> b) -> a -> b
$ o -> String -> IO AudioBaseSinkSlaveMethod
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "slave-method"

-- | Set the value of the “@slave-method@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBaseSink [ #slaveMethod 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSinkSlaveMethod :: (MonadIO m, IsAudioBaseSink o) => o -> GstAudio.Enums.AudioBaseSinkSlaveMethod -> m ()
setAudioBaseSinkSlaveMethod :: o -> AudioBaseSinkSlaveMethod -> m ()
setAudioBaseSinkSlaveMethod obj :: o
obj val :: AudioBaseSinkSlaveMethod
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 -> AudioBaseSinkSlaveMethod -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "slave-method" AudioBaseSinkSlaveMethod
val

-- | Construct a `GValueConstruct` with valid value for the “@slave-method@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAudioBaseSinkSlaveMethod :: (IsAudioBaseSink o) => GstAudio.Enums.AudioBaseSinkSlaveMethod -> IO (GValueConstruct o)
constructAudioBaseSinkSlaveMethod :: AudioBaseSinkSlaveMethod -> IO (GValueConstruct o)
constructAudioBaseSinkSlaveMethod val :: AudioBaseSinkSlaveMethod
val = String -> AudioBaseSinkSlaveMethod -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "slave-method" AudioBaseSinkSlaveMethod
val

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSlaveMethodPropertyInfo
instance AttrInfo AudioBaseSinkSlaveMethodPropertyInfo where
    type AttrAllowedOps AudioBaseSinkSlaveMethodPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSinkSlaveMethodPropertyInfo = IsAudioBaseSink
    type AttrSetTypeConstraint AudioBaseSinkSlaveMethodPropertyInfo = (~) GstAudio.Enums.AudioBaseSinkSlaveMethod
    type AttrTransferTypeConstraint AudioBaseSinkSlaveMethodPropertyInfo = (~) GstAudio.Enums.AudioBaseSinkSlaveMethod
    type AttrTransferType AudioBaseSinkSlaveMethodPropertyInfo = GstAudio.Enums.AudioBaseSinkSlaveMethod
    type AttrGetType AudioBaseSinkSlaveMethodPropertyInfo = GstAudio.Enums.AudioBaseSinkSlaveMethod
    type AttrLabel AudioBaseSinkSlaveMethodPropertyInfo = "slave-method"
    type AttrOrigin AudioBaseSinkSlaveMethodPropertyInfo = AudioBaseSink
    attrGet = getAudioBaseSinkSlaveMethod
    attrSet = setAudioBaseSinkSlaveMethod
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSinkSlaveMethod
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioBaseSink
type instance O.AttributeList AudioBaseSink = AudioBaseSinkAttributeList
type AudioBaseSinkAttributeList = ('[ '("alignmentThreshold", AudioBaseSinkAlignmentThresholdPropertyInfo), '("async", GstBase.BaseSink.BaseSinkAsyncPropertyInfo), '("blocksize", GstBase.BaseSink.BaseSinkBlocksizePropertyInfo), '("bufferTime", AudioBaseSinkBufferTimePropertyInfo), '("canActivatePull", AudioBaseSinkCanActivatePullPropertyInfo), '("discontWait", AudioBaseSinkDiscontWaitPropertyInfo), '("driftTolerance", AudioBaseSinkDriftTolerancePropertyInfo), '("enableLastSample", GstBase.BaseSink.BaseSinkEnableLastSamplePropertyInfo), '("lastSample", GstBase.BaseSink.BaseSinkLastSamplePropertyInfo), '("latencyTime", AudioBaseSinkLatencyTimePropertyInfo), '("maxBitrate", GstBase.BaseSink.BaseSinkMaxBitratePropertyInfo), '("maxLateness", GstBase.BaseSink.BaseSinkMaxLatenessPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("processingDeadline", GstBase.BaseSink.BaseSinkProcessingDeadlinePropertyInfo), '("provideClock", AudioBaseSinkProvideClockPropertyInfo), '("qos", GstBase.BaseSink.BaseSinkQosPropertyInfo), '("renderDelay", GstBase.BaseSink.BaseSinkRenderDelayPropertyInfo), '("slaveMethod", AudioBaseSinkSlaveMethodPropertyInfo), '("sync", GstBase.BaseSink.BaseSinkSyncPropertyInfo), '("throttleTime", GstBase.BaseSink.BaseSinkThrottleTimePropertyInfo), '("tsOffset", GstBase.BaseSink.BaseSinkTsOffsetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
audioBaseSinkAlignmentThreshold :: AttrLabelProxy "alignmentThreshold"
audioBaseSinkAlignmentThreshold = AttrLabelProxy

audioBaseSinkBufferTime :: AttrLabelProxy "bufferTime"
audioBaseSinkBufferTime = AttrLabelProxy

audioBaseSinkCanActivatePull :: AttrLabelProxy "canActivatePull"
audioBaseSinkCanActivatePull = AttrLabelProxy

audioBaseSinkDiscontWait :: AttrLabelProxy "discontWait"
audioBaseSinkDiscontWait = AttrLabelProxy

audioBaseSinkDriftTolerance :: AttrLabelProxy "driftTolerance"
audioBaseSinkDriftTolerance = AttrLabelProxy

audioBaseSinkLatencyTime :: AttrLabelProxy "latencyTime"
audioBaseSinkLatencyTime = AttrLabelProxy

audioBaseSinkProvideClock :: AttrLabelProxy "provideClock"
audioBaseSinkProvideClock = AttrLabelProxy

audioBaseSinkSlaveMethod :: AttrLabelProxy "slaveMethod"
audioBaseSinkSlaveMethod = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gst_audio_base_sink_create_ringbuffer" gst_audio_base_sink_create_ringbuffer :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO (Ptr GstAudio.AudioRingBuffer.AudioRingBuffer)

-- | Create and return the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' for /@sink@/. This function will
-- call the [create_ringbuffer](#signal:create_ringbuffer) vmethod and will set /@sink@/ as the parent of
-- the returned buffer (see 'GI.Gst.Objects.Object.objectSetParent').
audioBaseSinkCreateRingbuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'.
    -> m GstAudio.AudioRingBuffer.AudioRingBuffer
    -- ^ __Returns:__ The new ringbuffer of /@sink@/.
audioBaseSinkCreateRingbuffer :: a -> m AudioRingBuffer
audioBaseSinkCreateRingbuffer sink :: a
sink = IO AudioRingBuffer -> m AudioRingBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioRingBuffer -> m AudioRingBuffer)
-> IO AudioRingBuffer -> m AudioRingBuffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Ptr AudioRingBuffer
result <- Ptr AudioBaseSink -> IO (Ptr AudioRingBuffer)
gst_audio_base_sink_create_ringbuffer Ptr AudioBaseSink
sink'
    Text -> Ptr AudioRingBuffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "audioBaseSinkCreateRingbuffer" Ptr AudioRingBuffer
result
    AudioRingBuffer
result' <- ((ManagedPtr AudioRingBuffer -> AudioRingBuffer)
-> Ptr AudioRingBuffer -> IO AudioRingBuffer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AudioRingBuffer -> AudioRingBuffer
GstAudio.AudioRingBuffer.AudioRingBuffer) Ptr AudioRingBuffer
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    AudioRingBuffer -> IO AudioRingBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return AudioRingBuffer
result'

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkCreateRingbufferMethodInfo
instance (signature ~ (m GstAudio.AudioRingBuffer.AudioRingBuffer), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkCreateRingbufferMethodInfo a signature where
    overloadedMethod = audioBaseSinkCreateRingbuffer

#endif

-- method AudioBaseSink::get_alignment_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , 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_base_sink_get_alignment_threshold" gst_audio_base_sink_get_alignment_threshold :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO Word64

-- | Get the current alignment threshold, in nanoseconds, used by /@sink@/.
audioBaseSinkGetAlignmentThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> m Word64
    -- ^ __Returns:__ The current alignment threshold used by /@sink@/.
audioBaseSinkGetAlignmentThreshold :: a -> m Word64
audioBaseSinkGetAlignmentThreshold sink :: a
sink = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Word64
result <- Ptr AudioBaseSink -> IO Word64
gst_audio_base_sink_get_alignment_threshold Ptr AudioBaseSink
sink'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkGetAlignmentThresholdMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkGetAlignmentThresholdMethodInfo a signature where
    overloadedMethod = audioBaseSinkGetAlignmentThreshold

#endif

-- method AudioBaseSink::get_discont_wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , 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_base_sink_get_discont_wait" gst_audio_base_sink_get_discont_wait :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO Word64

-- | Get the current discont wait, in nanoseconds, used by /@sink@/.
audioBaseSinkGetDiscontWait ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> m Word64
    -- ^ __Returns:__ The current discont wait used by /@sink@/.
audioBaseSinkGetDiscontWait :: a -> m Word64
audioBaseSinkGetDiscontWait sink :: a
sink = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Word64
result <- Ptr AudioBaseSink -> IO Word64
gst_audio_base_sink_get_discont_wait Ptr AudioBaseSink
sink'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkGetDiscontWaitMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkGetDiscontWaitMethodInfo a signature where
    overloadedMethod = audioBaseSinkGetDiscontWait

#endif

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

foreign import ccall "gst_audio_base_sink_get_drift_tolerance" gst_audio_base_sink_get_drift_tolerance :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO Int64

-- | Get the current drift tolerance, in microseconds, used by /@sink@/.
audioBaseSinkGetDriftTolerance ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> m Int64
    -- ^ __Returns:__ The current drift tolerance used by /@sink@/.
audioBaseSinkGetDriftTolerance :: a -> m Int64
audioBaseSinkGetDriftTolerance sink :: a
sink = 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
$ do
    Ptr AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Int64
result <- Ptr AudioBaseSink -> IO Int64
gst_audio_base_sink_get_drift_tolerance Ptr AudioBaseSink
sink'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkGetDriftToleranceMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkGetDriftToleranceMethodInfo a signature where
    overloadedMethod = audioBaseSinkGetDriftTolerance

#endif

-- method AudioBaseSink::get_provide_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , 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_base_sink_get_provide_clock" gst_audio_base_sink_get_provide_clock :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO CInt

-- | Queries whether /@sink@/ will provide a clock or not. See also
-- gst_audio_base_sink_set_provide_clock.
audioBaseSinkGetProvideClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@sink@/ will provide a clock.
audioBaseSinkGetProvideClock :: a -> m Bool
audioBaseSinkGetProvideClock sink :: a
sink = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    CInt
result <- Ptr AudioBaseSink -> IO CInt
gst_audio_base_sink_get_provide_clock Ptr AudioBaseSink
sink'
    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
sink
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkGetProvideClockMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkGetProvideClockMethodInfo a signature where
    overloadedMethod = audioBaseSinkGetProvideClock

#endif

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

foreign import ccall "gst_audio_base_sink_get_slave_method" gst_audio_base_sink_get_slave_method :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO CUInt

-- | Get the current slave method used by /@sink@/.
audioBaseSinkGetSlaveMethod ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> m GstAudio.Enums.AudioBaseSinkSlaveMethod
    -- ^ __Returns:__ The current slave method used by /@sink@/.
audioBaseSinkGetSlaveMethod :: a -> m AudioBaseSinkSlaveMethod
audioBaseSinkGetSlaveMethod sink :: a
sink = IO AudioBaseSinkSlaveMethod -> m AudioBaseSinkSlaveMethod
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioBaseSinkSlaveMethod -> m AudioBaseSinkSlaveMethod)
-> IO AudioBaseSinkSlaveMethod -> m AudioBaseSinkSlaveMethod
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    CUInt
result <- Ptr AudioBaseSink -> IO CUInt
gst_audio_base_sink_get_slave_method Ptr AudioBaseSink
sink'
    let result' :: AudioBaseSinkSlaveMethod
result' = (Int -> AudioBaseSinkSlaveMethod
forall a. Enum a => Int -> a
toEnum (Int -> AudioBaseSinkSlaveMethod)
-> (CUInt -> Int) -> CUInt -> AudioBaseSinkSlaveMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    AudioBaseSinkSlaveMethod -> IO AudioBaseSinkSlaveMethod
forall (m :: * -> *) a. Monad m => a -> m a
return AudioBaseSinkSlaveMethod
result'

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkGetSlaveMethodMethodInfo
instance (signature ~ (m GstAudio.Enums.AudioBaseSinkSlaveMethod), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkGetSlaveMethodMethodInfo a signature where
    overloadedMethod = audioBaseSinkGetSlaveMethod

#endif

-- method AudioBaseSink::report_device_failure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , 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_base_sink_report_device_failure" gst_audio_base_sink_report_device_failure :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    IO ()

-- | Informs this base class that the audio output device has failed for
-- some reason, causing a discontinuity (for example, because the device
-- recovered from the error, but lost all contents of its ring buffer).
-- This function is typically called by derived classes, and is useful
-- for the custom slave method.
-- 
-- /Since: 1.6/
audioBaseSinkReportDeviceFailure ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> m ()
audioBaseSinkReportDeviceFailure :: a -> m ()
audioBaseSinkReportDeviceFailure sink :: a
sink = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Ptr AudioBaseSink -> IO ()
gst_audio_base_sink_report_device_failure Ptr AudioBaseSink
sink'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkReportDeviceFailureMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkReportDeviceFailureMethodInfo a signature where
    overloadedMethod = audioBaseSinkReportDeviceFailure

#endif

-- method AudioBaseSink::set_alignment_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alignment_threshold"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new alignment threshold in nanoseconds"
--                 , 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_base_sink_set_alignment_threshold" gst_audio_base_sink_set_alignment_threshold :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    Word64 ->                               -- alignment_threshold : TBasicType TUInt64
    IO ()

-- | Controls the sink\'s alignment threshold.
audioBaseSinkSetAlignmentThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> Word64
    -- ^ /@alignmentThreshold@/: the new alignment threshold in nanoseconds
    -> m ()
audioBaseSinkSetAlignmentThreshold :: a -> Word64 -> m ()
audioBaseSinkSetAlignmentThreshold sink :: a
sink alignmentThreshold :: Word64
alignmentThreshold = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Ptr AudioBaseSink -> Word64 -> IO ()
gst_audio_base_sink_set_alignment_threshold Ptr AudioBaseSink
sink' Word64
alignmentThreshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSetAlignmentThresholdMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkSetAlignmentThresholdMethodInfo a signature where
    overloadedMethod = audioBaseSinkSetAlignmentThreshold

#endif

-- method AudioBaseSink::set_custom_slaving_callback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstAudio"
--                   , name = "AudioBaseSinkCustomSlavingCallback"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSinkCustomSlavingCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "called when user_data becomes unused"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_base_sink_set_custom_slaving_callback" gst_audio_base_sink_set_custom_slaving_callback :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    FunPtr GstAudio.Callbacks.C_AudioBaseSinkCustomSlavingCallback -> -- callback : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSinkCustomSlavingCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the custom slaving callback. This callback will
-- be invoked if the slave-method property is set to
-- GST_AUDIO_BASE_SINK_SLAVE_CUSTOM and the audio sink
-- receives and plays samples.
-- 
-- Setting the callback to NULL causes the sink to
-- behave as if the GST_AUDIO_BASE_SINK_SLAVE_NONE
-- method were used.
-- 
-- /Since: 1.6/
audioBaseSinkSetCustomSlavingCallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> GstAudio.Callbacks.AudioBaseSinkCustomSlavingCallback
    -- ^ /@callback@/: a t'GI.GstAudio.Callbacks.AudioBaseSinkCustomSlavingCallback'
    -> m ()
audioBaseSinkSetCustomSlavingCallback :: a -> AudioBaseSinkCustomSlavingCallback -> m ()
audioBaseSinkSetCustomSlavingCallback sink :: a
sink callback :: AudioBaseSinkCustomSlavingCallback
callback = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    FunPtr C_AudioBaseSinkCustomSlavingCallback
callback' <- C_AudioBaseSinkCustomSlavingCallback
-> IO (FunPtr C_AudioBaseSinkCustomSlavingCallback)
GstAudio.Callbacks.mk_AudioBaseSinkCustomSlavingCallback (Maybe (Ptr (FunPtr C_AudioBaseSinkCustomSlavingCallback))
-> AudioBaseSinkCustomSlavingCallback_WithClosures
-> C_AudioBaseSinkCustomSlavingCallback
GstAudio.Callbacks.wrap_AudioBaseSinkCustomSlavingCallback Maybe (Ptr (FunPtr C_AudioBaseSinkCustomSlavingCallback))
forall a. Maybe a
Nothing (AudioBaseSinkCustomSlavingCallback
-> AudioBaseSinkCustomSlavingCallback_WithClosures
GstAudio.Callbacks.drop_closures_AudioBaseSinkCustomSlavingCallback AudioBaseSinkCustomSlavingCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_AudioBaseSinkCustomSlavingCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AudioBaseSinkCustomSlavingCallback
callback'
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr AudioBaseSink
-> FunPtr C_AudioBaseSinkCustomSlavingCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_audio_base_sink_set_custom_slaving_callback Ptr AudioBaseSink
sink' FunPtr C_AudioBaseSinkCustomSlavingCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSetCustomSlavingCallbackMethodInfo
instance (signature ~ (GstAudio.Callbacks.AudioBaseSinkCustomSlavingCallback -> m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkSetCustomSlavingCallbackMethodInfo a signature where
    overloadedMethod = audioBaseSinkSetCustomSlavingCallback

#endif

-- method AudioBaseSink::set_discont_wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "discont_wait"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new discont wait in nanoseconds"
--                 , 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_base_sink_set_discont_wait" gst_audio_base_sink_set_discont_wait :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    Word64 ->                               -- discont_wait : TBasicType TUInt64
    IO ()

-- | Controls how long the sink will wait before creating a discontinuity.
audioBaseSinkSetDiscontWait ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> Word64
    -- ^ /@discontWait@/: the new discont wait in nanoseconds
    -> m ()
audioBaseSinkSetDiscontWait :: a -> Word64 -> m ()
audioBaseSinkSetDiscontWait sink :: a
sink discontWait :: Word64
discontWait = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Ptr AudioBaseSink -> Word64 -> IO ()
gst_audio_base_sink_set_discont_wait Ptr AudioBaseSink
sink' Word64
discontWait
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSetDiscontWaitMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkSetDiscontWaitMethodInfo a signature where
    overloadedMethod = audioBaseSinkSetDiscontWait

#endif

-- method AudioBaseSink::set_drift_tolerance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "drift_tolerance"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new drift tolerance in microseconds"
--                 , 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_base_sink_set_drift_tolerance" gst_audio_base_sink_set_drift_tolerance :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    Int64 ->                                -- drift_tolerance : TBasicType TInt64
    IO ()

-- | Controls the sink\'s drift tolerance.
audioBaseSinkSetDriftTolerance ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> Int64
    -- ^ /@driftTolerance@/: the new drift tolerance in microseconds
    -> m ()
audioBaseSinkSetDriftTolerance :: a -> Int64 -> m ()
audioBaseSinkSetDriftTolerance sink :: a
sink driftTolerance :: Int64
driftTolerance = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    Ptr AudioBaseSink -> Int64 -> IO ()
gst_audio_base_sink_set_drift_tolerance Ptr AudioBaseSink
sink' Int64
driftTolerance
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSetDriftToleranceMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkSetDriftToleranceMethodInfo a signature where
    overloadedMethod = audioBaseSinkSetDriftTolerance

#endif

-- method AudioBaseSink::set_provide_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provide"
--           , 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_base_sink_set_provide_clock" gst_audio_base_sink_set_provide_clock :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    CInt ->                                 -- provide : TBasicType TBoolean
    IO ()

-- | Controls whether /@sink@/ will provide a clock or not. If /@provide@/ is 'P.True',
-- 'GI.Gst.Objects.Element.elementProvideClock' will return a clock that reflects the datarate
-- of /@sink@/. If /@provide@/ is 'P.False', 'GI.Gst.Objects.Element.elementProvideClock' will return
-- NULL.
audioBaseSinkSetProvideClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> Bool
    -- ^ /@provide@/: new state
    -> m ()
audioBaseSinkSetProvideClock :: a -> Bool -> m ()
audioBaseSinkSetProvideClock sink :: a
sink provide :: Bool
provide = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    let provide' :: CInt
provide' = (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
provide
    Ptr AudioBaseSink -> CInt -> IO ()
gst_audio_base_sink_set_provide_clock Ptr AudioBaseSink
sink' CInt
provide'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSetProvideClockMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkSetProvideClockMethodInfo a signature where
    overloadedMethod = audioBaseSinkSetProvideClock

#endif

-- method AudioBaseSink::set_slave_method
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sink"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSink" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSink"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "method"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioBaseSinkSlaveMethod" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new slave method"
--                 , 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_base_sink_set_slave_method" gst_audio_base_sink_set_slave_method :: 
    Ptr AudioBaseSink ->                    -- sink : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSink"})
    CUInt ->                                -- method : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSinkSlaveMethod"})
    IO ()

-- | Controls how clock slaving will be performed in /@sink@/.
audioBaseSinkSetSlaveMethod ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSink a) =>
    a
    -- ^ /@sink@/: a t'GI.GstAudio.Objects.AudioBaseSink.AudioBaseSink'
    -> GstAudio.Enums.AudioBaseSinkSlaveMethod
    -- ^ /@method@/: the new slave method
    -> m ()
audioBaseSinkSetSlaveMethod :: a -> AudioBaseSinkSlaveMethod -> m ()
audioBaseSinkSetSlaveMethod sink :: a
sink method :: AudioBaseSinkSlaveMethod
method = 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 AudioBaseSink
sink' <- a -> IO (Ptr AudioBaseSink)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sink
    let method' :: CUInt
method' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AudioBaseSinkSlaveMethod -> Int)
-> AudioBaseSinkSlaveMethod
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioBaseSinkSlaveMethod -> Int
forall a. Enum a => a -> Int
fromEnum) AudioBaseSinkSlaveMethod
method
    Ptr AudioBaseSink -> CUInt -> IO ()
gst_audio_base_sink_set_slave_method Ptr AudioBaseSink
sink' CUInt
method'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sink
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSinkSetSlaveMethodMethodInfo
instance (signature ~ (GstAudio.Enums.AudioBaseSinkSlaveMethod -> m ()), MonadIO m, IsAudioBaseSink a) => O.MethodInfo AudioBaseSinkSetSlaveMethodMethodInfo a signature where
    overloadedMethod = audioBaseSinkSetSlaveMethod

#endif