{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GstAudio.Structs.AudioResampler.AudioResampler' is a structure which holds the information
-- required to perform various kinds of resampling filtering.

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

module GI.GstAudio.Structs.AudioResampler
    ( 

-- * Exported types
    AudioResampler(..)                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAudioResamplerMethod             ,
#endif


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerFreeMethodInfo            ,
#endif
    audioResamplerFree                      ,


-- ** getInFrames #method:getInFrames#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerGetInFramesMethodInfo     ,
#endif
    audioResamplerGetInFrames               ,


-- ** getMaxLatency #method:getMaxLatency#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerGetMaxLatencyMethodInfo   ,
#endif
    audioResamplerGetMaxLatency             ,


-- ** getOutFrames #method:getOutFrames#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerGetOutFramesMethodInfo    ,
#endif
    audioResamplerGetOutFrames              ,


-- ** new #method:new#

    audioResamplerNew                       ,


-- ** optionsSetQuality #method:optionsSetQuality#

    audioResamplerOptionsSetQuality         ,


-- ** resample #method:resample#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerResampleMethodInfo        ,
#endif
    audioResamplerResample                  ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerResetMethodInfo           ,
#endif
    audioResamplerReset                     ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    AudioResamplerUpdateMethodInfo          ,
#endif
    audioResamplerUpdate                    ,




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

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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr AudioResampler where
    boxedPtrCopy :: AudioResampler -> IO AudioResampler
boxedPtrCopy = AudioResampler -> IO AudioResampler
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: AudioResampler -> IO ()
boxedPtrFree = \AudioResampler
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

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

-- | Free a previously allocated t'GI.GstAudio.Structs.AudioResampler.AudioResampler' /@resampler@/.
-- 
-- /Since: 1.6/
audioResamplerFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> m ()
audioResamplerFree :: AudioResampler -> m ()
audioResamplerFree AudioResampler
resampler = 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Ptr AudioResampler -> IO ()
gst_audio_resampler_free Ptr AudioResampler
resampler'
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioResamplerFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AudioResamplerFreeMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerFree

#endif

-- method AudioResampler::get_in_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResampler"
--                 , 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 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_resampler_get_in_frames" gst_audio_resampler_get_in_frames :: 
    Ptr AudioResampler ->                   -- resampler : TInterface (Name {namespace = "GstAudio", name = "AudioResampler"})
    Word64 ->                               -- out_frames : TBasicType TUInt64
    IO Word64

-- | Get the number of input frames that would currently be needed
-- to produce /@outFrames@/ from /@resampler@/.
audioResamplerGetInFrames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> Word64
    -- ^ /@outFrames@/: number of input frames
    -> m Word64
    -- ^ __Returns:__ The number of input frames needed for producing
    -- /@outFrames@/ of data from /@resampler@/.
audioResamplerGetInFrames :: AudioResampler -> Word64 -> m Word64
audioResamplerGetInFrames AudioResampler
resampler 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Word64
result <- Ptr AudioResampler -> Word64 -> IO Word64
gst_audio_resampler_get_in_frames Ptr AudioResampler
resampler' Word64
outFrames
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioResamplerGetInFramesMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m) => O.MethodInfo AudioResamplerGetInFramesMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerGetInFrames

#endif

-- method AudioResampler::get_max_latency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResampler"
--                 , 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_resampler_get_max_latency" gst_audio_resampler_get_max_latency :: 
    Ptr AudioResampler ->                   -- resampler : TInterface (Name {namespace = "GstAudio", name = "AudioResampler"})
    IO Word64

-- | Get the maximum number of input samples that the resampler would
-- need before producing output.
audioResamplerGetMaxLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> m Word64
    -- ^ __Returns:__ the latency of /@resampler@/ as expressed in the number of
    -- frames.
audioResamplerGetMaxLatency :: AudioResampler -> m Word64
audioResamplerGetMaxLatency AudioResampler
resampler = 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Word64
result <- Ptr AudioResampler -> IO Word64
gst_audio_resampler_get_max_latency Ptr AudioResampler
resampler'
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioResamplerGetMaxLatencyMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.MethodInfo AudioResamplerGetMaxLatencyMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerGetMaxLatency

#endif

-- method AudioResampler::get_out_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResampler"
--                 , 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_resampler_get_out_frames" gst_audio_resampler_get_out_frames :: 
    Ptr AudioResampler ->                   -- resampler : TInterface (Name {namespace = "GstAudio", name = "AudioResampler"})
    Word64 ->                               -- in_frames : TBasicType TUInt64
    IO Word64

-- | Get the number of output frames that would be currently available when
-- /@inFrames@/ are given to /@resampler@/.
audioResamplerGetOutFrames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> Word64
    -- ^ /@inFrames@/: number of input frames
    -> m Word64
    -- ^ __Returns:__ The number of frames that would be availabe after giving
    -- /@inFrames@/ as input to /@resampler@/.
audioResamplerGetOutFrames :: AudioResampler -> Word64 -> m Word64
audioResamplerGetOutFrames AudioResampler
resampler 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Word64
result <- Ptr AudioResampler -> Word64 -> IO Word64
gst_audio_resampler_get_out_frames Ptr AudioResampler
resampler' Word64
inFrames
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioResamplerGetOutFramesMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m) => O.MethodInfo AudioResamplerGetOutFramesMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerGetOutFrames

#endif

-- method AudioResampler::resample
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResampler"
--                 , 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 samples" , 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 samples" , 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: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_resampler_resample" gst_audio_resampler_resample :: 
    Ptr AudioResampler ->                   -- resampler : TInterface (Name {namespace = "GstAudio", name = "AudioResampler"})
    Ptr () ->                               -- in : TBasicType TPtr
    Word64 ->                               -- in_frames : TBasicType TUInt64
    Ptr () ->                               -- out : TBasicType TPtr
    Word64 ->                               -- out_frames : TBasicType TUInt64
    IO ()

-- | Perform resampling on /@inFrames@/ frames in /@in@/ and write /@outFrames@/ to /@out@/.
-- 
-- 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 pushed
-- into the resampler.
-- 
-- This function always produces /@outFrames@/ of output and consumes /@inFrames@/ of
-- input. Use 'GI.GstAudio.Structs.AudioResampler.audioResamplerGetOutFrames' and
-- 'GI.GstAudio.Structs.AudioResampler.audioResamplerGetInFrames' to make sure /@inFrames@/ and /@outFrames@/
-- are matching and /@in@/ and /@out@/ point to enough memory.
audioResamplerResample ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> Ptr ()
    -- ^ /@in@/: input samples
    -> Word64
    -- ^ /@inFrames@/: number of input frames
    -> Ptr ()
    -- ^ /@out@/: output samples
    -> Word64
    -- ^ /@outFrames@/: number of output frames
    -> m ()
audioResamplerResample :: AudioResampler -> Ptr () -> Word64 -> Ptr () -> Word64 -> m ()
audioResamplerResample AudioResampler
resampler Ptr ()
in_ Word64
inFrames Ptr ()
out Word64
outFrames = 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Ptr AudioResampler -> Ptr () -> Word64 -> Ptr () -> Word64 -> IO ()
gst_audio_resampler_resample Ptr AudioResampler
resampler' Ptr ()
in_ Word64
inFrames Ptr ()
out Word64
outFrames
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioResamplerResampleMethodInfo
instance (signature ~ (Ptr () -> Word64 -> Ptr () -> Word64 -> m ()), MonadIO m) => O.MethodInfo AudioResamplerResampleMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerResample

#endif

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

-- | Reset /@resampler@/ to the state it was when it was first created, discarding
-- all sample history.
audioResamplerReset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> m ()
audioResamplerReset :: AudioResampler -> m ()
audioResamplerReset AudioResampler
resampler = 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Ptr AudioResampler -> IO ()
gst_audio_resampler_reset Ptr AudioResampler
resampler'
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioResamplerResetMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AudioResamplerResetMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerReset

#endif

-- method AudioResampler::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "resampler"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResampler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResampler"
--                 , 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 "new 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 "new output rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new options or %NULL"
--                 , 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_resampler_update" gst_audio_resampler_update :: 
    Ptr AudioResampler ->                   -- resampler : TInterface (Name {namespace = "GstAudio", name = "AudioResampler"})
    Int32 ->                                -- in_rate : TBasicType TInt
    Int32 ->                                -- out_rate : TBasicType TInt
    Ptr Gst.Structure.Structure ->          -- options : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Update the resampler parameters for /@resampler@/. This function should
-- not be called concurrently with any other function on /@resampler@/.
-- 
-- When /@inRate@/ or /@outRate@/ is 0, its value is unchanged.
-- 
-- When /@options@/ is 'P.Nothing', the previously configured options are reused.
audioResamplerUpdate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioResampler
    -- ^ /@resampler@/: a t'GI.GstAudio.Structs.AudioResampler.AudioResampler'
    -> Int32
    -- ^ /@inRate@/: new input rate
    -> Int32
    -- ^ /@outRate@/: new output rate
    -> Gst.Structure.Structure
    -- ^ /@options@/: new options or 'P.Nothing'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the new parameters could be set
audioResamplerUpdate :: AudioResampler -> Int32 -> Int32 -> Structure -> m Bool
audioResamplerUpdate AudioResampler
resampler Int32
inRate Int32
outRate Structure
options = 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 AudioResampler
resampler' <- AudioResampler -> IO (Ptr AudioResampler)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioResampler
resampler
    Ptr Structure
options' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
options
    CInt
result <- Ptr AudioResampler -> Int32 -> Int32 -> Ptr Structure -> IO CInt
gst_audio_resampler_update Ptr AudioResampler
resampler' Int32
inRate Int32
outRate Ptr Structure
options'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    AudioResampler -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioResampler
resampler
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
options
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AudioResamplerUpdateMethodInfo
instance (signature ~ (Int32 -> Int32 -> Gst.Structure.Structure -> m Bool), MonadIO m) => O.MethodInfo AudioResamplerUpdateMethodInfo AudioResampler signature where
    overloadedMethod = audioResamplerUpdate

#endif

-- method AudioResampler::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "method"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResamplerMethod" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResamplerMethod"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResamplerFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstAudioResamplerFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GstAudio" , name = "AudioFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstAudioFormat"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "channels"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of channels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "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 = "options"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "extra options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstAudio" , name = "AudioResampler" })
-- throws : False
-- Skip return : True
-- XXX return value ignored, but it is not a boolean.
--     This may be a memory leak?

foreign import ccall "gst_audio_resampler_new" gst_audio_resampler_new :: 
    CUInt ->                                -- method : TInterface (Name {namespace = "GstAudio", name = "AudioResamplerMethod"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstAudio", name = "AudioResamplerFlags"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstAudio", name = "AudioFormat"})
    Int32 ->                                -- channels : TBasicType TInt
    Int32 ->                                -- in_rate : TBasicType TInt
    Int32 ->                                -- out_rate : TBasicType TInt
    Ptr Gst.Structure.Structure ->          -- options : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr AudioResampler)

-- | Make a new resampler.
audioResamplerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstAudio.Enums.AudioResamplerMethod
    -- ^ /@method@/: a t'GI.GstAudio.Enums.AudioResamplerMethod'
    -> [GstAudio.Flags.AudioResamplerFlags]
    -- ^ /@flags@/: t'GI.GstAudio.Flags.AudioResamplerFlags'
    -> GstAudio.Enums.AudioFormat
    -- ^ /@format@/: the t'GI.GstAudio.Enums.AudioFormat'
    -> Int32
    -- ^ /@channels@/: the number of channels
    -> Int32
    -- ^ /@inRate@/: input rate
    -> Int32
    -- ^ /@outRate@/: output rate
    -> Gst.Structure.Structure
    -- ^ /@options@/: extra options
    -> m ()
audioResamplerNew :: AudioResamplerMethod
-> [AudioResamplerFlags]
-> AudioFormat
-> Int32
-> Int32
-> Int32
-> Structure
-> m ()
audioResamplerNew AudioResamplerMethod
method [AudioResamplerFlags]
flags AudioFormat
format Int32
channels Int32
inRate Int32
outRate Structure
options = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let method' :: CUInt
method' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AudioResamplerMethod -> Int) -> AudioResamplerMethod -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioResamplerMethod -> Int
forall a. Enum a => a -> Int
fromEnum) AudioResamplerMethod
method
    let flags' :: CUInt
flags' = [AudioResamplerFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AudioResamplerFlags]
flags
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (AudioFormat -> Int) -> AudioFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioFormat -> Int
forall a. Enum a => a -> Int
fromEnum) AudioFormat
format
    Ptr Structure
options' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
options
    Ptr AudioResampler
_ <- CUInt
-> CUInt
-> CUInt
-> Int32
-> Int32
-> Int32
-> Ptr Structure
-> IO (Ptr AudioResampler)
gst_audio_resampler_new CUInt
method' CUInt
flags' CUInt
format' Int32
channels Int32
inRate Int32
outRate Ptr Structure
options'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method AudioResampler::options_set_quality
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "method"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioResamplerMethod" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioResamplerMethod"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "quality"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the quality" , 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 "the 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 "the output rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure" , 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_resampler_options_set_quality" gst_audio_resampler_options_set_quality :: 
    CUInt ->                                -- method : TInterface (Name {namespace = "GstAudio", name = "AudioResamplerMethod"})
    Word32 ->                               -- quality : TBasicType TUInt
    Int32 ->                                -- in_rate : TBasicType TInt
    Int32 ->                                -- out_rate : TBasicType TInt
    Ptr Gst.Structure.Structure ->          -- options : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Set the parameters for resampling from /@inRate@/ to /@outRate@/ using /@method@/
-- for /@quality@/ in /@options@/.
audioResamplerOptionsSetQuality ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstAudio.Enums.AudioResamplerMethod
    -- ^ /@method@/: a t'GI.GstAudio.Enums.AudioResamplerMethod'
    -> Word32
    -- ^ /@quality@/: the quality
    -> Int32
    -- ^ /@inRate@/: the input rate
    -> Int32
    -- ^ /@outRate@/: the output rate
    -> Gst.Structure.Structure
    -- ^ /@options@/: a t'GI.Gst.Structs.Structure.Structure'
    -> m ()
audioResamplerOptionsSetQuality :: AudioResamplerMethod
-> Word32 -> Int32 -> Int32 -> Structure -> m ()
audioResamplerOptionsSetQuality AudioResamplerMethod
method Word32
quality Int32
inRate Int32
outRate Structure
options = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let method' :: CUInt
method' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AudioResamplerMethod -> Int) -> AudioResamplerMethod -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioResamplerMethod -> Int
forall a. Enum a => a -> Int
fromEnum) AudioResamplerMethod
method
    Ptr Structure
options' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Structure
options
    CUInt -> Word32 -> Int32 -> Int32 -> Ptr Structure -> IO ()
gst_audio_resampler_options_set_quality CUInt
method' Word32
quality Int32
inRate Int32
outRate Ptr Structure
options'
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
options
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioResamplerMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioResamplerMethod "free" o = AudioResamplerFreeMethodInfo
    ResolveAudioResamplerMethod "resample" o = AudioResamplerResampleMethodInfo
    ResolveAudioResamplerMethod "reset" o = AudioResamplerResetMethodInfo
    ResolveAudioResamplerMethod "update" o = AudioResamplerUpdateMethodInfo
    ResolveAudioResamplerMethod "getInFrames" o = AudioResamplerGetInFramesMethodInfo
    ResolveAudioResamplerMethod "getMaxLatency" o = AudioResamplerGetMaxLatencyMethodInfo
    ResolveAudioResamplerMethod "getOutFrames" o = AudioResamplerGetOutFramesMethodInfo
    ResolveAudioResamplerMethod l o = O.MethodResolutionFailed l o

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

#endif