{-# 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 sources. Subclasses need to implement the
-- [create_ringbuffer](#g:signal:create_ringbuffer) vmethod. This base class will then take care of
-- reading samples from the ringbuffer, synchronisation and flushing.

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

module GI.GstAudio.Objects.AudioBaseSrc
    ( 

-- * Exported types
    AudioBaseSrc(..)                        ,
    IsAudioBaseSrc                          ,
    toAudioBaseSrc                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioBaseSrcMethod               ,
#endif


-- ** createRingbuffer #method:createRingbuffer#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcCreateRingbufferMethodInfo  ,
#endif
    audioBaseSrcCreateRingbuffer            ,


-- ** getProvideClock #method:getProvideClock#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcGetProvideClockMethodInfo   ,
#endif
    audioBaseSrcGetProvideClock             ,


-- ** getSlaveMethod #method:getSlaveMethod#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcGetSlaveMethodMethodInfo    ,
#endif
    audioBaseSrcGetSlaveMethod              ,


-- ** setProvideClock #method:setProvideClock#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcSetProvideClockMethodInfo   ,
#endif
    audioBaseSrcSetProvideClock             ,


-- ** setSlaveMethod #method:setSlaveMethod#

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcSetSlaveMethodMethodInfo    ,
#endif
    audioBaseSrcSetSlaveMethod              ,




 -- * Properties
-- ** actualBufferTime #attr:actualBufferTime#
-- | Actual configured size of audio buffer in microseconds.

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcActualBufferTimePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSrcActualBufferTime            ,
#endif
    getAudioBaseSrcActualBufferTime         ,


-- ** actualLatencyTime #attr:actualLatencyTime#
-- | Actual configured audio latency in microseconds.

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcActualLatencyTimePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSrcActualLatencyTime           ,
#endif
    getAudioBaseSrcActualLatencyTime        ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcBufferTimePropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSrcBufferTime                  ,
#endif
    constructAudioBaseSrcBufferTime         ,
    getAudioBaseSrcBufferTime               ,
    setAudioBaseSrcBufferTime               ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcLatencyTimePropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSrcLatencyTime                 ,
#endif
    constructAudioBaseSrcLatencyTime        ,
    getAudioBaseSrcLatencyTime              ,
    setAudioBaseSrcLatencyTime              ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcProvideClockPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSrcProvideClock                ,
#endif
    constructAudioBaseSrcProvideClock       ,
    getAudioBaseSrcProvideClock             ,
    setAudioBaseSrcProvideClock             ,


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

#if defined(ENABLE_OVERLOADING)
    AudioBaseSrcSlaveMethodPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    audioBaseSrcSlaveMethod                 ,
#endif
    constructAudioBaseSrcSlaveMethod        ,
    getAudioBaseSrcSlaveMethod              ,
    setAudioBaseSrcSlaveMethod              ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Objects.Element as Gst.Element
import qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.GstAudio.Enums as GstAudio.Enums
import {-# SOURCE #-} qualified GI.GstAudio.Objects.AudioRingBuffer as GstAudio.AudioRingBuffer
import qualified GI.GstBase.Objects.BaseSrc as GstBase.BaseSrc
import qualified GI.GstBase.Objects.PushSrc as GstBase.PushSrc

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

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

foreign import ccall "gst_audio_base_src_get_type"
    c_gst_audio_base_src_get_type :: IO B.Types.GType

instance B.Types.TypedObject AudioBaseSrc where
    glibType :: IO GType
glibType = IO GType
c_gst_audio_base_src_get_type

instance B.Types.GObject AudioBaseSrc

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

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

instance O.HasParentTypes AudioBaseSrc
type instance O.ParentTypes AudioBaseSrc = '[GstBase.PushSrc.PushSrc, GstBase.BaseSrc.BaseSrc, Gst.Element.Element, Gst.Object.Object, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioBaseSrcMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioBaseSrcMethod "abortState" o = Gst.Element.ElementAbortStateMethodInfo
    ResolveAudioBaseSrcMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveAudioBaseSrcMethod "addPad" o = Gst.Element.ElementAddPadMethodInfo
    ResolveAudioBaseSrcMethod "addPropertyDeepNotifyWatch" o = Gst.Element.ElementAddPropertyDeepNotifyWatchMethodInfo
    ResolveAudioBaseSrcMethod "addPropertyNotifyWatch" o = Gst.Element.ElementAddPropertyNotifyWatchMethodInfo
    ResolveAudioBaseSrcMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAudioBaseSrcMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAudioBaseSrcMethod "callAsync" o = Gst.Element.ElementCallAsyncMethodInfo
    ResolveAudioBaseSrcMethod "changeState" o = Gst.Element.ElementChangeStateMethodInfo
    ResolveAudioBaseSrcMethod "continueState" o = Gst.Element.ElementContinueStateMethodInfo
    ResolveAudioBaseSrcMethod "createAllPads" o = Gst.Element.ElementCreateAllPadsMethodInfo
    ResolveAudioBaseSrcMethod "createRingbuffer" o = AudioBaseSrcCreateRingbufferMethodInfo
    ResolveAudioBaseSrcMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveAudioBaseSrcMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAudioBaseSrcMethod "foreachPad" o = Gst.Element.ElementForeachPadMethodInfo
    ResolveAudioBaseSrcMethod "foreachSinkPad" o = Gst.Element.ElementForeachSinkPadMethodInfo
    ResolveAudioBaseSrcMethod "foreachSrcPad" o = Gst.Element.ElementForeachSrcPadMethodInfo
    ResolveAudioBaseSrcMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAudioBaseSrcMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAudioBaseSrcMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveAudioBaseSrcMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveAudioBaseSrcMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveAudioBaseSrcMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveAudioBaseSrcMethod "isAsync" o = GstBase.BaseSrc.BaseSrcIsAsyncMethodInfo
    ResolveAudioBaseSrcMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAudioBaseSrcMethod "isLive" o = GstBase.BaseSrc.BaseSrcIsLiveMethodInfo
    ResolveAudioBaseSrcMethod "isLockedState" o = Gst.Element.ElementIsLockedStateMethodInfo
    ResolveAudioBaseSrcMethod "iteratePads" o = Gst.Element.ElementIteratePadsMethodInfo
    ResolveAudioBaseSrcMethod "iterateSinkPads" o = Gst.Element.ElementIterateSinkPadsMethodInfo
    ResolveAudioBaseSrcMethod "iterateSrcPads" o = Gst.Element.ElementIterateSrcPadsMethodInfo
    ResolveAudioBaseSrcMethod "link" o = Gst.Element.ElementLinkMethodInfo
    ResolveAudioBaseSrcMethod "linkFiltered" o = Gst.Element.ElementLinkFilteredMethodInfo
    ResolveAudioBaseSrcMethod "linkPads" o = Gst.Element.ElementLinkPadsMethodInfo
    ResolveAudioBaseSrcMethod "linkPadsFiltered" o = Gst.Element.ElementLinkPadsFilteredMethodInfo
    ResolveAudioBaseSrcMethod "linkPadsFull" o = Gst.Element.ElementLinkPadsFullMethodInfo
    ResolveAudioBaseSrcMethod "lostState" o = Gst.Element.ElementLostStateMethodInfo
    ResolveAudioBaseSrcMethod "messageFull" o = Gst.Element.ElementMessageFullMethodInfo
    ResolveAudioBaseSrcMethod "messageFullWithDetails" o = Gst.Element.ElementMessageFullWithDetailsMethodInfo
    ResolveAudioBaseSrcMethod "newSeamlessSegment" o = GstBase.BaseSrc.BaseSrcNewSeamlessSegmentMethodInfo
    ResolveAudioBaseSrcMethod "noMorePads" o = Gst.Element.ElementNoMorePadsMethodInfo
    ResolveAudioBaseSrcMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAudioBaseSrcMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAudioBaseSrcMethod "postMessage" o = Gst.Element.ElementPostMessageMethodInfo
    ResolveAudioBaseSrcMethod "provideClock" o = Gst.Element.ElementProvideClockMethodInfo
    ResolveAudioBaseSrcMethod "query" o = Gst.Element.ElementQueryMethodInfo
    ResolveAudioBaseSrcMethod "queryConvert" o = Gst.Element.ElementQueryConvertMethodInfo
    ResolveAudioBaseSrcMethod "queryDuration" o = Gst.Element.ElementQueryDurationMethodInfo
    ResolveAudioBaseSrcMethod "queryLatency" o = GstBase.BaseSrc.BaseSrcQueryLatencyMethodInfo
    ResolveAudioBaseSrcMethod "queryPosition" o = Gst.Element.ElementQueryPositionMethodInfo
    ResolveAudioBaseSrcMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveAudioBaseSrcMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAudioBaseSrcMethod "releaseRequestPad" o = Gst.Element.ElementReleaseRequestPadMethodInfo
    ResolveAudioBaseSrcMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveAudioBaseSrcMethod "removePad" o = Gst.Element.ElementRemovePadMethodInfo
    ResolveAudioBaseSrcMethod "removePropertyNotifyWatch" o = Gst.Element.ElementRemovePropertyNotifyWatchMethodInfo
    ResolveAudioBaseSrcMethod "requestPad" o = Gst.Element.ElementRequestPadMethodInfo
    ResolveAudioBaseSrcMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAudioBaseSrcMethod "seek" o = Gst.Element.ElementSeekMethodInfo
    ResolveAudioBaseSrcMethod "seekSimple" o = Gst.Element.ElementSeekSimpleMethodInfo
    ResolveAudioBaseSrcMethod "sendEvent" o = Gst.Element.ElementSendEventMethodInfo
    ResolveAudioBaseSrcMethod "startComplete" o = GstBase.BaseSrc.BaseSrcStartCompleteMethodInfo
    ResolveAudioBaseSrcMethod "startWait" o = GstBase.BaseSrc.BaseSrcStartWaitMethodInfo
    ResolveAudioBaseSrcMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAudioBaseSrcMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAudioBaseSrcMethod "submitBufferList" o = GstBase.BaseSrc.BaseSrcSubmitBufferListMethodInfo
    ResolveAudioBaseSrcMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveAudioBaseSrcMethod "syncStateWithParent" o = Gst.Element.ElementSyncStateWithParentMethodInfo
    ResolveAudioBaseSrcMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveAudioBaseSrcMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAudioBaseSrcMethod "unlink" o = Gst.Element.ElementUnlinkMethodInfo
    ResolveAudioBaseSrcMethod "unlinkPads" o = Gst.Element.ElementUnlinkPadsMethodInfo
    ResolveAudioBaseSrcMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveAudioBaseSrcMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveAudioBaseSrcMethod "waitPlaying" o = GstBase.BaseSrc.BaseSrcWaitPlayingMethodInfo
    ResolveAudioBaseSrcMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAudioBaseSrcMethod "getAllocator" o = GstBase.BaseSrc.BaseSrcGetAllocatorMethodInfo
    ResolveAudioBaseSrcMethod "getBaseTime" o = Gst.Element.ElementGetBaseTimeMethodInfo
    ResolveAudioBaseSrcMethod "getBlocksize" o = GstBase.BaseSrc.BaseSrcGetBlocksizeMethodInfo
    ResolveAudioBaseSrcMethod "getBufferPool" o = GstBase.BaseSrc.BaseSrcGetBufferPoolMethodInfo
    ResolveAudioBaseSrcMethod "getBus" o = Gst.Element.ElementGetBusMethodInfo
    ResolveAudioBaseSrcMethod "getClock" o = Gst.Element.ElementGetClockMethodInfo
    ResolveAudioBaseSrcMethod "getCompatiblePad" o = Gst.Element.ElementGetCompatiblePadMethodInfo
    ResolveAudioBaseSrcMethod "getCompatiblePadTemplate" o = Gst.Element.ElementGetCompatiblePadTemplateMethodInfo
    ResolveAudioBaseSrcMethod "getContext" o = Gst.Element.ElementGetContextMethodInfo
    ResolveAudioBaseSrcMethod "getContextUnlocked" o = Gst.Element.ElementGetContextUnlockedMethodInfo
    ResolveAudioBaseSrcMethod "getContexts" o = Gst.Element.ElementGetContextsMethodInfo
    ResolveAudioBaseSrcMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveAudioBaseSrcMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveAudioBaseSrcMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAudioBaseSrcMethod "getDoTimestamp" o = GstBase.BaseSrc.BaseSrcGetDoTimestampMethodInfo
    ResolveAudioBaseSrcMethod "getFactory" o = Gst.Element.ElementGetFactoryMethodInfo
    ResolveAudioBaseSrcMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveAudioBaseSrcMethod "getMetadata" o = Gst.Element.ElementGetMetadataMethodInfo
    ResolveAudioBaseSrcMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveAudioBaseSrcMethod "getPadTemplate" o = Gst.Element.ElementGetPadTemplateMethodInfo
    ResolveAudioBaseSrcMethod "getPadTemplateList" o = Gst.Element.ElementGetPadTemplateListMethodInfo
    ResolveAudioBaseSrcMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveAudioBaseSrcMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveAudioBaseSrcMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAudioBaseSrcMethod "getProvideClock" o = AudioBaseSrcGetProvideClockMethodInfo
    ResolveAudioBaseSrcMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAudioBaseSrcMethod "getRequestPad" o = Gst.Element.ElementGetRequestPadMethodInfo
    ResolveAudioBaseSrcMethod "getSlaveMethod" o = AudioBaseSrcGetSlaveMethodMethodInfo
    ResolveAudioBaseSrcMethod "getStartTime" o = Gst.Element.ElementGetStartTimeMethodInfo
    ResolveAudioBaseSrcMethod "getState" o = Gst.Element.ElementGetStateMethodInfo
    ResolveAudioBaseSrcMethod "getStaticPad" o = Gst.Element.ElementGetStaticPadMethodInfo
    ResolveAudioBaseSrcMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveAudioBaseSrcMethod "setAsync" o = GstBase.BaseSrc.BaseSrcSetAsyncMethodInfo
    ResolveAudioBaseSrcMethod "setAutomaticEos" o = GstBase.BaseSrc.BaseSrcSetAutomaticEosMethodInfo
    ResolveAudioBaseSrcMethod "setBaseTime" o = Gst.Element.ElementSetBaseTimeMethodInfo
    ResolveAudioBaseSrcMethod "setBlocksize" o = GstBase.BaseSrc.BaseSrcSetBlocksizeMethodInfo
    ResolveAudioBaseSrcMethod "setBus" o = Gst.Element.ElementSetBusMethodInfo
    ResolveAudioBaseSrcMethod "setCaps" o = GstBase.BaseSrc.BaseSrcSetCapsMethodInfo
    ResolveAudioBaseSrcMethod "setClock" o = Gst.Element.ElementSetClockMethodInfo
    ResolveAudioBaseSrcMethod "setContext" o = Gst.Element.ElementSetContextMethodInfo
    ResolveAudioBaseSrcMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveAudioBaseSrcMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveAudioBaseSrcMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveAudioBaseSrcMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAudioBaseSrcMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAudioBaseSrcMethod "setDoTimestamp" o = GstBase.BaseSrc.BaseSrcSetDoTimestampMethodInfo
    ResolveAudioBaseSrcMethod "setDynamicSize" o = GstBase.BaseSrc.BaseSrcSetDynamicSizeMethodInfo
    ResolveAudioBaseSrcMethod "setFormat" o = GstBase.BaseSrc.BaseSrcSetFormatMethodInfo
    ResolveAudioBaseSrcMethod "setLive" o = GstBase.BaseSrc.BaseSrcSetLiveMethodInfo
    ResolveAudioBaseSrcMethod "setLockedState" o = Gst.Element.ElementSetLockedStateMethodInfo
    ResolveAudioBaseSrcMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveAudioBaseSrcMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveAudioBaseSrcMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAudioBaseSrcMethod "setProvideClock" o = AudioBaseSrcSetProvideClockMethodInfo
    ResolveAudioBaseSrcMethod "setSlaveMethod" o = AudioBaseSrcSetSlaveMethodMethodInfo
    ResolveAudioBaseSrcMethod "setStartTime" o = Gst.Element.ElementSetStartTimeMethodInfo
    ResolveAudioBaseSrcMethod "setState" o = Gst.Element.ElementSetStateMethodInfo
    ResolveAudioBaseSrcMethod l o = O.MethodResolutionFailed l o

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

#endif

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

-- | Get the value of the “@actual-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' audioBaseSrc #actualBufferTime
-- @
getAudioBaseSrcActualBufferTime :: (MonadIO m, IsAudioBaseSrc o) => o -> m Int64
getAudioBaseSrcActualBufferTime :: o -> m Int64
getAudioBaseSrcActualBufferTime 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 String
"actual-buffer-time"

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcActualBufferTimePropertyInfo
instance AttrInfo AudioBaseSrcActualBufferTimePropertyInfo where
    type AttrAllowedOps AudioBaseSrcActualBufferTimePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSrcActualBufferTimePropertyInfo = IsAudioBaseSrc
    type AttrSetTypeConstraint AudioBaseSrcActualBufferTimePropertyInfo = (~) ()
    type AttrTransferTypeConstraint AudioBaseSrcActualBufferTimePropertyInfo = (~) ()
    type AttrTransferType AudioBaseSrcActualBufferTimePropertyInfo = ()
    type AttrGetType AudioBaseSrcActualBufferTimePropertyInfo = Int64
    type AttrLabel AudioBaseSrcActualBufferTimePropertyInfo = "actual-buffer-time"
    type AttrOrigin AudioBaseSrcActualBufferTimePropertyInfo = AudioBaseSrc
    attrGet = getAudioBaseSrcActualBufferTime
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

-- | Get the value of the “@actual-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' audioBaseSrc #actualLatencyTime
-- @
getAudioBaseSrcActualLatencyTime :: (MonadIO m, IsAudioBaseSrc o) => o -> m Int64
getAudioBaseSrcActualLatencyTime :: o -> m Int64
getAudioBaseSrcActualLatencyTime 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 String
"actual-latency-time"

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcActualLatencyTimePropertyInfo
instance AttrInfo AudioBaseSrcActualLatencyTimePropertyInfo where
    type AttrAllowedOps AudioBaseSrcActualLatencyTimePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSrcActualLatencyTimePropertyInfo = IsAudioBaseSrc
    type AttrSetTypeConstraint AudioBaseSrcActualLatencyTimePropertyInfo = (~) ()
    type AttrTransferTypeConstraint AudioBaseSrcActualLatencyTimePropertyInfo = (~) ()
    type AttrTransferType AudioBaseSrcActualLatencyTimePropertyInfo = ()
    type AttrGetType AudioBaseSrcActualLatencyTimePropertyInfo = Int64
    type AttrLabel AudioBaseSrcActualLatencyTimePropertyInfo = "actual-latency-time"
    type AttrOrigin AudioBaseSrcActualLatencyTimePropertyInfo = AudioBaseSrc
    attrGet = getAudioBaseSrcActualLatencyTime
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    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' audioBaseSrc #bufferTime
-- @
getAudioBaseSrcBufferTime :: (MonadIO m, IsAudioBaseSrc o) => o -> m Int64
getAudioBaseSrcBufferTime :: o -> m Int64
getAudioBaseSrcBufferTime 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 String
"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' audioBaseSrc [ #bufferTime 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSrcBufferTime :: (MonadIO m, IsAudioBaseSrc o) => o -> Int64 -> m ()
setAudioBaseSrcBufferTime :: o -> Int64 -> m ()
setAudioBaseSrcBufferTime o
obj 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 String
"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`.
constructAudioBaseSrcBufferTime :: (IsAudioBaseSrc o, MIO.MonadIO m) => Int64 -> m (GValueConstruct o)
constructAudioBaseSrcBufferTime :: Int64 -> m (GValueConstruct o)
constructAudioBaseSrcBufferTime Int64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int64 -> IO (GValueConstruct o)
forall o. String -> Int64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt64 String
"buffer-time" Int64
val

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcBufferTimePropertyInfo
instance AttrInfo AudioBaseSrcBufferTimePropertyInfo where
    type AttrAllowedOps AudioBaseSrcBufferTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSrcBufferTimePropertyInfo = IsAudioBaseSrc
    type AttrSetTypeConstraint AudioBaseSrcBufferTimePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint AudioBaseSrcBufferTimePropertyInfo = (~) Int64
    type AttrTransferType AudioBaseSrcBufferTimePropertyInfo = Int64
    type AttrGetType AudioBaseSrcBufferTimePropertyInfo = Int64
    type AttrLabel AudioBaseSrcBufferTimePropertyInfo = "buffer-time"
    type AttrOrigin AudioBaseSrcBufferTimePropertyInfo = AudioBaseSrc
    attrGet = getAudioBaseSrcBufferTime
    attrSet = setAudioBaseSrcBufferTime
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSrcBufferTime
    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' audioBaseSrc #latencyTime
-- @
getAudioBaseSrcLatencyTime :: (MonadIO m, IsAudioBaseSrc o) => o -> m Int64
getAudioBaseSrcLatencyTime :: o -> m Int64
getAudioBaseSrcLatencyTime 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 String
"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' audioBaseSrc [ #latencyTime 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSrcLatencyTime :: (MonadIO m, IsAudioBaseSrc o) => o -> Int64 -> m ()
setAudioBaseSrcLatencyTime :: o -> Int64 -> m ()
setAudioBaseSrcLatencyTime o
obj 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 String
"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`.
constructAudioBaseSrcLatencyTime :: (IsAudioBaseSrc o, MIO.MonadIO m) => Int64 -> m (GValueConstruct o)
constructAudioBaseSrcLatencyTime :: Int64 -> m (GValueConstruct o)
constructAudioBaseSrcLatencyTime Int64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int64 -> IO (GValueConstruct o)
forall o. String -> Int64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt64 String
"latency-time" Int64
val

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcLatencyTimePropertyInfo
instance AttrInfo AudioBaseSrcLatencyTimePropertyInfo where
    type AttrAllowedOps AudioBaseSrcLatencyTimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSrcLatencyTimePropertyInfo = IsAudioBaseSrc
    type AttrSetTypeConstraint AudioBaseSrcLatencyTimePropertyInfo = (~) Int64
    type AttrTransferTypeConstraint AudioBaseSrcLatencyTimePropertyInfo = (~) Int64
    type AttrTransferType AudioBaseSrcLatencyTimePropertyInfo = Int64
    type AttrGetType AudioBaseSrcLatencyTimePropertyInfo = Int64
    type AttrLabel AudioBaseSrcLatencyTimePropertyInfo = "latency-time"
    type AttrOrigin AudioBaseSrcLatencyTimePropertyInfo = AudioBaseSrc
    attrGet = getAudioBaseSrcLatencyTime
    attrSet = setAudioBaseSrcLatencyTime
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSrcLatencyTime
    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' audioBaseSrc #provideClock
-- @
getAudioBaseSrcProvideClock :: (MonadIO m, IsAudioBaseSrc o) => o -> m Bool
getAudioBaseSrcProvideClock :: o -> m Bool
getAudioBaseSrcProvideClock o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"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' audioBaseSrc [ #provideClock 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSrcProvideClock :: (MonadIO m, IsAudioBaseSrc o) => o -> Bool -> m ()
setAudioBaseSrcProvideClock :: o -> Bool -> m ()
setAudioBaseSrcProvideClock o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"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`.
constructAudioBaseSrcProvideClock :: (IsAudioBaseSrc o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAudioBaseSrcProvideClock :: Bool -> m (GValueConstruct o)
constructAudioBaseSrcProvideClock Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"provide-clock" Bool
val

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcProvideClockPropertyInfo
instance AttrInfo AudioBaseSrcProvideClockPropertyInfo where
    type AttrAllowedOps AudioBaseSrcProvideClockPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSrcProvideClockPropertyInfo = IsAudioBaseSrc
    type AttrSetTypeConstraint AudioBaseSrcProvideClockPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AudioBaseSrcProvideClockPropertyInfo = (~) Bool
    type AttrTransferType AudioBaseSrcProvideClockPropertyInfo = Bool
    type AttrGetType AudioBaseSrcProvideClockPropertyInfo = Bool
    type AttrLabel AudioBaseSrcProvideClockPropertyInfo = "provide-clock"
    type AttrOrigin AudioBaseSrcProvideClockPropertyInfo = AudioBaseSrc
    attrGet = getAudioBaseSrcProvideClock
    attrSet = setAudioBaseSrcProvideClock
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSrcProvideClock
    attrClear = undefined
#endif

-- VVV Prop "slave-method"
   -- Type: TInterface (Name {namespace = "GstAudio", name = "AudioBaseSrcSlaveMethod"})
   -- 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' audioBaseSrc #slaveMethod
-- @
getAudioBaseSrcSlaveMethod :: (MonadIO m, IsAudioBaseSrc o) => o -> m GstAudio.Enums.AudioBaseSrcSlaveMethod
getAudioBaseSrcSlaveMethod :: o -> m AudioBaseSrcSlaveMethod
getAudioBaseSrcSlaveMethod o
obj = IO AudioBaseSrcSlaveMethod -> m AudioBaseSrcSlaveMethod
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioBaseSrcSlaveMethod -> m AudioBaseSrcSlaveMethod)
-> IO AudioBaseSrcSlaveMethod -> m AudioBaseSrcSlaveMethod
forall a b. (a -> b) -> a -> b
$ o -> String -> IO AudioBaseSrcSlaveMethod
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"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' audioBaseSrc [ #slaveMethod 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBaseSrcSlaveMethod :: (MonadIO m, IsAudioBaseSrc o) => o -> GstAudio.Enums.AudioBaseSrcSlaveMethod -> m ()
setAudioBaseSrcSlaveMethod :: o -> AudioBaseSrcSlaveMethod -> m ()
setAudioBaseSrcSlaveMethod o
obj AudioBaseSrcSlaveMethod
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 -> AudioBaseSrcSlaveMethod -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"slave-method" AudioBaseSrcSlaveMethod
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`.
constructAudioBaseSrcSlaveMethod :: (IsAudioBaseSrc o, MIO.MonadIO m) => GstAudio.Enums.AudioBaseSrcSlaveMethod -> m (GValueConstruct o)
constructAudioBaseSrcSlaveMethod :: AudioBaseSrcSlaveMethod -> m (GValueConstruct o)
constructAudioBaseSrcSlaveMethod AudioBaseSrcSlaveMethod
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> AudioBaseSrcSlaveMethod -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"slave-method" AudioBaseSrcSlaveMethod
val

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcSlaveMethodPropertyInfo
instance AttrInfo AudioBaseSrcSlaveMethodPropertyInfo where
    type AttrAllowedOps AudioBaseSrcSlaveMethodPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AudioBaseSrcSlaveMethodPropertyInfo = IsAudioBaseSrc
    type AttrSetTypeConstraint AudioBaseSrcSlaveMethodPropertyInfo = (~) GstAudio.Enums.AudioBaseSrcSlaveMethod
    type AttrTransferTypeConstraint AudioBaseSrcSlaveMethodPropertyInfo = (~) GstAudio.Enums.AudioBaseSrcSlaveMethod
    type AttrTransferType AudioBaseSrcSlaveMethodPropertyInfo = GstAudio.Enums.AudioBaseSrcSlaveMethod
    type AttrGetType AudioBaseSrcSlaveMethodPropertyInfo = GstAudio.Enums.AudioBaseSrcSlaveMethod
    type AttrLabel AudioBaseSrcSlaveMethodPropertyInfo = "slave-method"
    type AttrOrigin AudioBaseSrcSlaveMethodPropertyInfo = AudioBaseSrc
    attrGet = getAudioBaseSrcSlaveMethod
    attrSet = setAudioBaseSrcSlaveMethod
    attrTransfer _ v = do
        return v
    attrConstruct = constructAudioBaseSrcSlaveMethod
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioBaseSrc
type instance O.AttributeList AudioBaseSrc = AudioBaseSrcAttributeList
type AudioBaseSrcAttributeList = ('[ '("actualBufferTime", AudioBaseSrcActualBufferTimePropertyInfo), '("actualLatencyTime", AudioBaseSrcActualLatencyTimePropertyInfo), '("blocksize", GstBase.BaseSrc.BaseSrcBlocksizePropertyInfo), '("bufferTime", AudioBaseSrcBufferTimePropertyInfo), '("doTimestamp", GstBase.BaseSrc.BaseSrcDoTimestampPropertyInfo), '("latencyTime", AudioBaseSrcLatencyTimePropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("numBuffers", GstBase.BaseSrc.BaseSrcNumBuffersPropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("provideClock", AudioBaseSrcProvideClockPropertyInfo), '("slaveMethod", AudioBaseSrcSlaveMethodPropertyInfo), '("typefind", GstBase.BaseSrc.BaseSrcTypefindPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
audioBaseSrcActualBufferTime :: AttrLabelProxy "actualBufferTime"
audioBaseSrcActualBufferTime = AttrLabelProxy

audioBaseSrcActualLatencyTime :: AttrLabelProxy "actualLatencyTime"
audioBaseSrcActualLatencyTime = AttrLabelProxy

audioBaseSrcBufferTime :: AttrLabelProxy "bufferTime"
audioBaseSrcBufferTime = AttrLabelProxy

audioBaseSrcLatencyTime :: AttrLabelProxy "latencyTime"
audioBaseSrcLatencyTime = AttrLabelProxy

audioBaseSrcProvideClock :: AttrLabelProxy "provideClock"
audioBaseSrcProvideClock = AttrLabelProxy

audioBaseSrcSlaveMethod :: AttrLabelProxy "slaveMethod"
audioBaseSrcSlaveMethod = AttrLabelProxy

#endif

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

#endif

-- method AudioBaseSrc::create_ringbuffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSrc."
--                 , 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_src_create_ringbuffer" gst_audio_base_src_create_ringbuffer :: 
    Ptr AudioBaseSrc ->                     -- src : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSrc"})
    IO (Ptr GstAudio.AudioRingBuffer.AudioRingBuffer)

-- | Create and return the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' for /@src@/. This function will call
-- the [create_ringbuffer](#g:signal:create_ringbuffer) vmethod and will set /@src@/ as the parent of the
-- returned buffer (see 'GI.Gst.Objects.Object.objectSetParent').
audioBaseSrcCreateRingbuffer ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstAudio.Objects.AudioBaseSrc.AudioBaseSrc'.
    -> m GstAudio.AudioRingBuffer.AudioRingBuffer
    -- ^ __Returns:__ The new ringbuffer of /@src@/.
audioBaseSrcCreateRingbuffer :: a -> m AudioRingBuffer
audioBaseSrcCreateRingbuffer a
src = 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 AudioBaseSrc
src' <- a -> IO (Ptr AudioBaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr AudioRingBuffer
result <- Ptr AudioBaseSrc -> IO (Ptr AudioRingBuffer)
gst_audio_base_src_create_ringbuffer Ptr AudioBaseSrc
src'
    Text -> Ptr AudioRingBuffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioBaseSrcCreateRingbuffer" 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
src
    AudioRingBuffer -> IO AudioRingBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return AudioRingBuffer
result'

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcCreateRingbufferMethodInfo
instance (signature ~ (m GstAudio.AudioRingBuffer.AudioRingBuffer), MonadIO m, IsAudioBaseSrc a) => O.MethodInfo AudioBaseSrcCreateRingbufferMethodInfo a signature where
    overloadedMethod = audioBaseSrcCreateRingbuffer

#endif

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

-- | Queries whether /@src@/ will provide a clock or not. See also
-- gst_audio_base_src_set_provide_clock.
audioBaseSrcGetProvideClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstAudio.Objects.AudioBaseSrc.AudioBaseSrc'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@src@/ will provide a clock.
audioBaseSrcGetProvideClock :: a -> m Bool
audioBaseSrcGetProvideClock a
src = 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 AudioBaseSrc
src' <- a -> IO (Ptr AudioBaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CInt
result <- Ptr AudioBaseSrc -> IO CInt
gst_audio_base_src_get_provide_clock Ptr AudioBaseSrc
src'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcGetProvideClockMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioBaseSrc a) => O.MethodInfo AudioBaseSrcGetProvideClockMethodInfo a signature where
    overloadedMethod = audioBaseSrcGetProvideClock

#endif

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

foreign import ccall "gst_audio_base_src_get_slave_method" gst_audio_base_src_get_slave_method :: 
    Ptr AudioBaseSrc ->                     -- src : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSrc"})
    IO CUInt

-- | Get the current slave method used by /@src@/.
audioBaseSrcGetSlaveMethod ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstAudio.Objects.AudioBaseSrc.AudioBaseSrc'
    -> m GstAudio.Enums.AudioBaseSrcSlaveMethod
    -- ^ __Returns:__ The current slave method used by /@src@/.
audioBaseSrcGetSlaveMethod :: a -> m AudioBaseSrcSlaveMethod
audioBaseSrcGetSlaveMethod a
src = IO AudioBaseSrcSlaveMethod -> m AudioBaseSrcSlaveMethod
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioBaseSrcSlaveMethod -> m AudioBaseSrcSlaveMethod)
-> IO AudioBaseSrcSlaveMethod -> m AudioBaseSrcSlaveMethod
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioBaseSrc
src' <- a -> IO (Ptr AudioBaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CUInt
result <- Ptr AudioBaseSrc -> IO CUInt
gst_audio_base_src_get_slave_method Ptr AudioBaseSrc
src'
    let result' :: AudioBaseSrcSlaveMethod
result' = (Int -> AudioBaseSrcSlaveMethod
forall a. Enum a => Int -> a
toEnum (Int -> AudioBaseSrcSlaveMethod)
-> (CUInt -> Int) -> CUInt -> AudioBaseSrcSlaveMethod
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
src
    AudioBaseSrcSlaveMethod -> IO AudioBaseSrcSlaveMethod
forall (m :: * -> *) a. Monad m => a -> m a
return AudioBaseSrcSlaveMethod
result'

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcGetSlaveMethodMethodInfo
instance (signature ~ (m GstAudio.Enums.AudioBaseSrcSlaveMethod), MonadIO m, IsAudioBaseSrc a) => O.MethodInfo AudioBaseSrcGetSlaveMethodMethodInfo a signature where
    overloadedMethod = audioBaseSrcGetSlaveMethod

#endif

-- method AudioBaseSrc::set_provide_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSrc" , 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_src_set_provide_clock" gst_audio_base_src_set_provide_clock :: 
    Ptr AudioBaseSrc ->                     -- src : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSrc"})
    CInt ->                                 -- provide : TBasicType TBoolean
    IO ()

-- | Controls whether /@src@/ 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 /@src@/. If /@provide@/ is 'P.False', 'GI.Gst.Objects.Element.elementProvideClock' will return NULL.
audioBaseSrcSetProvideClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioBaseSrc a) =>
    a
    -- ^ /@src@/: a t'GI.GstAudio.Objects.AudioBaseSrc.AudioBaseSrc'
    -> Bool
    -- ^ /@provide@/: new state
    -> m ()
audioBaseSrcSetProvideClock :: a -> Bool -> m ()
audioBaseSrcSetProvideClock a
src 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 AudioBaseSrc
src' <- a -> IO (Ptr AudioBaseSrc)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    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 AudioBaseSrc -> CInt -> IO ()
gst_audio_base_src_set_provide_clock Ptr AudioBaseSrc
src' CInt
provide'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcSetProvideClockMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioBaseSrc a) => O.MethodInfo AudioBaseSrcSetProvideClockMethodInfo a signature where
    overloadedMethod = audioBaseSrcSetProvideClock

#endif

-- method AudioBaseSrc::set_slave_method
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "src"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBaseSrc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioBaseSrc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "method"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioBaseSrcSlaveMethod" }
--           , 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_src_set_slave_method" gst_audio_base_src_set_slave_method :: 
    Ptr AudioBaseSrc ->                     -- src : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSrc"})
    CUInt ->                                -- method : TInterface (Name {namespace = "GstAudio", name = "AudioBaseSrcSlaveMethod"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data AudioBaseSrcSetSlaveMethodMethodInfo
instance (signature ~ (GstAudio.Enums.AudioBaseSrcSlaveMethod -> m ()), MonadIO m, IsAudioBaseSrc a) => O.MethodInfo AudioBaseSrcSetSlaveMethodMethodInfo a signature where
    overloadedMethod = audioBaseSrcSetSlaveMethod

#endif