{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Information for an audio format.

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

module GI.GstAudio.Structs.AudioFormatInfo
    ( 

-- * Exported types
    AudioFormatInfo(..)                     ,
    newZeroAudioFormatInfo                  ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveAudioFormatInfoMethod            ,
#endif



 -- * Properties


-- ** depth #attr:depth#
-- | amount of valid bits in /@width@/

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_depth                   ,
#endif
    getAudioFormatInfoDepth                 ,
    setAudioFormatInfoDepth                 ,


-- ** description #attr:description#
-- | user readable description of the format

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_description             ,
#endif
    clearAudioFormatInfoDescription         ,
    getAudioFormatInfoDescription           ,
    setAudioFormatInfoDescription           ,


-- ** endianness #attr:endianness#
-- | the endianness

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_endianness              ,
#endif
    getAudioFormatInfoEndianness            ,
    setAudioFormatInfoEndianness            ,


-- ** flags #attr:flags#
-- | t'GI.GstAudio.Flags.AudioFormatFlags'

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_flags                   ,
#endif
    getAudioFormatInfoFlags                 ,
    setAudioFormatInfoFlags                 ,


-- ** format #attr:format#
-- | t'GI.GstAudio.Enums.AudioFormat'

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_format                  ,
#endif
    getAudioFormatInfoFormat                ,
    setAudioFormatInfoFormat                ,


-- ** name #attr:name#
-- | string representation of the format

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_name                    ,
#endif
    clearAudioFormatInfoName                ,
    getAudioFormatInfoName                  ,
    setAudioFormatInfoName                  ,


-- ** packFunc #attr:packFunc#
-- | function to pack samples

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_packFunc                ,
#endif
    clearAudioFormatInfoPackFunc            ,
    getAudioFormatInfoPackFunc              ,
    setAudioFormatInfoPackFunc              ,


-- ** unpackFormat #attr:unpackFormat#
-- | the format of the unpacked samples

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_unpackFormat            ,
#endif
    getAudioFormatInfoUnpackFormat          ,
    setAudioFormatInfoUnpackFormat          ,


-- ** unpackFunc #attr:unpackFunc#
-- | function to unpack samples

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_unpackFunc              ,
#endif
    clearAudioFormatInfoUnpackFunc          ,
    getAudioFormatInfoUnpackFunc            ,
    setAudioFormatInfoUnpackFunc            ,


-- ** width #attr:width#
-- | amount of bits used for one sample

#if defined(ENABLE_OVERLOADING)
    audioFormatInfo_width                   ,
#endif
    getAudioFormatInfoWidth                 ,
    setAudioFormatInfoWidth                 ,




    ) 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.GstAudio.Callbacks as GstAudio.Callbacks
import {-# SOURCE #-} qualified GI.GstAudio.Enums as GstAudio.Enums
import {-# SOURCE #-} qualified GI.GstAudio.Flags as GstAudio.Flags

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

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

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


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

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


-- | Get the value of the “@format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #format
-- @
getAudioFormatInfoFormat :: MonadIO m => AudioFormatInfo -> m GstAudio.Enums.AudioFormat
getAudioFormatInfoFormat :: forall (m :: * -> *). MonadIO m => AudioFormatInfo -> m AudioFormat
getAudioFormatInfoFormat AudioFormatInfo
s = IO AudioFormat -> m AudioFormat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioFormat -> m AudioFormat)
-> IO AudioFormat -> m AudioFormat
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO AudioFormat) -> IO AudioFormat
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO AudioFormat) -> IO AudioFormat)
-> (Ptr AudioFormatInfo -> IO AudioFormat) -> IO AudioFormat
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: AudioFormat
val' = (Int -> AudioFormat
forall a. Enum a => Int -> a
toEnum (Int -> AudioFormat) -> (CUInt -> Int) -> CUInt -> AudioFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    AudioFormat -> IO AudioFormat
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormat
val'

-- | Set the value of the “@format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioFormatInfo [ #format 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioFormatInfoFormat :: MonadIO m => AudioFormatInfo -> GstAudio.Enums.AudioFormat -> m ()
setAudioFormatInfoFormat :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> AudioFormat -> m ()
setAudioFormatInfoFormat AudioFormatInfo
s AudioFormat
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    let val' :: CUInt
val' = (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
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoFormatFieldInfo
instance AttrInfo AudioFormatInfoFormatFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoFormatFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioFormatInfoFormatFieldInfo = (~) GstAudio.Enums.AudioFormat
    type AttrTransferTypeConstraint AudioFormatInfoFormatFieldInfo = (~)GstAudio.Enums.AudioFormat
    type AttrTransferType AudioFormatInfoFormatFieldInfo = GstAudio.Enums.AudioFormat
    type AttrGetType AudioFormatInfoFormatFieldInfo = GstAudio.Enums.AudioFormat
    type AttrLabel AudioFormatInfoFormatFieldInfo = "format"
    type AttrOrigin AudioFormatInfoFormatFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoFormat
    attrSet = setAudioFormatInfoFormat
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioFormatInfo_format :: AttrLabelProxy "format"
audioFormatInfo_format = AttrLabelProxy

#endif


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #name
-- @
getAudioFormatInfoName :: MonadIO m => AudioFormatInfo -> m (Maybe T.Text)
getAudioFormatInfoName :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> m (Maybe Text)
getAudioFormatInfoName AudioFormatInfo
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr AudioFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@name@” 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' #name
-- @
clearAudioFormatInfoName :: MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoName :: forall (m :: * -> *). MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoName AudioFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoNameFieldInfo
instance AttrInfo AudioFormatInfoNameFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoNameFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AudioFormatInfoNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint AudioFormatInfoNameFieldInfo = (~)CString
    type AttrTransferType AudioFormatInfoNameFieldInfo = CString
    type AttrGetType AudioFormatInfoNameFieldInfo = Maybe T.Text
    type AttrLabel AudioFormatInfoNameFieldInfo = "name"
    type AttrOrigin AudioFormatInfoNameFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoName
    attrSet = setAudioFormatInfoName
    attrConstruct = undefined
    attrClear = clearAudioFormatInfoName
    attrTransfer _ v = do
        return v

audioFormatInfo_name :: AttrLabelProxy "name"
audioFormatInfo_name = AttrLabelProxy

#endif


-- | Get the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #description
-- @
getAudioFormatInfoDescription :: MonadIO m => AudioFormatInfo -> m (Maybe T.Text)
getAudioFormatInfoDescription :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> m (Maybe Text)
getAudioFormatInfoDescription AudioFormatInfo
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr AudioFormatInfo -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@description@” 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' #description
-- @
clearAudioFormatInfoDescription :: MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoDescription :: forall (m :: * -> *). MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoDescription AudioFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoDescriptionFieldInfo
instance AttrInfo AudioFormatInfoDescriptionFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoDescriptionFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AudioFormatInfoDescriptionFieldInfo = (~) CString
    type AttrTransferTypeConstraint AudioFormatInfoDescriptionFieldInfo = (~)CString
    type AttrTransferType AudioFormatInfoDescriptionFieldInfo = CString
    type AttrGetType AudioFormatInfoDescriptionFieldInfo = Maybe T.Text
    type AttrLabel AudioFormatInfoDescriptionFieldInfo = "description"
    type AttrOrigin AudioFormatInfoDescriptionFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoDescription
    attrSet = setAudioFormatInfoDescription
    attrConstruct = undefined
    attrClear = clearAudioFormatInfoDescription
    attrTransfer _ v = do
        return v

audioFormatInfo_description :: AttrLabelProxy "description"
audioFormatInfo_description = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #flags
-- @
getAudioFormatInfoFlags :: MonadIO m => AudioFormatInfo -> m [GstAudio.Flags.AudioFormatFlags]
getAudioFormatInfoFlags :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> m [AudioFormatFlags]
getAudioFormatInfoFlags AudioFormatInfo
s = IO [AudioFormatFlags] -> m [AudioFormatFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AudioFormatFlags] -> m [AudioFormatFlags])
-> IO [AudioFormatFlags] -> m [AudioFormatFlags]
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO [AudioFormatFlags])
-> IO [AudioFormatFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO [AudioFormatFlags])
 -> IO [AudioFormatFlags])
-> (Ptr AudioFormatInfo -> IO [AudioFormatFlags])
-> IO [AudioFormatFlags]
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CUInt
    let val' :: [AudioFormatFlags]
val' = CUInt -> [AudioFormatFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [AudioFormatFlags] -> IO [AudioFormatFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [AudioFormatFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioFormatInfo [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioFormatInfoFlags :: MonadIO m => AudioFormatInfo -> [GstAudio.Flags.AudioFormatFlags] -> m ()
setAudioFormatInfoFlags :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> [AudioFormatFlags] -> m ()
setAudioFormatInfoFlags AudioFormatInfo
s [AudioFormatFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    let val' :: CUInt
val' = [AudioFormatFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AudioFormatFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoFlagsFieldInfo
instance AttrInfo AudioFormatInfoFlagsFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoFlagsFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioFormatInfoFlagsFieldInfo = (~) [GstAudio.Flags.AudioFormatFlags]
    type AttrTransferTypeConstraint AudioFormatInfoFlagsFieldInfo = (~)[GstAudio.Flags.AudioFormatFlags]
    type AttrTransferType AudioFormatInfoFlagsFieldInfo = [GstAudio.Flags.AudioFormatFlags]
    type AttrGetType AudioFormatInfoFlagsFieldInfo = [GstAudio.Flags.AudioFormatFlags]
    type AttrLabel AudioFormatInfoFlagsFieldInfo = "flags"
    type AttrOrigin AudioFormatInfoFlagsFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoFlags
    attrSet = setAudioFormatInfoFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioFormatInfo_flags :: AttrLabelProxy "flags"
audioFormatInfo_flags = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoEndiannessFieldInfo
instance AttrInfo AudioFormatInfoEndiannessFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoEndiannessFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoEndiannessFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioFormatInfoEndiannessFieldInfo = (~) Int32
    type AttrTransferTypeConstraint AudioFormatInfoEndiannessFieldInfo = (~)Int32
    type AttrTransferType AudioFormatInfoEndiannessFieldInfo = Int32
    type AttrGetType AudioFormatInfoEndiannessFieldInfo = Int32
    type AttrLabel AudioFormatInfoEndiannessFieldInfo = "endianness"
    type AttrOrigin AudioFormatInfoEndiannessFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoEndianness
    attrSet = setAudioFormatInfoEndianness
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioFormatInfo_endianness :: AttrLabelProxy "endianness"
audioFormatInfo_endianness = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoWidthFieldInfo
instance AttrInfo AudioFormatInfoWidthFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoWidthFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioFormatInfoWidthFieldInfo = (~) Int32
    type AttrTransferTypeConstraint AudioFormatInfoWidthFieldInfo = (~)Int32
    type AttrTransferType AudioFormatInfoWidthFieldInfo = Int32
    type AttrGetType AudioFormatInfoWidthFieldInfo = Int32
    type AttrLabel AudioFormatInfoWidthFieldInfo = "width"
    type AttrOrigin AudioFormatInfoWidthFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoWidth
    attrSet = setAudioFormatInfoWidth
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioFormatInfo_width :: AttrLabelProxy "width"
audioFormatInfo_width = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoDepthFieldInfo
instance AttrInfo AudioFormatInfoDepthFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoDepthFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoDepthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioFormatInfoDepthFieldInfo = (~) Int32
    type AttrTransferTypeConstraint AudioFormatInfoDepthFieldInfo = (~)Int32
    type AttrTransferType AudioFormatInfoDepthFieldInfo = Int32
    type AttrGetType AudioFormatInfoDepthFieldInfo = Int32
    type AttrLabel AudioFormatInfoDepthFieldInfo = "depth"
    type AttrOrigin AudioFormatInfoDepthFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoDepth
    attrSet = setAudioFormatInfoDepth
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioFormatInfo_depth :: AttrLabelProxy "depth"
audioFormatInfo_depth = AttrLabelProxy

#endif


-- XXX Skipped attribute for "AudioFormatInfo:silence"
-- Not implemented: Don't know how to unpack C array of type TCArray False 8 (-1) (TBasicType TUInt8)
-- | Get the value of the “@unpack_format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #unpackFormat
-- @
getAudioFormatInfoUnpackFormat :: MonadIO m => AudioFormatInfo -> m GstAudio.Enums.AudioFormat
getAudioFormatInfoUnpackFormat :: forall (m :: * -> *). MonadIO m => AudioFormatInfo -> m AudioFormat
getAudioFormatInfoUnpackFormat AudioFormatInfo
s = IO AudioFormat -> m AudioFormat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioFormat -> m AudioFormat)
-> IO AudioFormat -> m AudioFormat
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO AudioFormat) -> IO AudioFormat
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO AudioFormat) -> IO AudioFormat)
-> (Ptr AudioFormatInfo -> IO AudioFormat) -> IO AudioFormat
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO CUInt
    let val' :: AudioFormat
val' = (Int -> AudioFormat
forall a. Enum a => Int -> a
toEnum (Int -> AudioFormat) -> (CUInt -> Int) -> CUInt -> AudioFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    AudioFormat -> IO AudioFormat
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormat
val'

-- | Set the value of the “@unpack_format@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' audioFormatInfo [ #unpackFormat 'Data.GI.Base.Attributes.:=' value ]
-- @
setAudioFormatInfoUnpackFormat :: MonadIO m => AudioFormatInfo -> GstAudio.Enums.AudioFormat -> m ()
setAudioFormatInfoUnpackFormat :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> AudioFormat -> m ()
setAudioFormatInfoUnpackFormat AudioFormatInfo
s AudioFormat
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    let val' :: CUInt
val' = (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
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoUnpackFormatFieldInfo
instance AttrInfo AudioFormatInfoUnpackFormatFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoUnpackFormatFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoUnpackFormatFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint AudioFormatInfoUnpackFormatFieldInfo = (~) GstAudio.Enums.AudioFormat
    type AttrTransferTypeConstraint AudioFormatInfoUnpackFormatFieldInfo = (~)GstAudio.Enums.AudioFormat
    type AttrTransferType AudioFormatInfoUnpackFormatFieldInfo = GstAudio.Enums.AudioFormat
    type AttrGetType AudioFormatInfoUnpackFormatFieldInfo = GstAudio.Enums.AudioFormat
    type AttrLabel AudioFormatInfoUnpackFormatFieldInfo = "unpack_format"
    type AttrOrigin AudioFormatInfoUnpackFormatFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoUnpackFormat
    attrSet = setAudioFormatInfoUnpackFormat
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

audioFormatInfo_unpackFormat :: AttrLabelProxy "unpackFormat"
audioFormatInfo_unpackFormat = AttrLabelProxy

#endif


-- | Get the value of the “@unpack_func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #unpackFunc
-- @
getAudioFormatInfoUnpackFunc :: MonadIO m => AudioFormatInfo -> m (Maybe GstAudio.Callbacks.AudioFormatUnpack)
getAudioFormatInfoUnpackFunc :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> m (Maybe AudioFormatUnpack)
getAudioFormatInfoUnpackFunc AudioFormatInfo
s = IO (Maybe AudioFormatUnpack) -> m (Maybe AudioFormatUnpack)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AudioFormatUnpack) -> m (Maybe AudioFormatUnpack))
-> IO (Maybe AudioFormatUnpack) -> m (Maybe AudioFormatUnpack)
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO (Maybe AudioFormatUnpack))
-> IO (Maybe AudioFormatUnpack)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO (Maybe AudioFormatUnpack))
 -> IO (Maybe AudioFormatUnpack))
-> (Ptr AudioFormatInfo -> IO (Maybe AudioFormatUnpack))
-> IO (Maybe AudioFormatUnpack)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    FunPtr C_AudioFormatUnpack
val <- Ptr (FunPtr C_AudioFormatUnpack) -> IO (FunPtr C_AudioFormatUnpack)
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr (FunPtr C_AudioFormatUnpack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO (FunPtr GstAudio.Callbacks.C_AudioFormatUnpack)
    Maybe AudioFormatUnpack
result <- FunPtr C_AudioFormatUnpack
-> (FunPtr C_AudioFormatUnpack -> IO AudioFormatUnpack)
-> IO (Maybe AudioFormatUnpack)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_AudioFormatUnpack
val ((FunPtr C_AudioFormatUnpack -> IO AudioFormatUnpack)
 -> IO (Maybe AudioFormatUnpack))
-> (FunPtr C_AudioFormatUnpack -> IO AudioFormatUnpack)
-> IO (Maybe AudioFormatUnpack)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_AudioFormatUnpack
val' -> do
        let val'' :: AudioFormatUnpack
val'' = FunPtr C_AudioFormatUnpack -> AudioFormatUnpack
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_AudioFormatUnpack
-> AudioFormatInfo
-> [AudioPackFlags]
-> Ptr Word8
-> Ptr Word8
-> Int32
-> m ()
GstAudio.Callbacks.dynamic_AudioFormatUnpack FunPtr C_AudioFormatUnpack
val'
        AudioFormatUnpack -> IO AudioFormatUnpack
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormatUnpack
val''
    Maybe AudioFormatUnpack -> IO (Maybe AudioFormatUnpack)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AudioFormatUnpack
result

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

-- | Set the value of the “@unpack_func@” 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' #unpackFunc
-- @
clearAudioFormatInfoUnpackFunc :: MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoUnpackFunc :: forall (m :: * -> *). MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoUnpackFunc AudioFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    Ptr (FunPtr C_AudioFormatUnpack)
-> FunPtr C_AudioFormatUnpack -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr (FunPtr C_AudioFormatUnpack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (FunPtr C_AudioFormatUnpack
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GstAudio.Callbacks.C_AudioFormatUnpack)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoUnpackFuncFieldInfo
instance AttrInfo AudioFormatInfoUnpackFuncFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoUnpackFuncFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoUnpackFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AudioFormatInfoUnpackFuncFieldInfo = (~) (FunPtr GstAudio.Callbacks.C_AudioFormatUnpack)
    type AttrTransferTypeConstraint AudioFormatInfoUnpackFuncFieldInfo = (~)GstAudio.Callbacks.AudioFormatUnpack
    type AttrTransferType AudioFormatInfoUnpackFuncFieldInfo = (FunPtr GstAudio.Callbacks.C_AudioFormatUnpack)
    type AttrGetType AudioFormatInfoUnpackFuncFieldInfo = Maybe GstAudio.Callbacks.AudioFormatUnpack
    type AttrLabel AudioFormatInfoUnpackFuncFieldInfo = "unpack_func"
    type AttrOrigin AudioFormatInfoUnpackFuncFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoUnpackFunc
    attrSet = setAudioFormatInfoUnpackFunc
    attrConstruct = undefined
    attrClear = clearAudioFormatInfoUnpackFunc
    attrTransfer _ v = do
        GstAudio.Callbacks.mk_AudioFormatUnpack (GstAudio.Callbacks.wrap_AudioFormatUnpack Nothing v)

audioFormatInfo_unpackFunc :: AttrLabelProxy "unpackFunc"
audioFormatInfo_unpackFunc = AttrLabelProxy

#endif


-- | Get the value of the “@pack_func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' audioFormatInfo #packFunc
-- @
getAudioFormatInfoPackFunc :: MonadIO m => AudioFormatInfo -> m (Maybe GstAudio.Callbacks.AudioFormatPack)
getAudioFormatInfoPackFunc :: forall (m :: * -> *).
MonadIO m =>
AudioFormatInfo -> m (Maybe AudioFormatUnpack)
getAudioFormatInfoPackFunc AudioFormatInfo
s = IO (Maybe AudioFormatUnpack) -> m (Maybe AudioFormatUnpack)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AudioFormatUnpack) -> m (Maybe AudioFormatUnpack))
-> IO (Maybe AudioFormatUnpack) -> m (Maybe AudioFormatUnpack)
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo
-> (Ptr AudioFormatInfo -> IO (Maybe AudioFormatUnpack))
-> IO (Maybe AudioFormatUnpack)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO (Maybe AudioFormatUnpack))
 -> IO (Maybe AudioFormatUnpack))
-> (Ptr AudioFormatInfo -> IO (Maybe AudioFormatUnpack))
-> IO (Maybe AudioFormatUnpack)
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    FunPtr C_AudioFormatUnpack
val <- Ptr (FunPtr C_AudioFormatUnpack) -> IO (FunPtr C_AudioFormatUnpack)
forall a. Storable a => Ptr a -> IO a
peek (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr (FunPtr C_AudioFormatUnpack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO (FunPtr GstAudio.Callbacks.C_AudioFormatPack)
    Maybe AudioFormatUnpack
result <- FunPtr C_AudioFormatUnpack
-> (FunPtr C_AudioFormatUnpack -> IO AudioFormatUnpack)
-> IO (Maybe AudioFormatUnpack)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_AudioFormatUnpack
val ((FunPtr C_AudioFormatUnpack -> IO AudioFormatUnpack)
 -> IO (Maybe AudioFormatUnpack))
-> (FunPtr C_AudioFormatUnpack -> IO AudioFormatUnpack)
-> IO (Maybe AudioFormatUnpack)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_AudioFormatUnpack
val' -> do
        let val'' :: AudioFormatUnpack
val'' = FunPtr C_AudioFormatUnpack -> AudioFormatUnpack
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_AudioFormatUnpack
-> AudioFormatInfo
-> [AudioPackFlags]
-> Ptr Word8
-> Ptr Word8
-> Int32
-> m ()
GstAudio.Callbacks.dynamic_AudioFormatPack FunPtr C_AudioFormatUnpack
val'
        AudioFormatUnpack -> IO AudioFormatUnpack
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormatUnpack
val''
    Maybe AudioFormatUnpack -> IO (Maybe AudioFormatUnpack)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AudioFormatUnpack
result

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

-- | Set the value of the “@pack_func@” 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' #packFunc
-- @
clearAudioFormatInfoPackFunc :: MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoPackFunc :: forall (m :: * -> *). MonadIO m => AudioFormatInfo -> m ()
clearAudioFormatInfoPackFunc AudioFormatInfo
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AudioFormatInfo -> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr AudioFormatInfo
s ((Ptr AudioFormatInfo -> IO ()) -> IO ())
-> (Ptr AudioFormatInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AudioFormatInfo
ptr -> do
    Ptr (FunPtr C_AudioFormatUnpack)
-> FunPtr C_AudioFormatUnpack -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr AudioFormatInfo
ptr Ptr AudioFormatInfo -> Int -> Ptr (FunPtr C_AudioFormatUnpack)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (FunPtr C_AudioFormatUnpack
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GstAudio.Callbacks.C_AudioFormatPack)

#if defined(ENABLE_OVERLOADING)
data AudioFormatInfoPackFuncFieldInfo
instance AttrInfo AudioFormatInfoPackFuncFieldInfo where
    type AttrBaseTypeConstraint AudioFormatInfoPackFuncFieldInfo = (~) AudioFormatInfo
    type AttrAllowedOps AudioFormatInfoPackFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint AudioFormatInfoPackFuncFieldInfo = (~) (FunPtr GstAudio.Callbacks.C_AudioFormatPack)
    type AttrTransferTypeConstraint AudioFormatInfoPackFuncFieldInfo = (~)GstAudio.Callbacks.AudioFormatPack
    type AttrTransferType AudioFormatInfoPackFuncFieldInfo = (FunPtr GstAudio.Callbacks.C_AudioFormatPack)
    type AttrGetType AudioFormatInfoPackFuncFieldInfo = Maybe GstAudio.Callbacks.AudioFormatPack
    type AttrLabel AudioFormatInfoPackFuncFieldInfo = "pack_func"
    type AttrOrigin AudioFormatInfoPackFuncFieldInfo = AudioFormatInfo
    attrGet = getAudioFormatInfoPackFunc
    attrSet = setAudioFormatInfoPackFunc
    attrConstruct = undefined
    attrClear = clearAudioFormatInfoPackFunc
    attrTransfer _ v = do
        GstAudio.Callbacks.mk_AudioFormatPack (GstAudio.Callbacks.wrap_AudioFormatPack Nothing v)

audioFormatInfo_packFunc :: AttrLabelProxy "packFunc"
audioFormatInfo_packFunc = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioFormatInfo
type instance O.AttributeList AudioFormatInfo = AudioFormatInfoAttributeList
type AudioFormatInfoAttributeList = ('[ '("format", AudioFormatInfoFormatFieldInfo), '("name", AudioFormatInfoNameFieldInfo), '("description", AudioFormatInfoDescriptionFieldInfo), '("flags", AudioFormatInfoFlagsFieldInfo), '("endianness", AudioFormatInfoEndiannessFieldInfo), '("width", AudioFormatInfoWidthFieldInfo), '("depth", AudioFormatInfoDepthFieldInfo), '("unpackFormat", AudioFormatInfoUnpackFormatFieldInfo), '("unpackFunc", AudioFormatInfoUnpackFuncFieldInfo), '("packFunc", AudioFormatInfoPackFuncFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioFormatInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioFormatInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAudioFormatInfoMethod t AudioFormatInfo, O.OverloadedMethod info AudioFormatInfo p) => OL.IsLabel t (AudioFormatInfo -> 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 ~ ResolveAudioFormatInfoMethod t AudioFormatInfo, O.OverloadedMethod info AudioFormatInfo p, R.HasField t AudioFormatInfo p) => R.HasField t AudioFormatInfo p where
    getField = O.overloadedMethod @info

#endif

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

#endif