{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This object is used to convert audio samples from one format to another.
-- The object can perform conversion of:
-- 
--  * audio format with optional dithering and noise shaping
-- 
--  * audio samplerate
-- 
--  * audio channels and channel layout

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

module GI.GstAudio.Structs.AudioConverter
    ( 

-- * Exported types
    AudioConverter(..)                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioConverterMethod             ,
#endif


-- ** convert #method:convert#

#if defined(ENABLE_OVERLOADING)
    AudioConverterConvertMethodInfo         ,
#endif
    audioConverterConvert                   ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    AudioConverterFreeMethodInfo            ,
#endif
    audioConverterFree                      ,


-- ** getConfig #method:getConfig#

#if defined(ENABLE_OVERLOADING)
    AudioConverterGetConfigMethodInfo       ,
#endif
    audioConverterGetConfig                 ,


-- ** getInFrames #method:getInFrames#

#if defined(ENABLE_OVERLOADING)
    AudioConverterGetInFramesMethodInfo     ,
#endif
    audioConverterGetInFrames               ,


-- ** getMaxLatency #method:getMaxLatency#

#if defined(ENABLE_OVERLOADING)
    AudioConverterGetMaxLatencyMethodInfo   ,
#endif
    audioConverterGetMaxLatency             ,


-- ** getOutFrames #method:getOutFrames#

#if defined(ENABLE_OVERLOADING)
    AudioConverterGetOutFramesMethodInfo    ,
#endif
    audioConverterGetOutFrames              ,


-- ** isPassthrough #method:isPassthrough#

#if defined(ENABLE_OVERLOADING)
    AudioConverterIsPassthroughMethodInfo   ,
#endif
    audioConverterIsPassthrough             ,


-- ** new #method:new#

    audioConverterNew                       ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    AudioConverterResetMethodInfo           ,
#endif
    audioConverterReset                     ,


-- ** samples #method:samples#

#if defined(ENABLE_OVERLOADING)
    AudioConverterSamplesMethodInfo         ,
#endif
    audioConverterSamples                   ,


-- ** supportsInplace #method:supportsInplace#

#if defined(ENABLE_OVERLOADING)
    AudioConverterSupportsInplaceMethodInfo ,
#endif
    audioConverterSupportsInplace           ,


-- ** updateConfig #method:updateConfig#

#if defined(ENABLE_OVERLOADING)
    AudioConverterUpdateConfigMethodInfo    ,
#endif
    audioConverterUpdateConfig              ,




    ) where

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

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

import qualified GI.Gst.Structs.Structure as Gst.Structure
import {-# SOURCE #-} qualified GI.GstAudio.Flags as GstAudio.Flags
import {-# SOURCE #-} qualified GI.GstAudio.Structs.AudioInfo as GstAudio.AudioInfo

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

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

foreign import ccall "gst_audio_converter_get_type" c_gst_audio_converter_get_type :: 
    IO GType

type instance O.ParentTypes AudioConverter = '[]
instance O.HasParentTypes AudioConverter

instance B.Types.TypedObject AudioConverter where
    glibType :: IO GType
glibType = IO GType
c_gst_audio_converter_get_type

instance B.Types.GBoxed AudioConverter

-- | Convert 'AudioConverter' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue AudioConverter where
    toGValue :: AudioConverter -> IO GValue
toGValue AudioConverter
o = do
        GType
gtype <- IO GType
c_gst_audio_converter_get_type
        AudioConverter -> (Ptr AudioConverter -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AudioConverter
o (GType
-> (GValue -> Ptr AudioConverter -> IO ())
-> Ptr AudioConverter
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr AudioConverter -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO AudioConverter
fromGValue GValue
gv = do
        Ptr AudioConverter
ptr <- GValue -> IO (Ptr AudioConverter)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr AudioConverter)
        (ManagedPtr AudioConverter -> AudioConverter)
-> Ptr AudioConverter -> IO AudioConverter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr AudioConverter -> AudioConverter
AudioConverter Ptr AudioConverter
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AudioConverter
type instance O.AttributeList AudioConverter = AudioConverterAttributeList
type AudioConverterAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method AudioConverter::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverterFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "extra #GstAudioConverterFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_info"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a source #GstAudioInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_info"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a destination #GstAudioInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure with configuration options"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstAudio" , name = "AudioConverter" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_converter_new" gst_audio_converter_new :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstAudio", name = "AudioConverterFlags"})
    Ptr GstAudio.AudioInfo.AudioInfo ->     -- in_info : TInterface (Name {namespace = "GstAudio", name = "AudioInfo"})
    Ptr GstAudio.AudioInfo.AudioInfo ->     -- out_info : TInterface (Name {namespace = "GstAudio", name = "AudioInfo"})
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr AudioConverter)

-- | Create a new t'GI.GstAudio.Structs.AudioConverter.AudioConverter' that is able to convert between /@in@/ and /@out@/
-- audio formats.
-- 
-- /@config@/ contains extra configuration options, see @/GST_AUDIO_CONVERTER_OPT_/@*
-- parameters for details about the options and values.
audioConverterNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [GstAudio.Flags.AudioConverterFlags]
    -- ^ /@flags@/: extra t'GI.GstAudio.Flags.AudioConverterFlags'
    -> GstAudio.AudioInfo.AudioInfo
    -- ^ /@inInfo@/: a source t'GI.GstAudio.Structs.AudioInfo.AudioInfo'
    -> GstAudio.AudioInfo.AudioInfo
    -- ^ /@outInfo@/: a destination t'GI.GstAudio.Structs.AudioInfo.AudioInfo'
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@config@/: a t'GI.Gst.Structs.Structure.Structure' with configuration options
    -> m AudioConverter
    -- ^ __Returns:__ a t'GI.GstAudio.Structs.AudioConverter.AudioConverter' or 'P.Nothing' if conversion is not possible.
audioConverterNew :: [AudioConverterFlags]
-> AudioInfo -> AudioInfo -> Maybe Structure -> m AudioConverter
audioConverterNew [AudioConverterFlags]
flags AudioInfo
inInfo AudioInfo
outInfo Maybe Structure
config = IO AudioConverter -> m AudioConverter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioConverter -> m AudioConverter)
-> IO AudioConverter -> m AudioConverter
forall a b. (a -> b) -> a -> b
$ do
    let flags' :: CUInt
flags' = [AudioConverterFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AudioConverterFlags]
flags
    Ptr AudioInfo
inInfo' <- AudioInfo -> IO (Ptr AudioInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioInfo
inInfo
    Ptr AudioInfo
outInfo' <- AudioInfo -> IO (Ptr AudioInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioInfo
outInfo
    Ptr Structure
maybeConfig <- case Maybe Structure
config of
        Maybe Structure
Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just Structure
jConfig -> do
            Ptr Structure
jConfig' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jConfig
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jConfig'
    Ptr AudioConverter
result <- CUInt
-> Ptr AudioInfo
-> Ptr AudioInfo
-> Ptr Structure
-> IO (Ptr AudioConverter)
gst_audio_converter_new CUInt
flags' Ptr AudioInfo
inInfo' Ptr AudioInfo
outInfo' Ptr Structure
maybeConfig
    Text -> Ptr AudioConverter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioConverterNew" Ptr AudioConverter
result
    AudioConverter
result' <- ((ManagedPtr AudioConverter -> AudioConverter)
-> Ptr AudioConverter -> IO AudioConverter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AudioConverter -> AudioConverter
AudioConverter) Ptr AudioConverter
result
    AudioInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioInfo
inInfo
    AudioInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioInfo
outInfo
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
config Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    AudioConverter -> IO AudioConverter
forall (m :: * -> *) a. Monad m => a -> m a
return AudioConverter
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AudioConverter::convert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverterFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "extra #GstAudioConverterFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of @in" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TCArray False (-1) 5 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer where\n the output data will be written"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer where the size of @out will be written"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "out_size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "a pointer where the size of @out will be written"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          , Arg
--              { argCName = "in_size"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "size of @in" , 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_converter_convert" gst_audio_converter_convert :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstAudio", name = "AudioConverterFlags"})
    Ptr Word8 ->                            -- in : TCArray False (-1) 3 (TBasicType TUInt8)
    Word64 ->                               -- in_size : TBasicType TUInt64
    Ptr (Ptr Word8) ->                      -- out : TCArray False (-1) 5 (TBasicType TUInt8)
    Ptr Word64 ->                           -- out_size : TBasicType TUInt64
    IO CInt

-- | Convenience wrapper around 'GI.GstAudio.Structs.AudioConverter.audioConverterSamples', which will
-- perform allocation of the output buffer based on the result from
-- 'GI.GstAudio.Structs.AudioConverter.audioConverterGetOutFrames'.
-- 
-- /Since: 1.14/
audioConverterConvert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> [GstAudio.Flags.AudioConverterFlags]
    -- ^ /@flags@/: extra t'GI.GstAudio.Flags.AudioConverterFlags'
    -> ByteString
    -- ^ /@in@/: input data
    -> m ((Bool, ByteString))
    -- ^ __Returns:__ 'P.True' is the conversion could be performed.
audioConverterConvert :: AudioConverter
-> [AudioConverterFlags] -> ByteString -> m (Bool, ByteString)
audioConverterConvert AudioConverter
convert [AudioConverterFlags]
flags ByteString
in_ = IO (Bool, ByteString) -> m (Bool, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, ByteString) -> m (Bool, ByteString))
-> IO (Bool, ByteString) -> m (Bool, ByteString)
forall a b. (a -> b) -> a -> b
$ do
    let inSize :: Word64
inSize = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
in_
    Ptr AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    let flags' :: CUInt
flags' = [AudioConverterFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AudioConverterFlags]
flags
    Ptr Word8
in_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
in_
    Ptr (Ptr Word8)
out <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
outSize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr AudioConverter
-> CUInt
-> Ptr Word8
-> Word64
-> Ptr (Ptr Word8)
-> Ptr Word64
-> IO CInt
gst_audio_converter_convert Ptr AudioConverter
convert' CUInt
flags' Ptr Word8
in_' Word64
inSize Ptr (Ptr Word8)
out Ptr Word64
outSize
    Word64
outSize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outSize
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Word8
out' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
out
    ByteString
out'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
outSize') Ptr Word8
out'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
out'
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
in_'
    Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
out
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outSize
    (Bool, ByteString) -> IO (Bool, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', ByteString
out'')

#if defined(ENABLE_OVERLOADING)
data AudioConverterConvertMethodInfo
instance (signature ~ ([GstAudio.Flags.AudioConverterFlags] -> ByteString -> m ((Bool, ByteString))), MonadIO m) => O.MethodInfo AudioConverterConvertMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterConvert

#endif

-- method AudioConverter::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , 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_converter_free" gst_audio_converter_free :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    IO ()

-- | Free a previously allocated /@convert@/ instance.
audioConverterFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> m ()
audioConverterFree :: AudioConverter -> m ()
audioConverterFree AudioConverter
convert = 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 AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Ptr AudioConverter -> IO ()
gst_audio_converter_free Ptr AudioConverter
convert'
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioConverterFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AudioConverterFreeMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterFree

#endif

-- method AudioConverter::get_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_rate"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result input rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_rate"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result output rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_converter_get_config" gst_audio_converter_get_config :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    Ptr Int32 ->                            -- in_rate : TBasicType TInt
    Ptr Int32 ->                            -- out_rate : TBasicType TInt
    IO (Ptr Gst.Structure.Structure)

-- | Get the current configuration of /@convert@/.
audioConverterGetConfig ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> m ((Gst.Structure.Structure, Int32, Int32))
    -- ^ __Returns:__ 
    --   a t'GI.Gst.Structs.Structure.Structure' that remains valid for as long as /@convert@/ is valid
    --   or until 'GI.GstAudio.Structs.AudioConverter.audioConverterUpdateConfig' is called.
audioConverterGetConfig :: AudioConverter -> m (Structure, Int32, Int32)
audioConverterGetConfig AudioConverter
convert = IO (Structure, Int32, Int32) -> m (Structure, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Structure, Int32, Int32) -> m (Structure, Int32, Int32))
-> IO (Structure, Int32, Int32) -> m (Structure, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Ptr Int32
inRate <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
outRate <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Structure
result <- Ptr AudioConverter -> Ptr Int32 -> Ptr Int32 -> IO (Ptr Structure)
gst_audio_converter_get_config Ptr AudioConverter
convert' Ptr Int32
inRate Ptr Int32
outRate
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioConverterGetConfig" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Int32
inRate' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
inRate
    Int32
outRate' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outRate
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
inRate
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outRate
    (Structure, Int32, Int32) -> IO (Structure, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Structure
result', Int32
inRate', Int32
outRate')

#if defined(ENABLE_OVERLOADING)
data AudioConverterGetConfigMethodInfo
instance (signature ~ (m ((Gst.Structure.Structure, Int32, Int32))), MonadIO m) => O.MethodInfo AudioConverterGetConfigMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterGetConfig

#endif

-- method AudioConverter::get_in_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_frames"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of output frames"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_converter_get_in_frames" gst_audio_converter_get_in_frames :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    Word64 ->                               -- out_frames : TBasicType TUInt64
    IO Word64

-- | Calculate how many input frames are currently needed by /@convert@/ to produce
-- /@outFrames@/ of output frames.
audioConverterGetInFrames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> Word64
    -- ^ /@outFrames@/: number of output frames
    -> m Word64
    -- ^ __Returns:__ the number of input frames
audioConverterGetInFrames :: AudioConverter -> Word64 -> m Word64
audioConverterGetInFrames AudioConverter
convert Word64
outFrames = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Word64
result <- Ptr AudioConverter -> Word64 -> IO Word64
gst_audio_converter_get_in_frames Ptr AudioConverter
convert' Word64
outFrames
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioConverterGetInFramesMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m) => O.MethodInfo AudioConverterGetInFramesMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterGetInFrames

#endif

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

foreign import ccall "gst_audio_converter_get_max_latency" gst_audio_converter_get_max_latency :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    IO Word64

-- | Get the maximum number of input frames that the converter would
-- need before producing output.
audioConverterGetMaxLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> m Word64
    -- ^ __Returns:__ the latency of /@convert@/ as expressed in the number of
    -- frames.
audioConverterGetMaxLatency :: AudioConverter -> m Word64
audioConverterGetMaxLatency AudioConverter
convert = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Word64
result <- Ptr AudioConverter -> IO Word64
gst_audio_converter_get_max_latency Ptr AudioConverter
convert'
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioConverterGetMaxLatencyMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.MethodInfo AudioConverterGetMaxLatencyMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterGetMaxLatency

#endif

-- method AudioConverter::get_out_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_frames"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of input frames"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_converter_get_out_frames" gst_audio_converter_get_out_frames :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    Word64 ->                               -- in_frames : TBasicType TUInt64
    IO Word64

-- | Calculate how many output frames can be produced when /@inFrames@/ input
-- frames are given to /@convert@/.
audioConverterGetOutFrames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> Word64
    -- ^ /@inFrames@/: number of input frames
    -> m Word64
    -- ^ __Returns:__ the number of output frames
audioConverterGetOutFrames :: AudioConverter -> Word64 -> m Word64
audioConverterGetOutFrames AudioConverter
convert Word64
inFrames = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Word64
result <- Ptr AudioConverter -> Word64 -> IO Word64
gst_audio_converter_get_out_frames Ptr AudioConverter
convert' Word64
inFrames
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioConverterGetOutFramesMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m) => O.MethodInfo AudioConverterGetOutFramesMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterGetOutFrames

#endif

-- method AudioConverter::is_passthrough
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_converter_is_passthrough" gst_audio_converter_is_passthrough :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    IO CInt

-- | Returns whether the audio converter will operate in passthrough mode.
-- The return value would be typically input to 'GI.GstBase.Objects.BaseTransform.baseTransformSetPassthrough'
-- 
-- /Since: 1.16/
audioConverterIsPassthrough ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -> m Bool
    -- ^ __Returns:__ 'P.True' when no conversion will actually occur.
audioConverterIsPassthrough :: AudioConverter -> m Bool
audioConverterIsPassthrough AudioConverter
convert = 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 AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    CInt
result <- Ptr AudioConverter -> IO CInt
gst_audio_converter_is_passthrough Ptr AudioConverter
convert'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioConverterIsPassthroughMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo AudioConverterIsPassthroughMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterIsPassthrough

#endif

-- method AudioConverter::reset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , 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_converter_reset" gst_audio_converter_reset :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    IO ()

-- | Reset /@convert@/ to the state it was when it was first created, clearing
-- any history it might currently have.
audioConverterReset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> m ()
audioConverterReset :: AudioConverter -> m ()
audioConverterReset AudioConverter
convert = 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 AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Ptr AudioConverter -> IO ()
gst_audio_converter_reset Ptr AudioConverter
convert'
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioConverterResetMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AudioConverterResetMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterReset

#endif

-- method AudioConverter::samples
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverterFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "extra #GstAudioConverterFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input frames" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_frames"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of input frames"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output frames" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_frames"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of output frames"
--                 , 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_converter_samples" gst_audio_converter_samples :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstAudio", name = "AudioConverterFlags"})
    Ptr () ->                               -- in : TBasicType TPtr
    Word64 ->                               -- in_frames : TBasicType TUInt64
    Ptr () ->                               -- out : TBasicType TPtr
    Word64 ->                               -- out_frames : TBasicType TUInt64
    IO CInt

-- | Perform the conversion with /@inFrames@/ in /@in@/ to /@outFrames@/ in /@out@/
-- using /@convert@/.
-- 
-- In case the samples are interleaved, /@in@/ and /@out@/ must point to an
-- array with a single element pointing to a block of interleaved samples.
-- 
-- If non-interleaved samples are used, /@in@/ and /@out@/ must point to an
-- array with pointers to memory blocks, one for each channel.
-- 
-- /@in@/ may be 'P.Nothing', in which case /@inFrames@/ of silence samples are processed
-- by the converter.
-- 
-- This function always produces /@outFrames@/ of output and consumes /@inFrames@/ of
-- input. Use 'GI.GstAudio.Structs.AudioConverter.audioConverterGetOutFrames' and
-- 'GI.GstAudio.Structs.AudioConverter.audioConverterGetInFrames' to make sure /@inFrames@/ and /@outFrames@/
-- are matching and /@in@/ and /@out@/ point to enough memory.
audioConverterSamples ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> [GstAudio.Flags.AudioConverterFlags]
    -- ^ /@flags@/: extra t'GI.GstAudio.Flags.AudioConverterFlags'
    -> Ptr ()
    -- ^ /@in@/: input frames
    -> Word64
    -- ^ /@inFrames@/: number of input frames
    -> Ptr ()
    -- ^ /@out@/: output frames
    -> Word64
    -- ^ /@outFrames@/: number of output frames
    -> m Bool
    -- ^ __Returns:__ 'P.True' is the conversion could be performed.
audioConverterSamples :: AudioConverter
-> [AudioConverterFlags]
-> Ptr ()
-> Word64
-> Ptr ()
-> Word64
-> m Bool
audioConverterSamples AudioConverter
convert [AudioConverterFlags]
flags Ptr ()
in_ Word64
inFrames Ptr ()
out Word64
outFrames = 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 AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    let flags' :: CUInt
flags' = [AudioConverterFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AudioConverterFlags]
flags
    CInt
result <- Ptr AudioConverter
-> CUInt -> Ptr () -> Word64 -> Ptr () -> Word64 -> IO CInt
gst_audio_converter_samples Ptr AudioConverter
convert' CUInt
flags' Ptr ()
in_ Word64
inFrames Ptr ()
out Word64
outFrames
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioConverterSamplesMethodInfo
instance (signature ~ ([GstAudio.Flags.AudioConverterFlags] -> Ptr () -> Word64 -> Ptr () -> Word64 -> m Bool), MonadIO m) => O.MethodInfo AudioConverterSamplesMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterSamples

#endif

-- method AudioConverter::supports_inplace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , 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_converter_supports_inplace" gst_audio_converter_supports_inplace :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    IO CInt

-- | Returns whether the audio converter can perform the conversion in-place.
-- The return value would be typically input to 'GI.GstBase.Objects.BaseTransform.baseTransformSetInPlace'
audioConverterSupportsInplace ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> m Bool
    -- ^ __Returns:__ 'P.True' when the conversion can be done in place.
audioConverterSupportsInplace :: AudioConverter -> m Bool
audioConverterSupportsInplace AudioConverter
convert = 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 AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    CInt
result <- Ptr AudioConverter -> IO CInt
gst_audio_converter_supports_inplace Ptr AudioConverter
convert'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioConverterSupportsInplaceMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo AudioConverterSupportsInplaceMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterSupportsInplace

#endif

-- method AudioConverter::update_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "convert"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioConverter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioConverter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "in_rate"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_rate"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_converter_update_config" gst_audio_converter_update_config :: 
    Ptr AudioConverter ->                   -- convert : TInterface (Name {namespace = "GstAudio", name = "AudioConverter"})
    Int32 ->                                -- in_rate : TBasicType TInt
    Int32 ->                                -- out_rate : TBasicType TInt
    Ptr Gst.Structure.Structure ->          -- config : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Set /@inRate@/, /@outRate@/ and /@config@/ as extra configuration for /@convert@/.
-- 
-- /@inRate@/ and /@outRate@/ specify the new sample rates of input and output
-- formats. A value of 0 leaves the sample rate unchanged.
-- 
-- /@config@/ can be 'P.Nothing', in which case, the current configuration is not
-- changed.
-- 
-- If the parameters in /@config@/ can not be set exactly, this function returns
-- 'P.False' and will try to update as much state as possible. The new state can
-- then be retrieved and refined with 'GI.GstAudio.Structs.AudioConverter.audioConverterGetConfig'.
-- 
-- Look at the @/GST_AUDIO_CONVERTER_OPT_/@* fields to check valid configuration
-- option and values.
audioConverterUpdateConfig ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioConverter
    -- ^ /@convert@/: a t'GI.GstAudio.Structs.AudioConverter.AudioConverter'
    -> Int32
    -- ^ /@inRate@/: input rate
    -> Int32
    -- ^ /@outRate@/: output rate
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@config@/: a t'GI.Gst.Structs.Structure.Structure' or 'P.Nothing'
    -> m Bool
    -- ^ __Returns:__ 'P.True' when the new parameters could be set
audioConverterUpdateConfig :: AudioConverter -> Int32 -> Int32 -> Maybe Structure -> m Bool
audioConverterUpdateConfig AudioConverter
convert Int32
inRate Int32
outRate Maybe Structure
config = 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 AudioConverter
convert' <- AudioConverter -> IO (Ptr AudioConverter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioConverter
convert
    Ptr Structure
maybeConfig <- case Maybe Structure
config of
        Maybe Structure
Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just Structure
jConfig -> do
            Ptr Structure
jConfig' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jConfig
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jConfig'
    CInt
result <- Ptr AudioConverter -> Int32 -> Int32 -> Ptr Structure -> IO CInt
gst_audio_converter_update_config Ptr AudioConverter
convert' Int32
inRate Int32
outRate Ptr Structure
maybeConfig
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AudioConverter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioConverter
convert
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
config Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioConverterUpdateConfigMethodInfo
instance (signature ~ (Int32 -> Int32 -> Maybe (Gst.Structure.Structure) -> m Bool), MonadIO m) => O.MethodInfo AudioConverterUpdateConfigMethodInfo AudioConverter signature where
    overloadedMethod = audioConverterUpdateConfig

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioConverterMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioConverterMethod "convert" o = AudioConverterConvertMethodInfo
    ResolveAudioConverterMethod "free" o = AudioConverterFreeMethodInfo
    ResolveAudioConverterMethod "isPassthrough" o = AudioConverterIsPassthroughMethodInfo
    ResolveAudioConverterMethod "reset" o = AudioConverterResetMethodInfo
    ResolveAudioConverterMethod "samples" o = AudioConverterSamplesMethodInfo
    ResolveAudioConverterMethod "supportsInplace" o = AudioConverterSupportsInplaceMethodInfo
    ResolveAudioConverterMethod "updateConfig" o = AudioConverterUpdateConfigMethodInfo
    ResolveAudioConverterMethod "getConfig" o = AudioConverterGetConfigMethodInfo
    ResolveAudioConverterMethod "getInFrames" o = AudioConverterGetInFramesMethodInfo
    ResolveAudioConverterMethod "getMaxLatency" o = AudioConverterGetMaxLatencyMethodInfo
    ResolveAudioConverterMethod "getOutFrames" o = AudioConverterGetOutFramesMethodInfo
    ResolveAudioConverterMethod l o = O.MethodResolutionFailed l o

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

#endif