{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure containing the result of an audio buffer map operation,
-- which is executed with 'GI.GstAudio.Structs.AudioBuffer.audioBufferMap'. For non-interleaved (planar)
-- buffers, the beginning of each channel in the buffer has its own pointer in
-- the /@planes@/ array. For interleaved buffers, the /@planes@/ array only contains
-- one item, which is the pointer to the beginning of the buffer, and /@nPlanes@/
-- equals 1.
-- 
-- The different channels in /@planes@/ are always in the GStreamer channel order.
-- 
-- /Since: 1.16/

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

module GI.GstAudio.Structs.AudioBuffer
    ( 

-- * Exported types
    AudioBuffer(..)                         ,
    newZeroAudioBuffer                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [map]("GI.GstAudio.Structs.AudioBuffer#g:method:map"), [unmap]("GI.GstAudio.Structs.AudioBuffer#g:method:unmap").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveAudioBufferMethod                ,
#endif

-- ** clip #method:clip#

    audioBufferClip                         ,


-- ** map #method:map#

#if defined(ENABLE_OVERLOADING)
    AudioBufferMapMethodInfo                ,
#endif
    audioBufferMap                          ,


-- ** reorderChannels #method:reorderChannels#

    audioBufferReorderChannels              ,


-- ** truncate #method:truncate#

    audioBufferTruncate                     ,


-- ** unmap #method:unmap#

#if defined(ENABLE_OVERLOADING)
    AudioBufferUnmapMethodInfo              ,
#endif
    audioBufferUnmap                        ,




 -- * Properties


-- ** buffer #attr:buffer#
-- | the mapped buffer

#if defined(ENABLE_OVERLOADING)
    audioBuffer_buffer                      ,
#endif
    clearAudioBufferBuffer                  ,
    getAudioBufferBuffer                    ,
    setAudioBufferBuffer                    ,


-- ** info #attr:info#
-- | a t'GI.GstAudio.Structs.AudioInfo.AudioInfo' describing the audio properties of this buffer

#if defined(ENABLE_OVERLOADING)
    audioBuffer_info                        ,
#endif
    getAudioBufferInfo                      ,


-- ** nPlanes #attr:nPlanes#
-- | the number of planes available

#if defined(ENABLE_OVERLOADING)
    audioBuffer_nPlanes                     ,
#endif
    getAudioBufferNPlanes                   ,
    setAudioBufferNPlanes                   ,


-- ** nSamples #attr:nSamples#
-- | the size of the buffer in samples

#if defined(ENABLE_OVERLOADING)
    audioBuffer_nSamples                    ,
#endif
    getAudioBufferNSamples                  ,
    setAudioBufferNSamples                  ,


-- ** planes #attr:planes#
-- | an array of /@nPlanes@/ pointers pointing to the start of each
--   plane in the mapped buffer

#if defined(ENABLE_OVERLOADING)
    audioBuffer_planes                      ,
#endif
    clearAudioBufferPlanes                  ,
    getAudioBufferPlanes                    ,
    setAudioBufferPlanes                    ,




    ) where

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

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

import qualified GI.Gst.Flags as Gst.Flags
import qualified GI.Gst.Structs.Buffer as Gst.Buffer
import qualified GI.Gst.Structs.Segment as Gst.Segment
import {-# SOURCE #-} qualified GI.GstAudio.Enums as GstAudio.Enums
import {-# SOURCE #-} qualified GI.GstAudio.Structs.AudioInfo as GstAudio.AudioInfo

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

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

instance BoxedPtr AudioBuffer where
    boxedPtrCopy :: AudioBuffer -> IO AudioBuffer
boxedPtrCopy = \AudioBuffer
p -> AudioBuffer
-> (Ptr AudioBuffer -> IO AudioBuffer) -> IO AudioBuffer
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AudioBuffer
p (Int -> Ptr AudioBuffer -> IO (Ptr AudioBuffer)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
1288 (Ptr AudioBuffer -> IO (Ptr AudioBuffer))
-> (Ptr AudioBuffer -> IO AudioBuffer)
-> Ptr AudioBuffer
-> IO AudioBuffer
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr AudioBuffer -> AudioBuffer)
-> Ptr AudioBuffer -> IO AudioBuffer
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr AudioBuffer -> AudioBuffer
AudioBuffer)
    boxedPtrFree :: AudioBuffer -> IO ()
boxedPtrFree = \AudioBuffer
x -> AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr AudioBuffer
x Ptr AudioBuffer -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr AudioBuffer where
    boxedPtrCalloc :: IO (Ptr AudioBuffer)
boxedPtrCalloc = Int -> IO (Ptr AudioBuffer)
forall a. Int -> IO (Ptr a)
callocBytes Int
1288


-- | Construct a `AudioBuffer` struct initialized to zero.
newZeroAudioBuffer :: MonadIO m => m AudioBuffer
newZeroAudioBuffer :: forall (m :: * -> *). MonadIO m => m AudioBuffer
newZeroAudioBuffer = IO AudioBuffer -> m AudioBuffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioBuffer -> m AudioBuffer)
-> IO AudioBuffer -> m AudioBuffer
forall a b. (a -> b) -> a -> b
$ IO (Ptr AudioBuffer)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr AudioBuffer)
-> (Ptr AudioBuffer -> IO AudioBuffer) -> IO AudioBuffer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr AudioBuffer -> AudioBuffer)
-> Ptr AudioBuffer -> IO AudioBuffer
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr AudioBuffer -> AudioBuffer
AudioBuffer

instance tag ~ 'AttrSet => Constructible AudioBuffer tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr AudioBuffer -> AudioBuffer)
-> [AttrOp AudioBuffer tag] -> m AudioBuffer
new ManagedPtr AudioBuffer -> AudioBuffer
_ [AttrOp AudioBuffer tag]
attrs = do
        AudioBuffer
o <- m AudioBuffer
forall (m :: * -> *). MonadIO m => m AudioBuffer
newZeroAudioBuffer
        AudioBuffer -> [AttrOp AudioBuffer 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set AudioBuffer
o [AttrOp AudioBuffer tag]
[AttrOp AudioBuffer 'AttrSet]
attrs
        AudioBuffer -> m AudioBuffer
forall (m :: * -> *) a. Monad m => a -> m a
return AudioBuffer
o


-- | Get the value of the “@info@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBuffer #info
-- @
getAudioBufferInfo :: MonadIO m => AudioBuffer -> m GstAudio.AudioInfo.AudioInfo
getAudioBufferInfo :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m AudioInfo
getAudioBufferInfo AudioBuffer
s = IO AudioInfo -> m AudioInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioInfo -> m AudioInfo) -> IO AudioInfo -> m AudioInfo
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO AudioInfo) -> IO AudioInfo
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO AudioInfo) -> IO AudioInfo)
-> (Ptr AudioBuffer -> IO AudioInfo) -> IO AudioInfo
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    let val :: Ptr AudioInfo
val = Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr AudioInfo
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr GstAudio.AudioInfo.AudioInfo)
    AudioInfo
val' <- ((ManagedPtr AudioInfo -> AudioInfo)
-> Ptr AudioInfo -> IO AudioInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr AudioInfo -> AudioInfo
GstAudio.AudioInfo.AudioInfo) Ptr AudioInfo
val
    AudioInfo -> IO AudioInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AudioInfo
val'

#if defined(ENABLE_OVERLOADING)
data AudioBufferInfoFieldInfo
instance AttrInfo AudioBufferInfoFieldInfo where
    type AttrBaseTypeConstraint AudioBufferInfoFieldInfo = (~) AudioBuffer
    type AttrAllowedOps AudioBufferInfoFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint AudioBufferInfoFieldInfo = (~) (Ptr GstAudio.AudioInfo.AudioInfo)
    type AttrTransferTypeConstraint AudioBufferInfoFieldInfo = (~)(Ptr GstAudio.AudioInfo.AudioInfo)
    type AttrTransferType AudioBufferInfoFieldInfo = (Ptr GstAudio.AudioInfo.AudioInfo)
    type AttrGetType AudioBufferInfoFieldInfo = GstAudio.AudioInfo.AudioInfo
    type AttrLabel AudioBufferInfoFieldInfo = "info"
    type AttrOrigin AudioBufferInfoFieldInfo = AudioBuffer
    attrGet = getAudioBufferInfo
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

audioBuffer_info :: AttrLabelProxy "info"
audioBuffer_info = AttrLabelProxy

#endif


-- | Get the value of the “@n_samples@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBuffer #nSamples
-- @
getAudioBufferNSamples :: MonadIO m => AudioBuffer -> m Word64
getAudioBufferNSamples :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m Word64
getAudioBufferNSamples AudioBuffer
s = 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
$ AudioBuffer -> (Ptr AudioBuffer -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO Word64) -> IO Word64)
-> (Ptr AudioBuffer -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
320) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

-- | Set the value of the “@n_samples@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBuffer [ #nSamples 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBufferNSamples :: MonadIO m => AudioBuffer -> Word64 -> m ()
setAudioBufferNSamples :: forall (m :: * -> *). MonadIO m => AudioBuffer -> Word64 -> m ()
setAudioBufferNSamples AudioBuffer
s Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO ()) -> IO ())
-> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
320) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data AudioBufferNSamplesFieldInfo
instance AttrInfo AudioBufferNSamplesFieldInfo where
    type AttrBaseTypeConstraint AudioBufferNSamplesFieldInfo = (~) AudioBuffer
    type AttrAllowedOps AudioBufferNSamplesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioBufferNSamplesFieldInfo = (~) Word64
    type AttrTransferTypeConstraint AudioBufferNSamplesFieldInfo = (~)Word64
    type AttrTransferType AudioBufferNSamplesFieldInfo = Word64
    type AttrGetType AudioBufferNSamplesFieldInfo = Word64
    type AttrLabel AudioBufferNSamplesFieldInfo = "n_samples"
    type AttrOrigin AudioBufferNSamplesFieldInfo = AudioBuffer
    attrGet = getAudioBufferNSamples
    attrSet = setAudioBufferNSamples
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioBuffer_nSamples :: AttrLabelProxy "nSamples"
audioBuffer_nSamples = AttrLabelProxy

#endif


-- | Get the value of the “@n_planes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBuffer #nPlanes
-- @
getAudioBufferNPlanes :: MonadIO m => AudioBuffer -> m Int32
getAudioBufferNPlanes :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m Int32
getAudioBufferNPlanes AudioBuffer
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO Int32) -> IO Int32)
-> (Ptr AudioBuffer -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
328) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@n_planes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBuffer [ #nPlanes 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBufferNPlanes :: MonadIO m => AudioBuffer -> Int32 -> m ()
setAudioBufferNPlanes :: forall (m :: * -> *). MonadIO m => AudioBuffer -> Int32 -> m ()
setAudioBufferNPlanes AudioBuffer
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO ()) -> IO ())
-> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
328) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data AudioBufferNPlanesFieldInfo
instance AttrInfo AudioBufferNPlanesFieldInfo where
    type AttrBaseTypeConstraint AudioBufferNPlanesFieldInfo = (~) AudioBuffer
    type AttrAllowedOps AudioBufferNPlanesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioBufferNPlanesFieldInfo = (~) Int32
    type AttrTransferTypeConstraint AudioBufferNPlanesFieldInfo = (~)Int32
    type AttrTransferType AudioBufferNPlanesFieldInfo = Int32
    type AttrGetType AudioBufferNPlanesFieldInfo = Int32
    type AttrLabel AudioBufferNPlanesFieldInfo = "n_planes"
    type AttrOrigin AudioBufferNPlanesFieldInfo = AudioBuffer
    attrGet = getAudioBufferNPlanes
    attrSet = setAudioBufferNPlanes
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioBuffer_nPlanes :: AttrLabelProxy "nPlanes"
audioBuffer_nPlanes = AttrLabelProxy

#endif


-- | Get the value of the “@planes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBuffer #planes
-- @
getAudioBufferPlanes :: MonadIO m => AudioBuffer -> m (Ptr ())
getAudioBufferPlanes :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m (Ptr ())
getAudioBufferPlanes AudioBuffer
s = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO (Ptr ())) -> IO (Ptr ())
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr AudioBuffer -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr ()
val <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
336) :: IO (Ptr ())
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
val

-- | Set the value of the “@planes@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBuffer [ #planes 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBufferPlanes :: MonadIO m => AudioBuffer -> Ptr () -> m ()
setAudioBufferPlanes :: forall (m :: * -> *). MonadIO m => AudioBuffer -> Ptr () -> m ()
setAudioBufferPlanes AudioBuffer
s Ptr ()
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO ()) -> IO ())
-> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
336) (Ptr ()
val :: Ptr ())

-- | Set the value of the “@planes@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #planes
-- @
clearAudioBufferPlanes :: MonadIO m => AudioBuffer -> m ()
clearAudioBufferPlanes :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m ()
clearAudioBufferPlanes AudioBuffer
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO ()) -> IO ())
-> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
336) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING)
data AudioBufferPlanesFieldInfo
instance AttrInfo AudioBufferPlanesFieldInfo where
    type AttrBaseTypeConstraint AudioBufferPlanesFieldInfo = (~) AudioBuffer
    type AttrAllowedOps AudioBufferPlanesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AudioBufferPlanesFieldInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint AudioBufferPlanesFieldInfo = (~)(Ptr ())
    type AttrTransferType AudioBufferPlanesFieldInfo = (Ptr ())
    type AttrGetType AudioBufferPlanesFieldInfo = Ptr ()
    type AttrLabel AudioBufferPlanesFieldInfo = "planes"
    type AttrOrigin AudioBufferPlanesFieldInfo = AudioBuffer
    attrGet = getAudioBufferPlanes
    attrSet = setAudioBufferPlanes
    attrConstruct = undefined
    attrClear = clearAudioBufferPlanes
    attrTransfer _ v = do
        return v

audioBuffer_planes :: AttrLabelProxy "planes"
audioBuffer_planes = AttrLabelProxy

#endif


-- | Get the value of the “@buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioBuffer #buffer
-- @
getAudioBufferBuffer :: MonadIO m => AudioBuffer -> m (Maybe Gst.Buffer.Buffer)
getAudioBufferBuffer :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m (Maybe Buffer)
getAudioBufferBuffer AudioBuffer
s = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ AudioBuffer
-> (Ptr AudioBuffer -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO (Maybe Buffer)) -> IO (Maybe Buffer))
-> (Ptr AudioBuffer -> IO (Maybe Buffer)) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr Buffer
val <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
344) :: IO (Ptr Gst.Buffer.Buffer)
    Maybe Buffer
result <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Buffer
val ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
val' -> do
        Buffer
val'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
val'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
val''
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
result

-- | Set the value of the “@buffer@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioBuffer [ #buffer 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioBufferBuffer :: MonadIO m => AudioBuffer -> Ptr Gst.Buffer.Buffer -> m ()
setAudioBufferBuffer :: forall (m :: * -> *).
MonadIO m =>
AudioBuffer -> Ptr Buffer -> m ()
setAudioBufferBuffer AudioBuffer
s Ptr Buffer
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO ()) -> IO ())
-> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
344) (Ptr Buffer
val :: Ptr Gst.Buffer.Buffer)

-- | Set the value of the “@buffer@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #buffer
-- @
clearAudioBufferBuffer :: MonadIO m => AudioBuffer -> m ()
clearAudioBufferBuffer :: forall (m :: * -> *). MonadIO m => AudioBuffer -> m ()
clearAudioBufferBuffer AudioBuffer
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioBuffer -> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioBuffer
s ((Ptr AudioBuffer -> IO ()) -> IO ())
-> (Ptr AudioBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioBuffer
ptr -> do
    Ptr (Ptr Buffer) -> Ptr Buffer -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioBuffer
ptr Ptr AudioBuffer -> Int -> Ptr (Ptr Buffer)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
344) (Ptr Buffer
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Buffer.Buffer)

#if defined(ENABLE_OVERLOADING)
data AudioBufferBufferFieldInfo
instance AttrInfo AudioBufferBufferFieldInfo where
    type AttrBaseTypeConstraint AudioBufferBufferFieldInfo = (~) AudioBuffer
    type AttrAllowedOps AudioBufferBufferFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AudioBufferBufferFieldInfo = (~) (Ptr Gst.Buffer.Buffer)
    type AttrTransferTypeConstraint AudioBufferBufferFieldInfo = (~)(Ptr Gst.Buffer.Buffer)
    type AttrTransferType AudioBufferBufferFieldInfo = (Ptr Gst.Buffer.Buffer)
    type AttrGetType AudioBufferBufferFieldInfo = Maybe Gst.Buffer.Buffer
    type AttrLabel AudioBufferBufferFieldInfo = "buffer"
    type AttrOrigin AudioBufferBufferFieldInfo = AudioBuffer
    attrGet = getAudioBufferBuffer
    attrSet = setAudioBufferBuffer
    attrConstruct = undefined
    attrClear = clearAudioBufferBuffer
    attrTransfer _ v = do
        return v

audioBuffer_buffer :: AttrLabelProxy "buffer"
audioBuffer_buffer = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioBuffer
type instance O.AttributeList AudioBuffer = AudioBufferAttributeList
type AudioBufferAttributeList = ('[ '("info", AudioBufferInfoFieldInfo), '("nSamples", AudioBufferNSamplesFieldInfo), '("nPlanes", AudioBufferNPlanesFieldInfo), '("planes", AudioBufferPlanesFieldInfo), '("buffer", AudioBufferBufferFieldInfo)] :: [(Symbol, *)])
#endif

-- method AudioBuffer::map
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to a #GstAudioBuffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the audio properties of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gstbuffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstBuffer to be mapped"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the access mode for the memory"
--                 , 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_buffer_map" gst_audio_buffer_map :: 
    Ptr AudioBuffer ->                      -- buffer : TInterface (Name {namespace = "GstAudio", name = "AudioBuffer"})
    Ptr GstAudio.AudioInfo.AudioInfo ->     -- info : TInterface (Name {namespace = "GstAudio", name = "AudioInfo"})
    Ptr Gst.Buffer.Buffer ->                -- gstbuffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "MapFlags"})
    IO CInt

-- | Maps an audio /@gstbuffer@/ so that it can be read or written and stores the
-- result of the map operation in /@buffer@/.
-- 
-- This is especially useful when the /@gstbuffer@/ is in non-interleaved (planar)
-- layout, in which case this function will use the information in the
-- /@gstbuffer@/\'s attached t'GI.GstAudio.Structs.AudioMeta.AudioMeta' in order to map each channel in a
-- separate \"plane\" in t'GI.GstAudio.Structs.AudioBuffer.AudioBuffer'. If a t'GI.GstAudio.Structs.AudioMeta.AudioMeta' is not attached
-- on the /@gstbuffer@/, then it must be in interleaved layout.
-- 
-- If a t'GI.GstAudio.Structs.AudioMeta.AudioMeta' is attached, then the t'GI.GstAudio.Structs.AudioInfo.AudioInfo' on the meta is checked
-- against /@info@/. Normally, they should be equal, but in case they are not,
-- a g_critical will be printed and the t'GI.GstAudio.Structs.AudioInfo.AudioInfo' from the meta will be
-- used.
-- 
-- In non-interleaved buffers, it is possible to have each channel on a separate
-- t'GI.Gst.Structs.Memory.Memory'. In this case, each memory will be mapped separately to avoid
-- copying their contents in a larger memory area. Do note though that it is
-- not supported to have a single channel spanning over two or more different
-- t'GI.Gst.Structs.Memory.Memory' objects. Although the map operation will likely succeed in this
-- case, it will be highly sub-optimal and it is recommended to merge all the
-- memories in the buffer before calling this function.
-- 
-- Note: The actual t'GI.Gst.Structs.Buffer.Buffer' is not ref\'ed, but it is required to stay valid
-- as long as it\'s mapped.
-- 
-- /Since: 1.16/
audioBufferMap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioBuffer
    -- ^ /@buffer@/: pointer to a t'GI.GstAudio.Structs.AudioBuffer.AudioBuffer'
    -> GstAudio.AudioInfo.AudioInfo
    -- ^ /@info@/: the audio properties of the buffer
    -> Gst.Buffer.Buffer
    -- ^ /@gstbuffer@/: the t'GI.Gst.Structs.Buffer.Buffer' to be mapped
    -> [Gst.Flags.MapFlags]
    -- ^ /@flags@/: the access mode for the memory
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the map operation succeeded or 'P.False' on failure
audioBufferMap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioBuffer -> AudioInfo -> Buffer -> [MapFlags] -> m Bool
audioBufferMap AudioBuffer
buffer AudioInfo
info Buffer
gstbuffer [MapFlags]
flags = 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 AudioBuffer
buffer' <- AudioBuffer -> IO (Ptr AudioBuffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioBuffer
buffer
    Ptr AudioInfo
info' <- AudioInfo -> IO (Ptr AudioInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioInfo
info
    Ptr Buffer
gstbuffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
gstbuffer
    let flags' :: CUInt
flags' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
flags
    CInt
result <- Ptr AudioBuffer -> Ptr AudioInfo -> Ptr Buffer -> CUInt -> IO CInt
gst_audio_buffer_map Ptr AudioBuffer
buffer' Ptr AudioInfo
info' Ptr Buffer
gstbuffer' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AudioBuffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioBuffer
buffer
    AudioInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioInfo
info
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
gstbuffer
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioBufferMapMethodInfo
instance (signature ~ (GstAudio.AudioInfo.AudioInfo -> Gst.Buffer.Buffer -> [Gst.Flags.MapFlags] -> m Bool), MonadIO m) => O.OverloadedMethod AudioBufferMapMethodInfo AudioBuffer signature where
    overloadedMethod = audioBufferMap

instance O.OverloadedMethodInfo AudioBufferMapMethodInfo AudioBuffer where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstAudio.Structs.AudioBuffer.audioBufferMap",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.23/docs/GI-GstAudio-Structs-AudioBuffer.html#v:audioBufferMap"
        }


#endif

-- method AudioBuffer::unmap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioBuffer to unmap"
--                 , 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_buffer_unmap" gst_audio_buffer_unmap :: 
    Ptr AudioBuffer ->                      -- buffer : TInterface (Name {namespace = "GstAudio", name = "AudioBuffer"})
    IO ()

-- | Unmaps an audio buffer that was previously mapped with
-- 'GI.GstAudio.Structs.AudioBuffer.audioBufferMap'.
-- 
-- /Since: 1.16/
audioBufferUnmap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioBuffer
    -- ^ /@buffer@/: the t'GI.GstAudio.Structs.AudioBuffer.AudioBuffer' to unmap
    -> m ()
audioBufferUnmap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioBuffer -> m ()
audioBufferUnmap AudioBuffer
buffer = 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 AudioBuffer
buffer' <- AudioBuffer -> IO (Ptr AudioBuffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioBuffer
buffer
    Ptr AudioBuffer -> IO ()
gst_audio_buffer_unmap Ptr AudioBuffer
buffer'
    AudioBuffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioBuffer
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioBufferUnmapMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod AudioBufferUnmapMethodInfo AudioBuffer signature where
    overloadedMethod = audioBufferUnmap

instance O.OverloadedMethodInfo AudioBufferUnmapMethodInfo AudioBuffer where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstAudio.Structs.AudioBuffer.audioBufferUnmap",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.23/docs/GI-GstAudio-Structs-AudioBuffer.html#v:audioBufferUnmap"
        }


#endif

-- method AudioBuffer::clip
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The buffer to clip."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Segment in %GST_FORMAT_TIME or %GST_FORMAT_DEFAULT to which\n          the buffer should be clipped."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "sample rate." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bpf"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "size of one audio frame in bytes. This is the size of one sample *\nnumber of channels."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_buffer_clip" gst_audio_buffer_clip :: 
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Segment.Segment ->              -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    Int32 ->                                -- rate : TBasicType TInt
    Int32 ->                                -- bpf : TBasicType TInt
    IO (Ptr Gst.Buffer.Buffer)

-- | Clip the buffer to the given @/GstSegment/@.
-- 
-- After calling this function the caller does not own a reference to
-- /@buffer@/ anymore.
audioBufferClip ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Buffer.Buffer
    -- ^ /@buffer@/: The buffer to clip.
    -> Gst.Segment.Segment
    -- ^ /@segment@/: Segment in 'GI.Gst.Enums.FormatTime' or 'GI.Gst.Enums.FormatDefault' to which
    --           the buffer should be clipped.
    -> Int32
    -- ^ /@rate@/: sample rate.
    -> Int32
    -- ^ /@bpf@/: size of one audio frame in bytes. This is the size of one sample *
    -- number of channels.
    -> m Gst.Buffer.Buffer
    -- ^ __Returns:__ 'P.Nothing' if the buffer is completely outside the configured segment,
    -- otherwise the clipped buffer is returned.
    -- 
    -- If the buffer has no timestamp, it is assumed to be inside the segment and
    -- is not clipped
audioBufferClip :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Segment -> Int32 -> Int32 -> m Buffer
audioBufferClip Buffer
buffer Segment
segment Int32
rate Int32
bpf = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    Ptr Buffer
result <- Ptr Buffer -> Ptr Segment -> Int32 -> Int32 -> IO (Ptr Buffer)
gst_audio_buffer_clip Ptr Buffer
buffer' Ptr Segment
segment' Int32
rate Int32
bpf
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioBufferClip" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AudioBuffer::reorder_channels
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The buffer to reorder."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The %GstAudioFormat of the buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "channels"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of channels."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface
--                    Name { namespace = "GstAudio" , name = "AudioChannelPosition" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The channel positions in the buffer."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface
--                    Name { namespace = "GstAudio" , name = "AudioChannelPosition" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The channel positions to convert to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "channels"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The number of channels."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "channels"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The number of channels."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_buffer_reorder_channels" gst_audio_buffer_reorder_channels :: 
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstAudio", name = "AudioFormat"})
    Int32 ->                                -- channels : TBasicType TInt
    Ptr CInt ->                             -- from : TCArray False (-1) 2 (TInterface (Name {namespace = "GstAudio", name = "AudioChannelPosition"}))
    Ptr CInt ->                             -- to : TCArray False (-1) 2 (TInterface (Name {namespace = "GstAudio", name = "AudioChannelPosition"}))
    IO CInt

-- | Reorders /@buffer@/ from the channel positions /@from@/ to the channel
-- positions /@to@/. /@from@/ and /@to@/ must contain the same number of
-- positions and the same positions, only in a different order.
-- /@buffer@/ must be writable.
audioBufferReorderChannels ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Buffer.Buffer
    -- ^ /@buffer@/: The buffer to reorder.
    -> GstAudio.Enums.AudioFormat
    -- ^ /@format@/: The @/GstAudioFormat/@ of the buffer.
    -> [GstAudio.Enums.AudioChannelPosition]
    -- ^ /@from@/: The channel positions in the buffer.
    -> [GstAudio.Enums.AudioChannelPosition]
    -- ^ /@to@/: The channel positions to convert to.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the reordering was possible.
audioBufferReorderChannels :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer
-> AudioFormat
-> [AudioChannelPosition]
-> [AudioChannelPosition]
-> m Bool
audioBufferReorderChannels Buffer
buffer AudioFormat
format [AudioChannelPosition]
from [AudioChannelPosition]
to = 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
    let channels :: Int32
channels = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [AudioChannelPosition] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [AudioChannelPosition]
to
    let from_expected_length_ :: Int32
from_expected_length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [AudioChannelPosition] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [AudioChannelPosition]
from
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int32
from_expected_length_ Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
channels) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"GstAudio.audioBufferReorderChannels : length of 'from' does not agree with that of 'to'."
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (AudioFormat -> Int) -> AudioFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioFormat -> Int
forall a. Enum a => a -> Int
fromEnum) AudioFormat
format
    let from' :: [CInt]
from' = (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]
from
    Ptr CInt
from'' <- [CInt] -> IO (Ptr CInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CInt]
from'
    let to' :: [CInt]
to' = (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]
to
    Ptr CInt
to'' <- [CInt] -> IO (Ptr CInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CInt]
to'
    CInt
result <- Ptr Buffer -> CUInt -> Int32 -> Ptr CInt -> Ptr CInt -> IO CInt
gst_audio_buffer_reorder_channels Ptr Buffer
buffer' CUInt
format' Int32
channels Ptr CInt
from'' Ptr CInt
to''
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
from''
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
to''
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AudioBuffer::truncate
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The buffer to truncate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "bpf"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "size of one audio frame in bytes. This is the size of one sample *\nnumber of channels."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trim"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the number of samples to remove from the beginning of the buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "samples"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the final number of samples that should exist in this buffer or -1\nto use all the remaining samples if you are only removing samples from the\nbeginning."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_buffer_truncate" gst_audio_buffer_truncate :: 
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Int32 ->                                -- bpf : TBasicType TInt
    Word64 ->                               -- trim : TBasicType TUInt64
    Word64 ->                               -- samples : TBasicType TUInt64
    IO (Ptr Gst.Buffer.Buffer)

-- | Truncate the buffer to finally have /@samples@/ number of samples, removing
-- the necessary amount of samples from the end and /@trim@/ number of samples
-- from the beginning.
-- 
-- After calling this function the caller does not own a reference to
-- /@buffer@/ anymore.
-- 
-- /Since: 1.16/
audioBufferTruncate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Buffer.Buffer
    -- ^ /@buffer@/: The buffer to truncate.
    -> Int32
    -- ^ /@bpf@/: size of one audio frame in bytes. This is the size of one sample *
    -- number of channels.
    -> Word64
    -- ^ /@trim@/: the number of samples to remove from the beginning of the buffer
    -> Word64
    -- ^ /@samples@/: the final number of samples that should exist in this buffer or -1
    -- to use all the remaining samples if you are only removing samples from the
    -- beginning.
    -> m Gst.Buffer.Buffer
    -- ^ __Returns:__ the truncated buffer or 'P.Nothing' if the arguments
    --   were invalid
audioBufferTruncate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Buffer -> Int32 -> Word64 -> Word64 -> m Buffer
audioBufferTruncate Buffer
buffer Int32
bpf Word64
trim Word64
samples = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Buffer
buffer
    Ptr Buffer
result <- Ptr Buffer -> Int32 -> Word64 -> Word64 -> IO (Ptr Buffer)
gst_audio_buffer_truncate Ptr Buffer
buffer' Int32
bpf Word64
trim Word64
samples
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioBufferTruncate" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioBufferMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioBufferMethod "map" o = AudioBufferMapMethodInfo
    ResolveAudioBufferMethod "unmap" o = AudioBufferUnmapMethodInfo
    ResolveAudioBufferMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveAudioBufferMethod t AudioBuffer, O.OverloadedMethod info AudioBuffer p, R.HasField t AudioBuffer p) => R.HasField t AudioBuffer p where
    getField = O.overloadedMethod @info

#endif

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

#endif