{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign' provides a helper object that helps tracking audio
-- stream alignment and discontinuities, and detects discontinuities if
-- possible.
-- 
-- See 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignNew' for a description of its parameters and
-- 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignProcess' for the details of the processing.
-- 
-- /Since: 1.14/

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

module GI.GstAudio.Structs.AudioStreamAlign
    ( 

-- * Exported types
    AudioStreamAlign(..)                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.GstAudio.Structs.AudioStreamAlign#g:method:copy"), [free]("GI.GstAudio.Structs.AudioStreamAlign#g:method:free"), [markDiscont]("GI.GstAudio.Structs.AudioStreamAlign#g:method:markDiscont"), [process]("GI.GstAudio.Structs.AudioStreamAlign#g:method:process").
-- 
-- ==== Getters
-- [getAlignmentThreshold]("GI.GstAudio.Structs.AudioStreamAlign#g:method:getAlignmentThreshold"), [getDiscontWait]("GI.GstAudio.Structs.AudioStreamAlign#g:method:getDiscontWait"), [getRate]("GI.GstAudio.Structs.AudioStreamAlign#g:method:getRate"), [getSamplesSinceDiscont]("GI.GstAudio.Structs.AudioStreamAlign#g:method:getSamplesSinceDiscont"), [getTimestampAtDiscont]("GI.GstAudio.Structs.AudioStreamAlign#g:method:getTimestampAtDiscont").
-- 
-- ==== Setters
-- [setAlignmentThreshold]("GI.GstAudio.Structs.AudioStreamAlign#g:method:setAlignmentThreshold"), [setDiscontWait]("GI.GstAudio.Structs.AudioStreamAlign#g:method:setDiscontWait"), [setRate]("GI.GstAudio.Structs.AudioStreamAlign#g:method:setRate").

#if defined(ENABLE_OVERLOADING)
    ResolveAudioStreamAlignMethod           ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignCopyMethodInfo          ,
#endif
    audioStreamAlignCopy                    ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignFreeMethodInfo          ,
#endif
    audioStreamAlignFree                    ,


-- ** getAlignmentThreshold #method:getAlignmentThreshold#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignGetAlignmentThresholdMethodInfo,
#endif
    audioStreamAlignGetAlignmentThreshold   ,


-- ** getDiscontWait #method:getDiscontWait#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignGetDiscontWaitMethodInfo,
#endif
    audioStreamAlignGetDiscontWait          ,


-- ** getRate #method:getRate#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignGetRateMethodInfo       ,
#endif
    audioStreamAlignGetRate                 ,


-- ** getSamplesSinceDiscont #method:getSamplesSinceDiscont#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignGetSamplesSinceDiscontMethodInfo,
#endif
    audioStreamAlignGetSamplesSinceDiscont  ,


-- ** getTimestampAtDiscont #method:getTimestampAtDiscont#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignGetTimestampAtDiscontMethodInfo,
#endif
    audioStreamAlignGetTimestampAtDiscont   ,


-- ** markDiscont #method:markDiscont#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignMarkDiscontMethodInfo   ,
#endif
    audioStreamAlignMarkDiscont             ,


-- ** new #method:new#

    audioStreamAlignNew                     ,


-- ** process #method:process#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignProcessMethodInfo       ,
#endif
    audioStreamAlignProcess                 ,


-- ** setAlignmentThreshold #method:setAlignmentThreshold#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignSetAlignmentThresholdMethodInfo,
#endif
    audioStreamAlignSetAlignmentThreshold   ,


-- ** setDiscontWait #method:setDiscontWait#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignSetDiscontWaitMethodInfo,
#endif
    audioStreamAlignSetDiscontWait          ,


-- ** setRate #method:setRate#

#if defined(ENABLE_OVERLOADING)
    AudioStreamAlignSetRateMethodInfo       ,
#endif
    audioStreamAlignSetRate                 ,




    ) where

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

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


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

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

foreign import ccall "gst_audio_stream_align_get_type" c_gst_audio_stream_align_get_type :: 
    IO GType

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

instance B.Types.TypedObject AudioStreamAlign where
    glibType :: IO GType
glibType = IO GType
c_gst_audio_stream_align_get_type

instance B.Types.GBoxed AudioStreamAlign

-- | Convert 'AudioStreamAlign' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe AudioStreamAlign) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_audio_stream_align_get_type
    gvalueSet_ :: Ptr GValue -> Maybe AudioStreamAlign -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AudioStreamAlign
P.Nothing = Ptr GValue -> Ptr AudioStreamAlign -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr AudioStreamAlign
forall a. Ptr a
FP.nullPtr :: FP.Ptr AudioStreamAlign)
    gvalueSet_ Ptr GValue
gv (P.Just AudioStreamAlign
obj) = AudioStreamAlign -> (Ptr AudioStreamAlign -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AudioStreamAlign
obj (Ptr GValue -> Ptr AudioStreamAlign -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe AudioStreamAlign)
gvalueGet_ Ptr GValue
gv = do
        Ptr AudioStreamAlign
ptr <- Ptr GValue -> IO (Ptr AudioStreamAlign)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr AudioStreamAlign)
        if Ptr AudioStreamAlign
ptr Ptr AudioStreamAlign -> Ptr AudioStreamAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AudioStreamAlign
forall a. Ptr a
FP.nullPtr
        then AudioStreamAlign -> Maybe AudioStreamAlign
forall a. a -> Maybe a
P.Just (AudioStreamAlign -> Maybe AudioStreamAlign)
-> IO AudioStreamAlign -> IO (Maybe AudioStreamAlign)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr AudioStreamAlign -> AudioStreamAlign)
-> Ptr AudioStreamAlign -> IO AudioStreamAlign
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr AudioStreamAlign -> AudioStreamAlign
AudioStreamAlign Ptr AudioStreamAlign
ptr
        else Maybe AudioStreamAlign -> IO (Maybe AudioStreamAlign)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AudioStreamAlign
forall a. Maybe a
P.Nothing
        
    


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

-- method AudioStreamAlign::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "rate"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a sample rate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alignment_threshold"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a alignment threshold in nanoseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "discont_wait"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "discont wait in nanoseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstAudio" , name = "AudioStreamAlign" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_audio_stream_align_new" gst_audio_stream_align_new :: 
    Int32 ->                                -- rate : TBasicType TInt
    Word64 ->                               -- alignment_threshold : TBasicType TUInt64
    Word64 ->                               -- discont_wait : TBasicType TUInt64
    IO (Ptr AudioStreamAlign)

-- | Allocate a new t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign' with the given configuration. All
-- processing happens according to sample rate /@rate@/, until
-- 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignSetRate' is called with a new /@rate@/.
-- A negative rate can be used for reverse playback.
-- 
-- /@alignmentThreshold@/ gives the tolerance in nanoseconds after which a
-- timestamp difference is considered a discontinuity. Once detected,
-- /@discontWait@/ nanoseconds have to pass without going below the threshold
-- again until the output buffer is marked as a discontinuity. These can later
-- be re-configured with 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignSetAlignmentThreshold' and
-- 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignSetDiscontWait'.
-- 
-- /Since: 1.14/
audioStreamAlignNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@rate@/: a sample rate
    -> Word64
    -- ^ /@alignmentThreshold@/: a alignment threshold in nanoseconds
    -> Word64
    -- ^ /@discontWait@/: discont wait in nanoseconds
    -> m AudioStreamAlign
    -- ^ __Returns:__ a new t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'. free with 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignFree'.
audioStreamAlignNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Word64 -> Word64 -> m AudioStreamAlign
audioStreamAlignNew Int32
rate Word64
alignmentThreshold Word64
discontWait = IO AudioStreamAlign -> m AudioStreamAlign
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioStreamAlign -> m AudioStreamAlign)
-> IO AudioStreamAlign -> m AudioStreamAlign
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioStreamAlign
result <- Int32 -> Word64 -> Word64 -> IO (Ptr AudioStreamAlign)
gst_audio_stream_align_new Int32
rate Word64
alignmentThreshold Word64
discontWait
    Text -> Ptr AudioStreamAlign -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioStreamAlignNew" Ptr AudioStreamAlign
result
    AudioStreamAlign
result' <- ((ManagedPtr AudioStreamAlign -> AudioStreamAlign)
-> Ptr AudioStreamAlign -> IO AudioStreamAlign
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AudioStreamAlign -> AudioStreamAlign
AudioStreamAlign) Ptr AudioStreamAlign
result
    AudioStreamAlign -> IO AudioStreamAlign
forall (m :: * -> *) a. Monad m => a -> m a
return AudioStreamAlign
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_audio_stream_align_copy" gst_audio_stream_align_copy :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO (Ptr AudioStreamAlign)

-- | Copy a GstAudioStreamAlign structure.
-- 
-- /Since: 1.14/
audioStreamAlignCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m AudioStreamAlign
    -- ^ __Returns:__ a new t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'. free with gst_audio_stream_align_free.
audioStreamAlignCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m AudioStreamAlign
audioStreamAlignCopy AudioStreamAlign
align = IO AudioStreamAlign -> m AudioStreamAlign
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AudioStreamAlign -> m AudioStreamAlign)
-> IO AudioStreamAlign -> m AudioStreamAlign
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Ptr AudioStreamAlign
result <- Ptr AudioStreamAlign -> IO (Ptr AudioStreamAlign)
gst_audio_stream_align_copy Ptr AudioStreamAlign
align'
    Text -> Ptr AudioStreamAlign -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"audioStreamAlignCopy" Ptr AudioStreamAlign
result
    AudioStreamAlign
result' <- ((ManagedPtr AudioStreamAlign -> AudioStreamAlign)
-> Ptr AudioStreamAlign -> IO AudioStreamAlign
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AudioStreamAlign -> AudioStreamAlign
AudioStreamAlign) Ptr AudioStreamAlign
result
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    AudioStreamAlign -> IO AudioStreamAlign
forall (m :: * -> *) a. Monad m => a -> m a
return AudioStreamAlign
result'

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignCopyMethodInfo
instance (signature ~ (m AudioStreamAlign), MonadIO m) => O.OverloadedMethod AudioStreamAlignCopyMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignCopy

instance O.OverloadedMethodInfo AudioStreamAlignCopyMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignCopy"
        })


#endif

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

-- | Free a GstAudioStreamAlign structure previously allocated with 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignNew'
-- or 'GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignCopy'.
-- 
-- /Since: 1.14/
audioStreamAlignFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m ()
audioStreamAlignFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m ()
audioStreamAlignFree AudioStreamAlign
align = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Ptr AudioStreamAlign -> IO ()
gst_audio_stream_align_free Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod AudioStreamAlignFreeMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignFree

instance O.OverloadedMethodInfo AudioStreamAlignFreeMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignFree"
        })


#endif

-- method AudioStreamAlign::get_alignment_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , 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_stream_align_get_alignment_threshold" gst_audio_stream_align_get_alignment_threshold :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO Word64

-- | Gets the currently configured alignment threshold.
-- 
-- /Since: 1.14/
audioStreamAlignGetAlignmentThreshold ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m Word64
    -- ^ __Returns:__ The currently configured alignment threshold
audioStreamAlignGetAlignmentThreshold :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m Word64
audioStreamAlignGetAlignmentThreshold AudioStreamAlign
align = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Word64
result <- Ptr AudioStreamAlign -> IO Word64
gst_audio_stream_align_get_alignment_threshold Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignGetAlignmentThresholdMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod AudioStreamAlignGetAlignmentThresholdMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignGetAlignmentThreshold

instance O.OverloadedMethodInfo AudioStreamAlignGetAlignmentThresholdMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignGetAlignmentThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignGetAlignmentThreshold"
        })


#endif

-- method AudioStreamAlign::get_discont_wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , 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_stream_align_get_discont_wait" gst_audio_stream_align_get_discont_wait :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO Word64

-- | Gets the currently configured discont wait.
-- 
-- /Since: 1.14/
audioStreamAlignGetDiscontWait ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m Word64
    -- ^ __Returns:__ The currently configured discont wait
audioStreamAlignGetDiscontWait :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m Word64
audioStreamAlignGetDiscontWait AudioStreamAlign
align = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Word64
result <- Ptr AudioStreamAlign -> IO Word64
gst_audio_stream_align_get_discont_wait Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignGetDiscontWaitMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod AudioStreamAlignGetDiscontWaitMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignGetDiscontWait

instance O.OverloadedMethodInfo AudioStreamAlignGetDiscontWaitMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignGetDiscontWait",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignGetDiscontWait"
        })


#endif

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

foreign import ccall "gst_audio_stream_align_get_rate" gst_audio_stream_align_get_rate :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO Int32

-- | Gets the currently configured sample rate.
-- 
-- /Since: 1.14/
audioStreamAlignGetRate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m Int32
    -- ^ __Returns:__ The currently configured sample rate
audioStreamAlignGetRate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m Int32
audioStreamAlignGetRate AudioStreamAlign
align = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Int32
result <- Ptr AudioStreamAlign -> IO Int32
gst_audio_stream_align_get_rate Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignGetRateMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod AudioStreamAlignGetRateMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignGetRate

instance O.OverloadedMethodInfo AudioStreamAlignGetRateMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignGetRate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignGetRate"
        })


#endif

-- method AudioStreamAlign::get_samples_since_discont
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , 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_stream_align_get_samples_since_discont" gst_audio_stream_align_get_samples_since_discont :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO Word64

-- | Returns the number of samples that were processed since the last
-- discontinuity was detected.
-- 
-- /Since: 1.14/
audioStreamAlignGetSamplesSinceDiscont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m Word64
    -- ^ __Returns:__ The number of samples processed since the last discontinuity.
audioStreamAlignGetSamplesSinceDiscont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m Word64
audioStreamAlignGetSamplesSinceDiscont AudioStreamAlign
align = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Word64
result <- Ptr AudioStreamAlign -> IO Word64
gst_audio_stream_align_get_samples_since_discont Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignGetSamplesSinceDiscontMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod AudioStreamAlignGetSamplesSinceDiscontMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignGetSamplesSinceDiscont

instance O.OverloadedMethodInfo AudioStreamAlignGetSamplesSinceDiscontMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignGetSamplesSinceDiscont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignGetSamplesSinceDiscont"
        })


#endif

-- method AudioStreamAlign::get_timestamp_at_discont
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , 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_stream_align_get_timestamp_at_discont" gst_audio_stream_align_get_timestamp_at_discont :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO Word64

-- | Timestamp that was passed when a discontinuity was detected, i.e. the first
-- timestamp after the discontinuity.
-- 
-- /Since: 1.14/
audioStreamAlignGetTimestampAtDiscont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m Word64
    -- ^ __Returns:__ The last timestamp at when a discontinuity was detected
audioStreamAlignGetTimestampAtDiscont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m Word64
audioStreamAlignGetTimestampAtDiscont AudioStreamAlign
align = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Word64
result <- Ptr AudioStreamAlign -> IO Word64
gst_audio_stream_align_get_timestamp_at_discont Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignGetTimestampAtDiscontMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod AudioStreamAlignGetTimestampAtDiscontMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignGetTimestampAtDiscont

instance O.OverloadedMethodInfo AudioStreamAlignGetTimestampAtDiscontMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignGetTimestampAtDiscont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignGetTimestampAtDiscont"
        })


#endif

-- method AudioStreamAlign::mark_discont
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , 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_stream_align_mark_discont" gst_audio_stream_align_mark_discont :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    IO ()

-- | Marks the next buffer as discontinuous and resets timestamp tracking.
-- 
-- /Since: 1.14/
audioStreamAlignMarkDiscont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> m ()
audioStreamAlignMarkDiscont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> m ()
audioStreamAlignMarkDiscont AudioStreamAlign
align = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Ptr AudioStreamAlign -> IO ()
gst_audio_stream_align_mark_discont Ptr AudioStreamAlign
align'
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignMarkDiscontMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod AudioStreamAlignMarkDiscontMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignMarkDiscont

instance O.OverloadedMethodInfo AudioStreamAlignMarkDiscontMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignMarkDiscont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignMarkDiscont"
        })


#endif

-- method AudioStreamAlign::process
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "discont"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if this data is considered to be discontinuous"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClockTime of the start of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_samples"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of samples to process"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output timestamp of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_duration"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "output duration of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_sample_position"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "output sample position of the start of the data"
--                 , 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_stream_align_process" gst_audio_stream_align_process :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    CInt ->                                 -- discont : TBasicType TBoolean
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Word32 ->                               -- n_samples : TBasicType TUInt
    Ptr Word64 ->                           -- out_timestamp : TBasicType TUInt64
    Ptr Word64 ->                           -- out_duration : TBasicType TUInt64
    Ptr Word64 ->                           -- out_sample_position : TBasicType TUInt64
    IO CInt

-- | Processes data with /@timestamp@/ and /@nSamples@/, and returns the output
-- timestamp, duration and sample position together with a boolean to signal
-- whether a discontinuity was detected or not. All non-discontinuous data
-- will have perfect timestamps and durations.
-- 
-- A discontinuity is detected once the difference between the actual
-- timestamp and the timestamp calculated from the sample count since the last
-- discontinuity differs by more than the alignment threshold for a duration
-- longer than discont wait.
-- 
-- Note: In reverse playback, every buffer is considered discontinuous in the
-- context of buffer flags because the last sample of the previous buffer is
-- discontinuous with the first sample of the current one. However for this
-- function they are only considered discontinuous in reverse playback if the
-- first sample of the previous buffer is discontinuous with the last sample
-- of the current one.
-- 
-- /Since: 1.14/
audioStreamAlignProcess ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> Bool
    -- ^ /@discont@/: if this data is considered to be discontinuous
    -> Word64
    -- ^ /@timestamp@/: a @/GstClockTime/@ of the start of the data
    -> Word32
    -- ^ /@nSamples@/: number of samples to process
    -> m ((Bool, Word64, Word64, Word64))
    -- ^ __Returns:__ 'P.True' if a discontinuity was detected, 'P.False' otherwise.
audioStreamAlignProcess :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign
-> Bool -> Word64 -> Word32 -> m (Bool, Word64, Word64, Word64)
audioStreamAlignProcess AudioStreamAlign
align Bool
discont Word64
timestamp Word32
nSamples = IO (Bool, Word64, Word64, Word64)
-> m (Bool, Word64, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64, Word64, Word64)
 -> m (Bool, Word64, Word64, Word64))
-> IO (Bool, Word64, Word64, Word64)
-> m (Bool, Word64, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    let discont' :: CInt
discont' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
discont
    Ptr Word64
outTimestamp <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
outDuration <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
outSamplePosition <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr AudioStreamAlign
-> CInt
-> Word64
-> Word32
-> Ptr Word64
-> Ptr Word64
-> Ptr Word64
-> IO CInt
gst_audio_stream_align_process Ptr AudioStreamAlign
align' CInt
discont' Word64
timestamp Word32
nSamples Ptr Word64
outTimestamp Ptr Word64
outDuration Ptr Word64
outSamplePosition
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word64
outTimestamp' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outTimestamp
    Word64
outDuration' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outDuration
    Word64
outSamplePosition' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outSamplePosition
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outTimestamp
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outDuration
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outSamplePosition
    (Bool, Word64, Word64, Word64) -> IO (Bool, Word64, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word64
outTimestamp', Word64
outDuration', Word64
outSamplePosition')

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignProcessMethodInfo
instance (signature ~ (Bool -> Word64 -> Word32 -> m ((Bool, Word64, Word64, Word64))), MonadIO m) => O.OverloadedMethod AudioStreamAlignProcessMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignProcess

instance O.OverloadedMethodInfo AudioStreamAlignProcessMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignProcess",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignProcess"
        })


#endif

-- method AudioStreamAlign::set_alignment_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alignment_threshold"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new alignment threshold"
--                 , 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_stream_align_set_alignment_threshold" gst_audio_stream_align_set_alignment_threshold :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    Word64 ->                               -- alignment_threshold : TBasicType TUInt64
    IO ()

-- | Sets /@alignmentTreshold@/ as new alignment threshold for the following processing.
-- 
-- /Since: 1.14/
audioStreamAlignSetAlignmentThreshold ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> Word64
    -- ^ /@alignmentThreshold@/: a new alignment threshold
    -> m ()
audioStreamAlignSetAlignmentThreshold :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> Word64 -> m ()
audioStreamAlignSetAlignmentThreshold AudioStreamAlign
align Word64
alignmentThreshold = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Ptr AudioStreamAlign -> Word64 -> IO ()
gst_audio_stream_align_set_alignment_threshold Ptr AudioStreamAlign
align' Word64
alignmentThreshold
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignSetAlignmentThresholdMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.OverloadedMethod AudioStreamAlignSetAlignmentThresholdMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignSetAlignmentThreshold

instance O.OverloadedMethodInfo AudioStreamAlignSetAlignmentThresholdMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignSetAlignmentThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignSetAlignmentThreshold"
        })


#endif

-- method AudioStreamAlign::set_discont_wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "discont_wait"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new discont wait" , 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_stream_align_set_discont_wait" gst_audio_stream_align_set_discont_wait :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    Word64 ->                               -- discont_wait : TBasicType TUInt64
    IO ()

-- | Sets /@alignmentTreshold@/ as new discont wait for the following processing.
-- 
-- /Since: 1.14/
audioStreamAlignSetDiscontWait ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> Word64
    -- ^ /@discontWait@/: a new discont wait
    -> m ()
audioStreamAlignSetDiscontWait :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> Word64 -> m ()
audioStreamAlignSetDiscontWait AudioStreamAlign
align Word64
discontWait = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Ptr AudioStreamAlign -> Word64 -> IO ()
gst_audio_stream_align_set_discont_wait Ptr AudioStreamAlign
align' Word64
discontWait
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignSetDiscontWaitMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.OverloadedMethod AudioStreamAlignSetDiscontWaitMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignSetDiscontWait

instance O.OverloadedMethodInfo AudioStreamAlignSetDiscontWaitMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignSetDiscontWait",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignSetDiscontWait"
        })


#endif

-- method AudioStreamAlign::set_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "align"
--           , argType =
--               TInterface
--                 Name { namespace = "GstAudio" , name = "AudioStreamAlign" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstAudioStreamAlign"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new sample rate" , 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_stream_align_set_rate" gst_audio_stream_align_set_rate :: 
    Ptr AudioStreamAlign ->                 -- align : TInterface (Name {namespace = "GstAudio", name = "AudioStreamAlign"})
    Int32 ->                                -- rate : TBasicType TInt
    IO ()

-- | Sets /@rate@/ as new sample rate for the following processing. If the sample
-- rate differs this implicitly marks the next data as discontinuous.
-- 
-- /Since: 1.14/
audioStreamAlignSetRate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AudioStreamAlign
    -- ^ /@align@/: a t'GI.GstAudio.Structs.AudioStreamAlign.AudioStreamAlign'
    -> Int32
    -- ^ /@rate@/: a new sample rate
    -> m ()
audioStreamAlignSetRate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
AudioStreamAlign -> Int32 -> m ()
audioStreamAlignSetRate AudioStreamAlign
align Int32
rate = 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 AudioStreamAlign
align' <- AudioStreamAlign -> IO (Ptr AudioStreamAlign)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AudioStreamAlign
align
    Ptr AudioStreamAlign -> Int32 -> IO ()
gst_audio_stream_align_set_rate Ptr AudioStreamAlign
align' Int32
rate
    AudioStreamAlign -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AudioStreamAlign
align
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AudioStreamAlignSetRateMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod AudioStreamAlignSetRateMethodInfo AudioStreamAlign signature where
    overloadedMethod = audioStreamAlignSetRate

instance O.OverloadedMethodInfo AudioStreamAlignSetRateMethodInfo AudioStreamAlign where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstAudio.Structs.AudioStreamAlign.audioStreamAlignSetRate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstaudio-1.0.24/docs/GI-GstAudio-Structs-AudioStreamAlign.html#v:audioStreamAlignSetRate"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAudioStreamAlignMethod (t :: Symbol) (o :: *) :: * where
    ResolveAudioStreamAlignMethod "copy" o = AudioStreamAlignCopyMethodInfo
    ResolveAudioStreamAlignMethod "free" o = AudioStreamAlignFreeMethodInfo
    ResolveAudioStreamAlignMethod "markDiscont" o = AudioStreamAlignMarkDiscontMethodInfo
    ResolveAudioStreamAlignMethod "process" o = AudioStreamAlignProcessMethodInfo
    ResolveAudioStreamAlignMethod "getAlignmentThreshold" o = AudioStreamAlignGetAlignmentThresholdMethodInfo
    ResolveAudioStreamAlignMethod "getDiscontWait" o = AudioStreamAlignGetDiscontWaitMethodInfo
    ResolveAudioStreamAlignMethod "getRate" o = AudioStreamAlignGetRateMethodInfo
    ResolveAudioStreamAlignMethod "getSamplesSinceDiscont" o = AudioStreamAlignGetSamplesSinceDiscontMethodInfo
    ResolveAudioStreamAlignMethod "getTimestampAtDiscont" o = AudioStreamAlignGetTimestampAtDiscontMethodInfo
    ResolveAudioStreamAlignMethod "setAlignmentThreshold" o = AudioStreamAlignSetAlignmentThresholdMethodInfo
    ResolveAudioStreamAlignMethod "setDiscontWait" o = AudioStreamAlignSetDiscontWaitMethodInfo
    ResolveAudioStreamAlignMethod "setRate" o = AudioStreamAlignSetRateMethodInfo
    ResolveAudioStreamAlignMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif