{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This object is the base class for audio ringbuffers used by the base
-- audio source and sink classes.
-- 
-- The ringbuffer abstracts a circular buffer of data. One reader and
-- one writer can operate on the data from different threads in a lockfree
-- manner. The base class is sufficiently flexible to be used as an
-- abstraction for DMA based ringbuffers as well as a pure software
-- implementations.

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

module GI.GstAudio.Objects.AudioRingBuffer
    ( 

-- * Exported types
    AudioRingBuffer(..)                     ,
    IsAudioRingBuffer                       ,
    toAudioRingBuffer                       ,
    noAudioRingBuffer                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioRingBufferMethod            ,
#endif


-- ** acquire #method:acquire#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferAcquireMethodInfo        ,
#endif
    audioRingBufferAcquire                  ,


-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferActivateMethodInfo       ,
#endif
    audioRingBufferActivate                 ,


-- ** advance #method:advance#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferAdvanceMethodInfo        ,
#endif
    audioRingBufferAdvance                  ,


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferClearMethodInfo          ,
#endif
    audioRingBufferClear                    ,


-- ** clearAll #method:clearAll#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferClearAllMethodInfo       ,
#endif
    audioRingBufferClearAll                 ,


-- ** closeDevice #method:closeDevice#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferCloseDeviceMethodInfo    ,
#endif
    audioRingBufferCloseDevice              ,


-- ** commit #method:commit#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferCommitMethodInfo         ,
#endif
    audioRingBufferCommit                   ,


-- ** convert #method:convert#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferConvertMethodInfo        ,
#endif
    audioRingBufferConvert                  ,


-- ** debugSpecBuff #method:debugSpecBuff#

    audioRingBufferDebugSpecBuff            ,


-- ** debugSpecCaps #method:debugSpecCaps#

    audioRingBufferDebugSpecCaps            ,


-- ** delay #method:delay#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferDelayMethodInfo          ,
#endif
    audioRingBufferDelay                    ,


-- ** deviceIsOpen #method:deviceIsOpen#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferDeviceIsOpenMethodInfo   ,
#endif
    audioRingBufferDeviceIsOpen             ,


-- ** isAcquired #method:isAcquired#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferIsAcquiredMethodInfo     ,
#endif
    audioRingBufferIsAcquired               ,


-- ** isActive #method:isActive#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferIsActiveMethodInfo       ,
#endif
    audioRingBufferIsActive                 ,


-- ** isFlushing #method:isFlushing#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferIsFlushingMethodInfo     ,
#endif
    audioRingBufferIsFlushing               ,


-- ** mayStart #method:mayStart#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferMayStartMethodInfo       ,
#endif
    audioRingBufferMayStart                 ,


-- ** openDevice #method:openDevice#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferOpenDeviceMethodInfo     ,
#endif
    audioRingBufferOpenDevice               ,


-- ** parseCaps #method:parseCaps#

    audioRingBufferParseCaps                ,


-- ** pause #method:pause#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferPauseMethodInfo          ,
#endif
    audioRingBufferPause                    ,


-- ** prepareRead #method:prepareRead#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferPrepareReadMethodInfo    ,
#endif
    audioRingBufferPrepareRead              ,


-- ** read #method:read#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferReadMethodInfo           ,
#endif
    audioRingBufferRead                     ,


-- ** release #method:release#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferReleaseMethodInfo        ,
#endif
    audioRingBufferRelease                  ,


-- ** samplesDone #method:samplesDone#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferSamplesDoneMethodInfo    ,
#endif
    audioRingBufferSamplesDone              ,


-- ** setCallback #method:setCallback#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferSetCallbackMethodInfo    ,
#endif
    audioRingBufferSetCallback              ,


-- ** setChannelPositions #method:setChannelPositions#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferSetChannelPositionsMethodInfo,
#endif
    audioRingBufferSetChannelPositions      ,


-- ** setFlushing #method:setFlushing#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferSetFlushingMethodInfo    ,
#endif
    audioRingBufferSetFlushing              ,


-- ** setSample #method:setSample#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferSetSampleMethodInfo      ,
#endif
    audioRingBufferSetSample                ,


-- ** setTimestamp #method:setTimestamp#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferSetTimestampMethodInfo   ,
#endif
    audioRingBufferSetTimestamp             ,


-- ** start #method:start#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferStartMethodInfo          ,
#endif
    audioRingBufferStart                    ,


-- ** stop #method:stop#

#if defined(ENABLE_OVERLOADING)
    AudioRingBufferStopMethodInfo           ,
#endif
    audioRingBufferStop                     ,




    ) 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.Enums as Gst.Enums
import qualified GI.Gst.Objects.Object as Gst.Object
import qualified GI.Gst.Structs.Caps as Gst.Caps
import qualified GI.GstAudio.Callbacks as GstAudio.Callbacks
import {-# SOURCE #-} qualified GI.GstAudio.Enums as GstAudio.Enums
import {-# SOURCE #-} qualified GI.GstAudio.Structs.AudioRingBufferSpec as GstAudio.AudioRingBufferSpec

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

instance GObject AudioRingBuffer where
    gobjectType :: IO GType
gobjectType = IO GType
c_gst_audio_ring_buffer_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `AudioRingBuffer`.
noAudioRingBuffer :: Maybe AudioRingBuffer
noAudioRingBuffer :: Maybe AudioRingBuffer
noAudioRingBuffer = Maybe AudioRingBuffer
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioRingBufferMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioRingBufferMethod "acquire" o = AudioRingBufferAcquireMethodInfo
    ResolveAudioRingBufferMethod "activate" o = AudioRingBufferActivateMethodInfo
    ResolveAudioRingBufferMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveAudioRingBufferMethod "advance" o = AudioRingBufferAdvanceMethodInfo
    ResolveAudioRingBufferMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAudioRingBufferMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAudioRingBufferMethod "clear" o = AudioRingBufferClearMethodInfo
    ResolveAudioRingBufferMethod "clearAll" o = AudioRingBufferClearAllMethodInfo
    ResolveAudioRingBufferMethod "closeDevice" o = AudioRingBufferCloseDeviceMethodInfo
    ResolveAudioRingBufferMethod "commit" o = AudioRingBufferCommitMethodInfo
    ResolveAudioRingBufferMethod "convert" o = AudioRingBufferConvertMethodInfo
    ResolveAudioRingBufferMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveAudioRingBufferMethod "delay" o = AudioRingBufferDelayMethodInfo
    ResolveAudioRingBufferMethod "deviceIsOpen" o = AudioRingBufferDeviceIsOpenMethodInfo
    ResolveAudioRingBufferMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAudioRingBufferMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAudioRingBufferMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAudioRingBufferMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveAudioRingBufferMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveAudioRingBufferMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveAudioRingBufferMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveAudioRingBufferMethod "isAcquired" o = AudioRingBufferIsAcquiredMethodInfo
    ResolveAudioRingBufferMethod "isActive" o = AudioRingBufferIsActiveMethodInfo
    ResolveAudioRingBufferMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAudioRingBufferMethod "isFlushing" o = AudioRingBufferIsFlushingMethodInfo
    ResolveAudioRingBufferMethod "mayStart" o = AudioRingBufferMayStartMethodInfo
    ResolveAudioRingBufferMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAudioRingBufferMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAudioRingBufferMethod "openDevice" o = AudioRingBufferOpenDeviceMethodInfo
    ResolveAudioRingBufferMethod "pause" o = AudioRingBufferPauseMethodInfo
    ResolveAudioRingBufferMethod "prepareRead" o = AudioRingBufferPrepareReadMethodInfo
    ResolveAudioRingBufferMethod "read" o = AudioRingBufferReadMethodInfo
    ResolveAudioRingBufferMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveAudioRingBufferMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAudioRingBufferMethod "release" o = AudioRingBufferReleaseMethodInfo
    ResolveAudioRingBufferMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveAudioRingBufferMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAudioRingBufferMethod "samplesDone" o = AudioRingBufferSamplesDoneMethodInfo
    ResolveAudioRingBufferMethod "start" o = AudioRingBufferStartMethodInfo
    ResolveAudioRingBufferMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAudioRingBufferMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAudioRingBufferMethod "stop" o = AudioRingBufferStopMethodInfo
    ResolveAudioRingBufferMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveAudioRingBufferMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveAudioRingBufferMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAudioRingBufferMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveAudioRingBufferMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveAudioRingBufferMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAudioRingBufferMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveAudioRingBufferMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveAudioRingBufferMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAudioRingBufferMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveAudioRingBufferMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveAudioRingBufferMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveAudioRingBufferMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveAudioRingBufferMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAudioRingBufferMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAudioRingBufferMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveAudioRingBufferMethod "setCallback" o = AudioRingBufferSetCallbackMethodInfo
    ResolveAudioRingBufferMethod "setChannelPositions" o = AudioRingBufferSetChannelPositionsMethodInfo
    ResolveAudioRingBufferMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveAudioRingBufferMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveAudioRingBufferMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveAudioRingBufferMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAudioRingBufferMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAudioRingBufferMethod "setFlushing" o = AudioRingBufferSetFlushingMethodInfo
    ResolveAudioRingBufferMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveAudioRingBufferMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveAudioRingBufferMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAudioRingBufferMethod "setSample" o = AudioRingBufferSetSampleMethodInfo
    ResolveAudioRingBufferMethod "setTimestamp" o = AudioRingBufferSetTimestampMethodInfo
    ResolveAudioRingBufferMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioRingBuffer
type instance O.AttributeList AudioRingBuffer = AudioRingBufferAttributeList
type AudioRingBufferAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AudioRingBuffer = AudioRingBufferSignalList
type AudioRingBufferSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method AudioRingBuffer::acquire
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to acquire"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spec"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBufferSpec" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the specs of the buffer"
--                 , 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_ring_buffer_acquire" gst_audio_ring_buffer_acquire :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Ptr GstAudio.AudioRingBufferSpec.AudioRingBufferSpec -> -- spec : TInterface (Name {namespace = "GstAudio", name = "AudioRingBufferSpec"})
    IO CInt

-- | Allocate the resources for the ringbuffer. This function fills
-- in the data pointer of the ring buffer with a valid t'GI.Gst.Structs.Buffer.Buffer'
-- to which samples can be written.
audioRingBufferAcquire ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to acquire
    -> GstAudio.AudioRingBufferSpec.AudioRingBufferSpec
    -- ^ /@spec@/: the specs of the buffer
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be acquired, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferAcquire :: a -> AudioRingBufferSpec -> m Bool
audioRingBufferAcquire buf :: a
buf spec :: AudioRingBufferSpec
spec = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr AudioRingBufferSpec
spec' <- AudioRingBufferSpec -> IO (Ptr AudioRingBufferSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioRingBufferSpec
spec
    CInt
result <- Ptr AudioRingBuffer -> Ptr AudioRingBufferSpec -> IO CInt
gst_audio_ring_buffer_acquire Ptr AudioRingBuffer
buf' Ptr AudioRingBufferSpec
spec'
    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
buf
    AudioRingBufferSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioRingBufferSpec
spec
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferAcquireMethodInfo
instance (signature ~ (GstAudio.AudioRingBufferSpec.AudioRingBufferSpec -> m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferAcquireMethodInfo a signature where
    overloadedMethod = audioRingBufferAcquire

#endif

-- method AudioRingBuffer::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to activate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new mode" , 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_ring_buffer_activate" gst_audio_ring_buffer_activate :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    CInt ->                                 -- active : TBasicType TBoolean
    IO CInt

-- | Activate /@buf@/ to start or stop pulling data.
-- 
-- MT safe.
audioRingBufferActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to activate
    -> Bool
    -- ^ /@active@/: the new mode
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be activated in the requested mode,
    -- FALSE on error.
audioRingBufferActivate :: a -> Bool -> m Bool
audioRingBufferActivate buf :: a
buf active :: Bool
active = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    let active' :: CInt
active' = (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
active
    CInt
result <- Ptr AudioRingBuffer -> CInt -> IO CInt
gst_audio_ring_buffer_activate Ptr AudioRingBuffer
buf' CInt
active'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferActivateMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferActivateMethodInfo a signature where
    overloadedMethod = audioRingBufferActivate

#endif

-- method AudioRingBuffer::advance
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to advance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "advance"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of segments written"
--                 , 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_ring_buffer_advance" gst_audio_ring_buffer_advance :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Word32 ->                               -- advance : TBasicType TUInt
    IO ()

-- | Subclasses should call this function to notify the fact that
-- /@advance@/ segments are now processed by the device.
-- 
-- MT safe.
audioRingBufferAdvance ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to advance
    -> Word32
    -- ^ /@advance@/: the number of segments written
    -> m ()
audioRingBufferAdvance :: a -> Word32 -> m ()
audioRingBufferAdvance buf :: a
buf advance :: Word32
advance = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr AudioRingBuffer -> Word32 -> IO ()
gst_audio_ring_buffer_advance Ptr AudioRingBuffer
buf' Word32
advance
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferAdvanceMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferAdvanceMethodInfo a signature where
    overloadedMethod = audioRingBufferAdvance

#endif

-- method AudioRingBuffer::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to clear"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment to clear"
--                 , 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_ring_buffer_clear" gst_audio_ring_buffer_clear :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Int32 ->                                -- segment : TBasicType TInt
    IO ()

-- | Clear the given segment of the buffer with silence samples.
-- This function is used by subclasses.
-- 
-- MT safe.
audioRingBufferClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to clear
    -> Int32
    -- ^ /@segment@/: the segment to clear
    -> m ()
audioRingBufferClear :: a -> Int32 -> m ()
audioRingBufferClear buf :: a
buf segment :: Int32
segment = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr AudioRingBuffer -> Int32 -> IO ()
gst_audio_ring_buffer_clear Ptr AudioRingBuffer
buf' Int32
segment
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferClearMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferClearMethodInfo a signature where
    overloadedMethod = audioRingBufferClear

#endif

-- method AudioRingBuffer::clear_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to clear"
--                 , 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_ring_buffer_clear_all" gst_audio_ring_buffer_clear_all :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO ()

-- | Fill the ringbuffer with silence.
-- 
-- MT safe.
audioRingBufferClearAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to clear
    -> m ()
audioRingBufferClearAll :: a -> m ()
audioRingBufferClearAll buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr AudioRingBuffer -> IO ()
gst_audio_ring_buffer_clear_all Ptr AudioRingBuffer
buf'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferClearAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferClearAllMethodInfo a signature where
    overloadedMethod = audioRingBufferClearAll

#endif

-- method AudioRingBuffer::close_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , 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_ring_buffer_close_device" gst_audio_ring_buffer_close_device :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Close the audio device associated with the ring buffer. The ring buffer
-- should already have been released via 'GI.GstAudio.Objects.AudioRingBuffer.audioRingBufferRelease'.
audioRingBufferCloseDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be closed, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferCloseDevice :: a -> m Bool
audioRingBufferCloseDevice buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_close_device Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferCloseDeviceMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferCloseDeviceMethodInfo a signature where
    overloadedMethod = audioRingBufferCloseDevice

#endif

-- method AudioRingBuffer::commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sample"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sample position of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to commit" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_samples"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of samples in the data to commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_samples"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the number of samples to write to the ringbuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accum"
--           , argType = TBasicType TInt
--           , direction = DirectionInout
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "accumulator for rate conversion."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "in_samples"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of samples in the data to commit"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_commit" gst_audio_ring_buffer_commit :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Word64 ->                               -- sample : TBasicType TUInt64
    Ptr Word8 ->                            -- data : TCArray False (-1) 3 (TBasicType TUInt8)
    Int32 ->                                -- in_samples : TBasicType TInt
    Int32 ->                                -- out_samples : TBasicType TInt
    Ptr Int32 ->                            -- accum : TBasicType TInt
    IO Word32

-- | Commit /@inSamples@/ samples pointed to by /@data@/ to the ringbuffer /@buf@/.
-- 
-- /@inSamples@/ and /@outSamples@/ define the rate conversion to perform on the
-- samples in /@data@/. For negative rates, /@outSamples@/ must be negative and
-- /@inSamples@/ positive.
-- 
-- When /@outSamples@/ is positive, the first sample will be written at position /@sample@/
-- in the ringbuffer. When /@outSamples@/ is negative, the last sample will be written to
-- /@sample@/ in reverse order.
-- 
-- /@outSamples@/ does not need to be a multiple of the segment size of the ringbuffer
-- although it is recommended for optimal performance.
-- 
-- /@accum@/ will hold a temporary accumulator used in rate conversion and should be
-- set to 0 when this function is first called. In case the commit operation is
-- interrupted, one can resume the processing by passing the previously returned
-- /@accum@/ value back to this function.
-- 
-- MT safe.
audioRingBufferCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to commit
    -> Word64
    -- ^ /@sample@/: the sample position of the data
    -> ByteString
    -- ^ /@data@/: the data to commit
    -> Int32
    -- ^ /@outSamples@/: the number of samples to write to the ringbuffer
    -> Int32
    -- ^ /@accum@/: accumulator for rate conversion.
    -> m ((Word32, Int32))
    -- ^ __Returns:__ The number of samples written to the ringbuffer or -1 on error. The
    -- number of samples written can be less than /@outSamples@/ when /@buf@/ was interrupted
    -- with a flush or stop.
audioRingBufferCommit :: a -> Word64 -> ByteString -> Int32 -> Int32 -> m (Word32, Int32)
audioRingBufferCommit buf :: a
buf sample :: Word64
sample data_ :: ByteString
data_ outSamples :: Int32
outSamples accum :: Int32
accum = IO (Word32, Int32) -> m (Word32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Int32) -> m (Word32, Int32))
-> IO (Word32, Int32) -> m (Word32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    let inSamples :: Int32
inSamples = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Int32
accum' <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int32
accum' Int32
accum
    Word32
result <- Ptr AudioRingBuffer
-> Word64 -> Ptr Word8 -> Int32 -> Int32 -> Ptr Int32 -> IO Word32
gst_audio_ring_buffer_commit Ptr AudioRingBuffer
buf' Word64
sample Ptr Word8
data_' Int32
inSamples Int32
outSamples Ptr Int32
accum'
    Int32
accum'' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
accum'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
accum'
    (Word32, Int32) -> IO (Word32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
result, Int32
accum'')

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferCommitMethodInfo
instance (signature ~ (Word64 -> ByteString -> Int32 -> Int32 -> m ((Word32, Int32))), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferCommitMethodInfo a signature where
    overloadedMethod = audioRingBufferCommit

#endif

-- method AudioRingBuffer::convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_fmt"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source format" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_fmt"
--           , argType = TInterface Name { namespace = "Gst" , name = "Format" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the destination format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_val"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the converted value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_convert" gst_audio_ring_buffer_convert :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    CUInt ->                                -- src_fmt : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_val : TBasicType TInt64
    CUInt ->                                -- dest_fmt : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- dest_val : TBasicType TInt64
    IO CInt

-- | Convert /@srcVal@/ in /@srcFmt@/ to the equivalent value in /@destFmt@/. The result
-- will be put in /@destVal@/.
audioRingBufferConvert ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> Gst.Enums.Format
    -- ^ /@srcFmt@/: the source format
    -> Int64
    -- ^ /@srcVal@/: the source value
    -> Gst.Enums.Format
    -- ^ /@destFmt@/: the destination format
    -> m ((Bool, Int64))
    -- ^ __Returns:__ TRUE if the conversion succeeded.
audioRingBufferConvert :: a -> Format -> Int64 -> Format -> m (Bool, Int64)
audioRingBufferConvert buf :: a
buf srcFmt :: Format
srcFmt srcVal :: Int64
srcVal destFmt :: Format
destFmt = IO (Bool, Int64) -> m (Bool, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int64) -> m (Bool, Int64))
-> IO (Bool, Int64) -> m (Bool, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    let srcFmt' :: CUInt
srcFmt' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
srcFmt
    let destFmt' :: CUInt
destFmt' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
destFmt
    Ptr Int64
destVal <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CInt
result <- Ptr AudioRingBuffer
-> CUInt -> Int64 -> CUInt -> Ptr Int64 -> IO CInt
gst_audio_ring_buffer_convert Ptr AudioRingBuffer
buf' CUInt
srcFmt' Int64
srcVal CUInt
destFmt' Ptr Int64
destVal
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Int64
destVal' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
destVal
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
destVal
    (Bool, Int64) -> IO (Bool, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int64
destVal')

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> m ((Bool, Int64))), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferConvertMethodInfo a signature where
    overloadedMethod = audioRingBufferConvert

#endif

-- method AudioRingBuffer::delay
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to query"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_delay" gst_audio_ring_buffer_delay :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO Word32

-- | Get the number of samples queued in the audio device. This is
-- usually less than the segment size but can be bigger when the
-- implementation uses another internal buffer between the audio
-- device.
-- 
-- For playback ringbuffers this is the amount of samples transfered from the
-- ringbuffer to the device but still not played.
-- 
-- For capture ringbuffers this is the amount of samples in the device that are
-- not yet transfered to the ringbuffer.
audioRingBufferDelay ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to query
    -> m Word32
    -- ^ __Returns:__ The number of samples queued in the audio device.
    -- 
    -- MT safe.
audioRingBufferDelay :: a -> m Word32
audioRingBufferDelay buf :: a
buf = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Word32
result <- Ptr AudioRingBuffer -> IO Word32
gst_audio_ring_buffer_delay Ptr AudioRingBuffer
buf'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferDelayMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferDelayMethodInfo a signature where
    overloadedMethod = audioRingBufferDelay

#endif

-- method AudioRingBuffer::device_is_open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , 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_ring_buffer_device_is_open" gst_audio_ring_buffer_device_is_open :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Checks the status of the device associated with the ring buffer.
audioRingBufferDeviceIsOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> m Bool
    -- ^ __Returns:__ TRUE if the device was open, FALSE if it was closed.
    -- 
    -- MT safe.
audioRingBufferDeviceIsOpen :: a -> m Bool
audioRingBufferDeviceIsOpen buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_device_is_open Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferDeviceIsOpenMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferDeviceIsOpenMethodInfo a signature where
    overloadedMethod = audioRingBufferDeviceIsOpen

#endif

-- method AudioRingBuffer::is_acquired
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to check"
--                 , 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_ring_buffer_is_acquired" gst_audio_ring_buffer_is_acquired :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Check if the ringbuffer is acquired and ready to use.
audioRingBufferIsAcquired ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to check
    -> m Bool
    -- ^ __Returns:__ TRUE if the ringbuffer is acquired, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferIsAcquired :: a -> m Bool
audioRingBufferIsAcquired buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_is_acquired Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferIsAcquiredMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferIsAcquiredMethodInfo a signature where
    overloadedMethod = audioRingBufferIsAcquired

#endif

-- method AudioRingBuffer::is_active
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , 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_ring_buffer_is_active" gst_audio_ring_buffer_is_active :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Check if /@buf@/ is activated.
-- 
-- MT safe.
audioRingBufferIsActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> m Bool
    -- ^ __Returns:__ TRUE if the device is active.
audioRingBufferIsActive :: a -> m Bool
audioRingBufferIsActive buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_is_active Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferIsActiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferIsActiveMethodInfo a signature where
    overloadedMethod = audioRingBufferIsActive

#endif

-- method AudioRingBuffer::is_flushing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , 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_ring_buffer_is_flushing" gst_audio_ring_buffer_is_flushing :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Check if /@buf@/ is flushing.
-- 
-- MT safe.
audioRingBufferIsFlushing ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> m Bool
    -- ^ __Returns:__ TRUE if the device is flushing.
audioRingBufferIsFlushing :: a -> m Bool
audioRingBufferIsFlushing buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_is_flushing Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferIsFlushingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferIsFlushingMethodInfo a signature where
    overloadedMethod = audioRingBufferIsFlushing

#endif

-- method AudioRingBuffer::may_start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allowed"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_may_start" gst_audio_ring_buffer_may_start :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    CInt ->                                 -- allowed : TBasicType TBoolean
    IO ()

-- | Tell the ringbuffer that it is allowed to start playback when
-- the ringbuffer is filled with samples.
-- 
-- MT safe.
audioRingBufferMayStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> Bool
    -- ^ /@allowed@/: the new value
    -> m ()
audioRingBufferMayStart :: a -> Bool -> m ()
audioRingBufferMayStart buf :: a
buf allowed :: Bool
allowed = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    let allowed' :: CInt
allowed' = (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
allowed
    Ptr AudioRingBuffer -> CInt -> IO ()
gst_audio_ring_buffer_may_start Ptr AudioRingBuffer
buf' CInt
allowed'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferMayStartMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferMayStartMethodInfo a signature where
    overloadedMethod = audioRingBufferMayStart

#endif

-- method AudioRingBuffer::open_device
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , 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_ring_buffer_open_device" gst_audio_ring_buffer_open_device :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Open the audio device associated with the ring buffer. Does not perform any
-- setup on the device. You must open the device before acquiring the ring
-- buffer.
audioRingBufferOpenDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be opened, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferOpenDevice :: a -> m Bool
audioRingBufferOpenDevice buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_open_device Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferOpenDeviceMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferOpenDeviceMethodInfo a signature where
    overloadedMethod = audioRingBufferOpenDevice

#endif

-- method AudioRingBuffer::pause
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to pause"
--                 , 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_ring_buffer_pause" gst_audio_ring_buffer_pause :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Pause processing samples from the ringbuffer.
audioRingBufferPause ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to pause
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be paused, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferPause :: a -> m Bool
audioRingBufferPause buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_pause Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferPauseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferPauseMethodInfo a signature where
    overloadedMethod = audioRingBufferPause

#endif

-- method AudioRingBuffer::prepare_read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to read from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the segment to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "readptr"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "\n    the pointer to the memory where samples can be read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "len"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of bytes to read"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_prepare_read" gst_audio_ring_buffer_prepare_read :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Ptr Int32 ->                            -- segment : TBasicType TInt
    Ptr (Ptr Word8) ->                      -- readptr : TCArray False (-1) 3 (TBasicType TUInt8)
    Ptr Int32 ->                            -- len : TBasicType TInt
    IO CInt

-- | Returns a pointer to memory where the data from segment /@segment@/
-- can be found. This function is mostly used by subclasses.
audioRingBufferPrepareRead ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to read from
    -> m ((Bool, Int32, ByteString))
    -- ^ __Returns:__ FALSE if the buffer is not started.
    -- 
    -- MT safe.
audioRingBufferPrepareRead :: a -> m (Bool, Int32, ByteString)
audioRingBufferPrepareRead buf :: a
buf = IO (Bool, Int32, ByteString) -> m (Bool, Int32, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, ByteString) -> m (Bool, Int32, ByteString))
-> IO (Bool, Int32, ByteString) -> m (Bool, Int32, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr Int32
segment <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr (Ptr Word8)
readptr <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Word8))
    Ptr Int32
len <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr AudioRingBuffer
-> Ptr Int32 -> Ptr (Ptr Word8) -> Ptr Int32 -> IO CInt
gst_audio_ring_buffer_prepare_read Ptr AudioRingBuffer
buf' Ptr Int32
segment Ptr (Ptr Word8)
readptr Ptr Int32
len
    Int32
len' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
len
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Int32
segment' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
segment
    Ptr Word8
readptr' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
readptr
    ByteString
readptr'' <- (Int32 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Int32
len') Ptr Word8
readptr'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
readptr'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
segment
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
readptr
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
len
    (Bool, Int32, ByteString) -> IO (Bool, Int32, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
segment', ByteString
readptr'')

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferPrepareReadMethodInfo
instance (signature ~ (m ((Bool, Int32, ByteString))), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferPrepareReadMethodInfo a signature where
    overloadedMethod = audioRingBufferPrepareRead

#endif

-- method AudioRingBuffer::read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to read from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sample"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sample position of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "where the data should be read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of samples in data to read"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "where the timestamp is returned"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "len"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of samples in data to read"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_read" gst_audio_ring_buffer_read :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Word64 ->                               -- sample : TBasicType TUInt64
    Ptr Word8 ->                            -- data : TCArray False (-1) 3 (TBasicType TUInt8)
    Word32 ->                               -- len : TBasicType TUInt
    Ptr Word64 ->                           -- timestamp : TBasicType TUInt64
    IO Word32

-- | Read /@len@/ samples from the ringbuffer into the memory pointed
-- to by /@data@/.
-- The first sample should be read from position /@sample@/ in
-- the ringbuffer.
-- 
-- /@len@/ should not be a multiple of the segment size of the ringbuffer
-- although it is recommended.
-- 
-- /@timestamp@/ will return the timestamp associated with the data returned.
audioRingBufferRead ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to read from
    -> Word64
    -- ^ /@sample@/: the sample position of the data
    -> ByteString
    -- ^ /@data@/: where the data should be read
    -> m ((Word32, Word64))
    -- ^ __Returns:__ The number of samples read from the ringbuffer or -1 on
    -- error.
    -- 
    -- MT safe.
audioRingBufferRead :: a -> Word64 -> ByteString -> m (Word32, Word64)
audioRingBufferRead buf :: a
buf sample :: Word64
sample data_ :: ByteString
data_ = IO (Word32, Word64) -> m (Word32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word64) -> m (Word32, Word64))
-> IO (Word32, Word64) -> m (Word32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    let len :: Word32
len = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr Word64
timestamp <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Word32
result <- Ptr AudioRingBuffer
-> Word64 -> Ptr Word8 -> Word32 -> Ptr Word64 -> IO Word32
gst_audio_ring_buffer_read Ptr AudioRingBuffer
buf' Word64
sample Ptr Word8
data_' Word32
len Ptr Word64
timestamp
    Word64
timestamp' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
timestamp
    (Word32, Word64) -> IO (Word32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
result, Word64
timestamp')

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferReadMethodInfo
instance (signature ~ (Word64 -> ByteString -> m ((Word32, Word64))), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferReadMethodInfo a signature where
    overloadedMethod = audioRingBufferRead

#endif

-- method AudioRingBuffer::release
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to release"
--                 , 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_ring_buffer_release" gst_audio_ring_buffer_release :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Free the resources of the ringbuffer.
audioRingBufferRelease ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to release
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be released, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferRelease :: a -> m Bool
audioRingBufferRelease buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_release Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferReleaseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferReleaseMethodInfo a signature where
    overloadedMethod = audioRingBufferRelease

#endif

-- method AudioRingBuffer::samples_done
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to query"
--                 , 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_ring_buffer_samples_done" gst_audio_ring_buffer_samples_done :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO Word64

-- | Get the number of samples that were processed by the ringbuffer
-- since it was last started. This does not include the number of samples not
-- yet processed (see 'GI.GstAudio.Objects.AudioRingBuffer.audioRingBufferDelay').
audioRingBufferSamplesDone ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to query
    -> m Word64
    -- ^ __Returns:__ The number of samples processed by the ringbuffer.
    -- 
    -- MT safe.
audioRingBufferSamplesDone :: a -> m Word64
audioRingBufferSamplesDone buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Word64
result <- Ptr AudioRingBuffer -> IO Word64
gst_audio_ring_buffer_samples_done Ptr AudioRingBuffer
buf'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferSamplesDoneMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferSamplesDoneMethodInfo a signature where
    overloadedMethod = audioRingBufferSamplesDone

#endif

-- method AudioRingBuffer::set_callback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GstAudioRingBuffer to set the callback on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cb"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBufferCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback to set"
--                 , 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 "function to be called when @user_data is no longer needed"
--                 , 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_ring_buffer_set_callback_full" gst_audio_ring_buffer_set_callback_full :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    FunPtr GstAudio.Callbacks.C_AudioRingBufferCallback -> -- cb : TInterface (Name {namespace = "GstAudio", name = "AudioRingBufferCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the given callback function on the buffer. This function
-- will be called every time a segment has been written to a device.
-- 
-- MT safe.
-- 
-- /Since: 1.12/
audioRingBufferSetCallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to set the callback on
    -> Maybe (GstAudio.Callbacks.AudioRingBufferCallback)
    -- ^ /@cb@/: the callback to set
    -> m ()
audioRingBufferSetCallback :: a -> Maybe AudioRingBufferCallback -> m ()
audioRingBufferSetCallback buf :: a
buf cb :: Maybe AudioRingBufferCallback
cb = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    FunPtr C_AudioRingBufferCallback
maybeCb <- case Maybe AudioRingBufferCallback
cb of
        Nothing -> FunPtr C_AudioRingBufferCallback
-> IO (FunPtr C_AudioRingBufferCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AudioRingBufferCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCb :: AudioRingBufferCallback
jCb -> do
            FunPtr C_AudioRingBufferCallback
jCb' <- C_AudioRingBufferCallback -> IO (FunPtr C_AudioRingBufferCallback)
GstAudio.Callbacks.mk_AudioRingBufferCallback (Maybe (Ptr (FunPtr C_AudioRingBufferCallback))
-> AudioRingBufferCallback_WithClosures
-> C_AudioRingBufferCallback
GstAudio.Callbacks.wrap_AudioRingBufferCallback Maybe (Ptr (FunPtr C_AudioRingBufferCallback))
forall a. Maybe a
Nothing (AudioRingBufferCallback -> AudioRingBufferCallback_WithClosures
GstAudio.Callbacks.drop_closures_AudioRingBufferCallback AudioRingBufferCallback
jCb))
            FunPtr C_AudioRingBufferCallback
-> IO (FunPtr C_AudioRingBufferCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AudioRingBufferCallback
jCb'
    let userData :: Ptr ()
userData = FunPtr C_AudioRingBufferCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AudioRingBufferCallback
maybeCb
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr AudioRingBuffer
-> FunPtr C_AudioRingBufferCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gst_audio_ring_buffer_set_callback_full Ptr AudioRingBuffer
buf' FunPtr C_AudioRingBufferCallback
maybeCb Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferSetCallbackMethodInfo
instance (signature ~ (Maybe (GstAudio.Callbacks.AudioRingBufferCallback) -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferSetCallbackMethodInfo a signature where
    overloadedMethod = audioRingBufferSetCallback

#endif

-- method AudioRingBuffer::set_channel_positions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 (-1)
--                 (TInterface
--                    Name { namespace = "GstAudio" , name = "AudioChannelPosition" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the device channel positions"
--                 , 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_ring_buffer_set_channel_positions" gst_audio_ring_buffer_set_channel_positions :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Ptr CInt ->                             -- position : TCArray False (-1) (-1) (TInterface (Name {namespace = "GstAudio", name = "AudioChannelPosition"}))
    IO ()

-- | Tell the ringbuffer about the device\'s channel positions. This must
-- be called in when the ringbuffer is acquired.
audioRingBufferSetChannelPositions ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer'
    -> [GstAudio.Enums.AudioChannelPosition]
    -- ^ /@position@/: the device channel positions
    -> m ()
audioRingBufferSetChannelPositions :: a -> [AudioChannelPosition] -> m ()
audioRingBufferSetChannelPositions buf :: a
buf position :: [AudioChannelPosition]
position = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    let position' :: [CInt]
position' = (AudioChannelPosition -> CInt) -> [AudioChannelPosition] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt)
-> (AudioChannelPosition -> Int) -> AudioChannelPosition -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioChannelPosition -> Int
forall a. Enum a => a -> Int
fromEnum) [AudioChannelPosition]
position
    Ptr CInt
position'' <- [CInt] -> IO (Ptr CInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CInt]
position'
    Ptr AudioRingBuffer -> Ptr CInt -> IO ()
gst_audio_ring_buffer_set_channel_positions Ptr AudioRingBuffer
buf' Ptr CInt
position''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
position''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferSetChannelPositionsMethodInfo
instance (signature ~ ([GstAudio.Enums.AudioChannelPosition] -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferSetChannelPositionsMethodInfo a signature where
    overloadedMethod = audioRingBufferSetChannelPositions

#endif

-- method AudioRingBuffer::set_flushing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to flush"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flushing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new mode" , 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_ring_buffer_set_flushing" gst_audio_ring_buffer_set_flushing :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    CInt ->                                 -- flushing : TBasicType TBoolean
    IO ()

-- | Set the ringbuffer to flushing mode or normal mode.
-- 
-- MT safe.
audioRingBufferSetFlushing ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to flush
    -> Bool
    -- ^ /@flushing@/: the new mode
    -> m ()
audioRingBufferSetFlushing :: a -> Bool -> m ()
audioRingBufferSetFlushing buf :: a
buf flushing :: Bool
flushing = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    let flushing' :: CInt
flushing' = (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
flushing
    Ptr AudioRingBuffer -> CInt -> IO ()
gst_audio_ring_buffer_set_flushing Ptr AudioRingBuffer
buf' CInt
flushing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferSetFlushingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferSetFlushingMethodInfo a signature where
    overloadedMethod = audioRingBufferSetFlushing

#endif

-- method AudioRingBuffer::set_sample
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sample"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the sample number to set"
--                 , 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_ring_buffer_set_sample" gst_audio_ring_buffer_set_sample :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Word64 ->                               -- sample : TBasicType TUInt64
    IO ()

-- | Make sure that the next sample written to the device is
-- accounted for as being the /@sample@/ sample written to the
-- device. This value will be used in reporting the current
-- sample position of the ringbuffer.
-- 
-- This function will also clear the buffer with silence.
-- 
-- MT safe.
audioRingBufferSetSample ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to use
    -> Word64
    -- ^ /@sample@/: the sample number to set
    -> m ()
audioRingBufferSetSample :: a -> Word64 -> m ()
audioRingBufferSetSample buf :: a
buf sample :: Word64
sample = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr AudioRingBuffer -> Word64 -> IO ()
gst_audio_ring_buffer_set_sample Ptr AudioRingBuffer
buf' Word64
sample
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferSetSampleMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferSetSampleMethodInfo a signature where
    overloadedMethod = audioRingBufferSetSample

#endif

-- method AudioRingBuffer::set_timestamp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "readseg"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_ring_buffer_set_timestamp" gst_audio_ring_buffer_set_timestamp :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    Int32 ->                                -- readseg : TBasicType TInt
    Word64 ->                               -- timestamp : TBasicType TUInt64
    IO ()

-- | /No description available in the introspection data./
audioRingBufferSetTimestamp ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -> Int32
    -> Word64
    -> m ()
audioRingBufferSetTimestamp :: a -> Int32 -> Word64 -> m ()
audioRingBufferSetTimestamp buf :: a
buf readseg :: Int32
readseg timestamp :: Word64
timestamp = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    Ptr AudioRingBuffer -> Int32 -> Word64 -> IO ()
gst_audio_ring_buffer_set_timestamp Ptr AudioRingBuffer
buf' Int32
readseg Word64
timestamp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferSetTimestampMethodInfo
instance (signature ~ (Int32 -> Word64 -> m ()), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferSetTimestampMethodInfo a signature where
    overloadedMethod = audioRingBufferSetTimestamp

#endif

-- method AudioRingBuffer::start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to start"
--                 , 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_ring_buffer_start" gst_audio_ring_buffer_start :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Start processing samples from the ringbuffer.
audioRingBufferStart ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to start
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be started, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferStart :: a -> m Bool
audioRingBufferStart buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_start Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferStartMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferStartMethodInfo a signature where
    overloadedMethod = audioRingBufferStart

#endif

-- method AudioRingBuffer::stop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buf"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioRingBuffer to stop"
--                 , 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_ring_buffer_stop" gst_audio_ring_buffer_stop :: 
    Ptr AudioRingBuffer ->                  -- buf : TInterface (Name {namespace = "GstAudio", name = "AudioRingBuffer"})
    IO CInt

-- | Stop processing samples from the ringbuffer.
audioRingBufferStop ::
    (B.CallStack.HasCallStack, MonadIO m, IsAudioRingBuffer a) =>
    a
    -- ^ /@buf@/: the t'GI.GstAudio.Objects.AudioRingBuffer.AudioRingBuffer' to stop
    -> m Bool
    -- ^ __Returns:__ TRUE if the device could be stopped, FALSE on error.
    -- 
    -- MT safe.
audioRingBufferStop :: a -> m Bool
audioRingBufferStop buf :: a
buf = 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 AudioRingBuffer
buf' <- a -> IO (Ptr AudioRingBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buf
    CInt
result <- Ptr AudioRingBuffer -> IO CInt
gst_audio_ring_buffer_stop Ptr AudioRingBuffer
buf'
    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
buf
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioRingBufferStopMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAudioRingBuffer a) => O.MethodInfo AudioRingBufferStopMethodInfo a signature where
    overloadedMethod = audioRingBufferStop

#endif

-- method AudioRingBuffer::debug_spec_buff
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "spec"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBufferSpec" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the spec to debug" , 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_ring_buffer_debug_spec_buff" gst_audio_ring_buffer_debug_spec_buff :: 
    Ptr GstAudio.AudioRingBufferSpec.AudioRingBufferSpec -> -- spec : TInterface (Name {namespace = "GstAudio", name = "AudioRingBufferSpec"})
    IO ()

-- | Print debug info about the buffer sized in /@spec@/ to the debug log.
audioRingBufferDebugSpecBuff ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstAudio.AudioRingBufferSpec.AudioRingBufferSpec
    -- ^ /@spec@/: the spec to debug
    -> m ()
audioRingBufferDebugSpecBuff :: AudioRingBufferSpec -> m ()
audioRingBufferDebugSpecBuff spec :: AudioRingBufferSpec
spec = 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 AudioRingBufferSpec
spec' <- AudioRingBufferSpec -> IO (Ptr AudioRingBufferSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioRingBufferSpec
spec
    Ptr AudioRingBufferSpec -> IO ()
gst_audio_ring_buffer_debug_spec_buff Ptr AudioRingBufferSpec
spec'
    AudioRingBufferSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioRingBufferSpec
spec
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method AudioRingBuffer::debug_spec_caps
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "spec"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBufferSpec" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the spec to debug" , 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_ring_buffer_debug_spec_caps" gst_audio_ring_buffer_debug_spec_caps :: 
    Ptr GstAudio.AudioRingBufferSpec.AudioRingBufferSpec -> -- spec : TInterface (Name {namespace = "GstAudio", name = "AudioRingBufferSpec"})
    IO ()

-- | Print debug info about the parsed caps in /@spec@/ to the debug log.
audioRingBufferDebugSpecCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstAudio.AudioRingBufferSpec.AudioRingBufferSpec
    -- ^ /@spec@/: the spec to debug
    -> m ()
audioRingBufferDebugSpecCaps :: AudioRingBufferSpec -> m ()
audioRingBufferDebugSpecCaps spec :: AudioRingBufferSpec
spec = 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 AudioRingBufferSpec
spec' <- AudioRingBufferSpec -> IO (Ptr AudioRingBufferSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioRingBufferSpec
spec
    Ptr AudioRingBufferSpec -> IO ()
gst_audio_ring_buffer_debug_spec_caps Ptr AudioRingBufferSpec
spec'
    AudioRingBufferSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioRingBufferSpec
spec
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method AudioRingBuffer::parse_caps
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "spec"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioRingBufferSpec" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a spec" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | Parse /@caps@/ into /@spec@/.
audioRingBufferParseCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstAudio.AudioRingBufferSpec.AudioRingBufferSpec
    -- ^ /@spec@/: a spec
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ TRUE if the caps could be parsed.
audioRingBufferParseCaps :: AudioRingBufferSpec -> Caps -> m Bool
audioRingBufferParseCaps spec :: AudioRingBufferSpec
spec caps :: Caps
caps = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioRingBufferSpec
spec' <- AudioRingBufferSpec -> IO (Ptr AudioRingBufferSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioRingBufferSpec
spec
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr AudioRingBufferSpec -> Ptr Caps -> IO CInt
gst_audio_ring_buffer_parse_caps Ptr AudioRingBufferSpec
spec' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    AudioRingBufferSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioRingBufferSpec
spec
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif