{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)

The event class provides factory methods to construct events for sending
and functions to query (parse) received events.

Events are usually created with gst_event_new_*() which takes event-type
specific parameters as arguments.
To send an event application will usually use 'GI.Gst.Objects.Element.elementSendEvent' and
elements will use 'GI.Gst.Objects.Pad.padSendEvent' or 'GI.Gst.Objects.Pad.padPushEvent'.
The event should be unreffed with @/gst_event_unref()/@ if it has not been sent.

Events that have been received can be parsed with their respective
gst_event_parse_*() functions. It is valid to pass 'Nothing' for unwanted details.

Events are passed between elements in parallel to the data stream. Some events
are serialized with buffers, others are not. Some events only travel downstream,
others only upstream. Some events can travel both upstream and downstream.

The events are used to signal special conditions in the datastream such as
EOS (end of stream) or the start of a new stream-segment.
Events are also used to flush the pipeline of any pending data.

Most of the event API is used inside plugins. Applications usually only
construct and use seek events.
To do that 'GI.Gst.Structs.Event.eventNewSeek' is used to create a seek event. It takes
the needed parameters to specify seeking time and mode.

=== /C code/
>
>  GstEvent *event;
>  gboolean result;
>  ...
>  // construct a seek event to play the media from second 2 to 5, flush
>  // the pipeline to decrease latency.
>  event = gst_event_new_seek (1.0,
>     GST_FORMAT_TIME,
>     GST_SEEK_FLAG_FLUSH,
>     GST_SEEK_TYPE_SET, 2 * GST_SECOND,
>     GST_SEEK_TYPE_SET, 5 * GST_SECOND);
>  ...
>  result = gst_element_send_event (pipeline, event);
>  if (!result)
>    g_warning ("seek failed");
>  ...

-}

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

module GI.Gst.Structs.Event
    (

-- * Exported types
    Event(..)                               ,
    newZeroEvent                            ,
    noEvent                                 ,


 -- * Methods
-- ** copySegment #method:copySegment#

#if ENABLE_OVERLOADING
    EventCopySegmentMethodInfo              ,
#endif
    eventCopySegment                        ,


-- ** getRunningTimeOffset #method:getRunningTimeOffset#

#if ENABLE_OVERLOADING
    EventGetRunningTimeOffsetMethodInfo     ,
#endif
    eventGetRunningTimeOffset               ,


-- ** getSeqnum #method:getSeqnum#

#if ENABLE_OVERLOADING
    EventGetSeqnumMethodInfo                ,
#endif
    eventGetSeqnum                          ,


-- ** getStructure #method:getStructure#

#if ENABLE_OVERLOADING
    EventGetStructureMethodInfo             ,
#endif
    eventGetStructure                       ,


-- ** hasName #method:hasName#

#if ENABLE_OVERLOADING
    EventHasNameMethodInfo                  ,
#endif
    eventHasName                            ,


-- ** newBufferSize #method:newBufferSize#

    eventNewBufferSize                      ,


-- ** newCaps #method:newCaps#

    eventNewCaps                            ,


-- ** newCustom #method:newCustom#

    eventNewCustom                          ,


-- ** newEos #method:newEos#

    eventNewEos                             ,


-- ** newFlushStart #method:newFlushStart#

    eventNewFlushStart                      ,


-- ** newFlushStop #method:newFlushStop#

    eventNewFlushStop                       ,


-- ** newGap #method:newGap#

    eventNewGap                             ,


-- ** newLatency #method:newLatency#

    eventNewLatency                         ,


-- ** newNavigation #method:newNavigation#

    eventNewNavigation                      ,


-- ** newProtection #method:newProtection#

    eventNewProtection                      ,


-- ** newQos #method:newQos#

    eventNewQos                             ,


-- ** newReconfigure #method:newReconfigure#

    eventNewReconfigure                     ,


-- ** newSeek #method:newSeek#

    eventNewSeek                            ,


-- ** newSegment #method:newSegment#

    eventNewSegment                         ,


-- ** newSegmentDone #method:newSegmentDone#

    eventNewSegmentDone                     ,


-- ** newSelectStreams #method:newSelectStreams#

    eventNewSelectStreams                   ,


-- ** newSinkMessage #method:newSinkMessage#

    eventNewSinkMessage                     ,


-- ** newStep #method:newStep#

    eventNewStep                            ,


-- ** newStreamCollection #method:newStreamCollection#

    eventNewStreamCollection                ,


-- ** newStreamGroupDone #method:newStreamGroupDone#

    eventNewStreamGroupDone                 ,


-- ** newStreamStart #method:newStreamStart#

    eventNewStreamStart                     ,


-- ** newTag #method:newTag#

    eventNewTag                             ,


-- ** newToc #method:newToc#

    eventNewToc                             ,


-- ** newTocSelect #method:newTocSelect#

    eventNewTocSelect                       ,


-- ** parseBufferSize #method:parseBufferSize#

#if ENABLE_OVERLOADING
    EventParseBufferSizeMethodInfo          ,
#endif
    eventParseBufferSize                    ,


-- ** parseCaps #method:parseCaps#

#if ENABLE_OVERLOADING
    EventParseCapsMethodInfo                ,
#endif
    eventParseCaps                          ,


-- ** parseFlushStop #method:parseFlushStop#

#if ENABLE_OVERLOADING
    EventParseFlushStopMethodInfo           ,
#endif
    eventParseFlushStop                     ,


-- ** parseGap #method:parseGap#

#if ENABLE_OVERLOADING
    EventParseGapMethodInfo                 ,
#endif
    eventParseGap                           ,


-- ** parseGroupId #method:parseGroupId#

#if ENABLE_OVERLOADING
    EventParseGroupIdMethodInfo             ,
#endif
    eventParseGroupId                       ,


-- ** parseLatency #method:parseLatency#

#if ENABLE_OVERLOADING
    EventParseLatencyMethodInfo             ,
#endif
    eventParseLatency                       ,


-- ** parseProtection #method:parseProtection#

#if ENABLE_OVERLOADING
    EventParseProtectionMethodInfo          ,
#endif
    eventParseProtection                    ,


-- ** parseQos #method:parseQos#

#if ENABLE_OVERLOADING
    EventParseQosMethodInfo                 ,
#endif
    eventParseQos                           ,


-- ** parseSeek #method:parseSeek#

#if ENABLE_OVERLOADING
    EventParseSeekMethodInfo                ,
#endif
    eventParseSeek                          ,


-- ** parseSeekTrickmodeInterval #method:parseSeekTrickmodeInterval#

#if ENABLE_OVERLOADING
    EventParseSeekTrickmodeIntervalMethodInfo,
#endif
    eventParseSeekTrickmodeInterval         ,


-- ** parseSegment #method:parseSegment#

#if ENABLE_OVERLOADING
    EventParseSegmentMethodInfo             ,
#endif
    eventParseSegment                       ,


-- ** parseSegmentDone #method:parseSegmentDone#

#if ENABLE_OVERLOADING
    EventParseSegmentDoneMethodInfo         ,
#endif
    eventParseSegmentDone                   ,


-- ** parseSelectStreams #method:parseSelectStreams#

#if ENABLE_OVERLOADING
    EventParseSelectStreamsMethodInfo       ,
#endif
    eventParseSelectStreams                 ,


-- ** parseSinkMessage #method:parseSinkMessage#

#if ENABLE_OVERLOADING
    EventParseSinkMessageMethodInfo         ,
#endif
    eventParseSinkMessage                   ,


-- ** parseStep #method:parseStep#

#if ENABLE_OVERLOADING
    EventParseStepMethodInfo                ,
#endif
    eventParseStep                          ,


-- ** parseStream #method:parseStream#

#if ENABLE_OVERLOADING
    EventParseStreamMethodInfo              ,
#endif
    eventParseStream                        ,


-- ** parseStreamCollection #method:parseStreamCollection#

#if ENABLE_OVERLOADING
    EventParseStreamCollectionMethodInfo    ,
#endif
    eventParseStreamCollection              ,


-- ** parseStreamFlags #method:parseStreamFlags#

#if ENABLE_OVERLOADING
    EventParseStreamFlagsMethodInfo         ,
#endif
    eventParseStreamFlags                   ,


-- ** parseStreamGroupDone #method:parseStreamGroupDone#

#if ENABLE_OVERLOADING
    EventParseStreamGroupDoneMethodInfo     ,
#endif
    eventParseStreamGroupDone               ,


-- ** parseStreamStart #method:parseStreamStart#

#if ENABLE_OVERLOADING
    EventParseStreamStartMethodInfo         ,
#endif
    eventParseStreamStart                   ,


-- ** parseTag #method:parseTag#

#if ENABLE_OVERLOADING
    EventParseTagMethodInfo                 ,
#endif
    eventParseTag                           ,


-- ** parseToc #method:parseToc#

#if ENABLE_OVERLOADING
    EventParseTocMethodInfo                 ,
#endif
    eventParseToc                           ,


-- ** parseTocSelect #method:parseTocSelect#

#if ENABLE_OVERLOADING
    EventParseTocSelectMethodInfo           ,
#endif
    eventParseTocSelect                     ,


-- ** setGroupId #method:setGroupId#

#if ENABLE_OVERLOADING
    EventSetGroupIdMethodInfo               ,
#endif
    eventSetGroupId                         ,


-- ** setRunningTimeOffset #method:setRunningTimeOffset#

#if ENABLE_OVERLOADING
    EventSetRunningTimeOffsetMethodInfo     ,
#endif
    eventSetRunningTimeOffset               ,


-- ** setSeekTrickmodeInterval #method:setSeekTrickmodeInterval#

#if ENABLE_OVERLOADING
    EventSetSeekTrickmodeIntervalMethodInfo ,
#endif
    eventSetSeekTrickmodeInterval           ,


-- ** setSeqnum #method:setSeqnum#

#if ENABLE_OVERLOADING
    EventSetSeqnumMethodInfo                ,
#endif
    eventSetSeqnum                          ,


-- ** setStream #method:setStream#

#if ENABLE_OVERLOADING
    EventSetStreamMethodInfo                ,
#endif
    eventSetStream                          ,


-- ** setStreamFlags #method:setStreamFlags#

#if ENABLE_OVERLOADING
    EventSetStreamFlagsMethodInfo           ,
#endif
    eventSetStreamFlags                     ,


-- ** writableStructure #method:writableStructure#

#if ENABLE_OVERLOADING
    EventWritableStructureMethodInfo        ,
#endif
    eventWritableStructure                  ,




 -- * Properties
-- ** miniObject #attr:miniObject#
{- | the parent structure
-}
#if ENABLE_OVERLOADING
    event_miniObject                        ,
#endif
    getEventMiniObject                      ,


-- ** seqnum #attr:seqnum#
{- | the sequence number of the event
-}
#if ENABLE_OVERLOADING
    event_seqnum                            ,
#endif
    getEventSeqnum                          ,
    setEventSeqnum                          ,


-- ** timestamp #attr:timestamp#
{- | the timestamp of the event
-}
#if ENABLE_OVERLOADING
    event_timestamp                         ,
#endif
    getEventTimestamp                       ,
    setEventTimestamp                       ,


-- ** type #attr:type#
{- | the 'GI.Gst.Enums.EventType' of the event
-}
#if ENABLE_OVERLOADING
    event_type                              ,
#endif
    getEventType                            ,
    setEventType                            ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Stream as Gst.Stream
import {-# SOURCE #-} qualified GI.Gst.Objects.StreamCollection as Gst.StreamCollection
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.Message as Gst.Message
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
import {-# SOURCE #-} qualified GI.Gst.Structs.Segment as Gst.Segment
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure
import {-# SOURCE #-} qualified GI.Gst.Structs.TagList as Gst.TagList
import {-# SOURCE #-} qualified GI.Gst.Structs.Toc as Gst.Toc

-- | Memory-managed wrapper type.
newtype Event = Event (ManagedPtr Event)
foreign import ccall "gst_event_get_type" c_gst_event_get_type ::
    IO GType

instance BoxedObject Event where
    boxedType _ = c_gst_event_get_type

-- | Construct a `Event` struct initialized to zero.
newZeroEvent :: MonadIO m => m Event
newZeroEvent = liftIO $ callocBoxedBytes 88 >>= wrapBoxed Event

instance tag ~ 'AttrSet => Constructible Event tag where
    new _ attrs = do
        o <- newZeroEvent
        GI.Attributes.set o attrs
        return o


-- | A convenience alias for `Nothing` :: `Maybe` `Event`.
noEvent :: Maybe Event
noEvent = Nothing

{- |
Get the value of the “@mini_object@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' event #miniObject
@
-}
getEventMiniObject :: MonadIO m => Event -> m Gst.MiniObject.MiniObject
getEventMiniObject s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Gst.MiniObject.MiniObject)
    val' <- (newPtr Gst.MiniObject.MiniObject) val
    return val'

#if ENABLE_OVERLOADING
data EventMiniObjectFieldInfo
instance AttrInfo EventMiniObjectFieldInfo where
    type AttrAllowedOps EventMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint EventMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrBaseTypeConstraint EventMiniObjectFieldInfo = (~) Event
    type AttrGetType EventMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel EventMiniObjectFieldInfo = "mini_object"
    type AttrOrigin EventMiniObjectFieldInfo = Event
    attrGet _ = getEventMiniObject
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

event_miniObject :: AttrLabelProxy "miniObject"
event_miniObject = AttrLabelProxy

#endif


{- |
Get the value of the “@type@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' event #type
@
-}
getEventType :: MonadIO m => Event -> m Gst.Enums.EventType
getEventType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

{- |
Set the value of the “@type@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' event [ #type 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventType :: MonadIO m => Event -> Gst.Enums.EventType -> m ()
setEventType s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 64) (val' :: CUInt)

#if ENABLE_OVERLOADING
data EventTypeFieldInfo
instance AttrInfo EventTypeFieldInfo where
    type AttrAllowedOps EventTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventTypeFieldInfo = (~) Gst.Enums.EventType
    type AttrBaseTypeConstraint EventTypeFieldInfo = (~) Event
    type AttrGetType EventTypeFieldInfo = Gst.Enums.EventType
    type AttrLabel EventTypeFieldInfo = "type"
    type AttrOrigin EventTypeFieldInfo = Event
    attrGet _ = getEventType
    attrSet _ = setEventType
    attrConstruct = undefined
    attrClear _ = undefined

event_type :: AttrLabelProxy "type"
event_type = AttrLabelProxy

#endif


{- |
Get the value of the “@timestamp@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' event #timestamp
@
-}
getEventTimestamp :: MonadIO m => Event -> m Word64
getEventTimestamp s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 72) :: IO Word64
    return val

{- |
Set the value of the “@timestamp@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' event [ #timestamp 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventTimestamp :: MonadIO m => Event -> Word64 -> m ()
setEventTimestamp s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 72) (val :: Word64)

#if ENABLE_OVERLOADING
data EventTimestampFieldInfo
instance AttrInfo EventTimestampFieldInfo where
    type AttrAllowedOps EventTimestampFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventTimestampFieldInfo = (~) Word64
    type AttrBaseTypeConstraint EventTimestampFieldInfo = (~) Event
    type AttrGetType EventTimestampFieldInfo = Word64
    type AttrLabel EventTimestampFieldInfo = "timestamp"
    type AttrOrigin EventTimestampFieldInfo = Event
    attrGet _ = getEventTimestamp
    attrSet _ = setEventTimestamp
    attrConstruct = undefined
    attrClear _ = undefined

event_timestamp :: AttrLabelProxy "timestamp"
event_timestamp = AttrLabelProxy

#endif


{- |
Get the value of the “@seqnum@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' event #seqnum
@
-}
getEventSeqnum :: MonadIO m => Event -> m Word32
getEventSeqnum s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 80) :: IO Word32
    return val

{- |
Set the value of the “@seqnum@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' event [ #seqnum 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventSeqnum :: MonadIO m => Event -> Word32 -> m ()
setEventSeqnum s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 80) (val :: Word32)

#if ENABLE_OVERLOADING
data EventSeqnumFieldInfo
instance AttrInfo EventSeqnumFieldInfo where
    type AttrAllowedOps EventSeqnumFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventSeqnumFieldInfo = (~) Word32
    type AttrBaseTypeConstraint EventSeqnumFieldInfo = (~) Event
    type AttrGetType EventSeqnumFieldInfo = Word32
    type AttrLabel EventSeqnumFieldInfo = "seqnum"
    type AttrOrigin EventSeqnumFieldInfo = Event
    attrGet _ = getEventSeqnum
    attrSet _ = setEventSeqnum
    attrConstruct = undefined
    attrClear _ = undefined

event_seqnum :: AttrLabelProxy "seqnum"
event_seqnum = AttrLabelProxy

#endif



#if ENABLE_OVERLOADING
instance O.HasAttributeList Event
type instance O.AttributeList Event = EventAttributeList
type EventAttributeList = ('[ '("miniObject", EventMiniObjectFieldInfo), '("type", EventTypeFieldInfo), '("timestamp", EventTimestampFieldInfo), '("seqnum", EventSeqnumFieldInfo)] :: [(Symbol, *)])
#endif

-- method Event::new_buffer_size
-- method type : Constructor
-- Args : [Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "buffer format", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "minsize", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "minimum buffer size", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "maxsize", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "maximum buffer size", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "async", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "thread behavior", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_buffer_size" gst_event_new_buffer_size ::
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- minsize : TBasicType TInt64
    Int64 ->                                -- maxsize : TBasicType TInt64
    CInt ->                                 -- async : TBasicType TBoolean
    IO (Ptr Event)

{- |
Create a new buffersize event. The event is sent downstream and notifies
elements that they should provide a buffer of the specified dimensions.

When the /@async@/ flag is set, a thread boundary is preferred.
-}
eventNewBufferSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    {- ^ /@format@/: buffer format -}
    -> Int64
    {- ^ /@minsize@/: minimum buffer size -}
    -> Int64
    {- ^ /@maxsize@/: maximum buffer size -}
    -> Bool
    {- ^ /@async@/: thread behavior -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewBufferSize format minsize maxsize async = liftIO $ do
    let format' = (fromIntegral . fromEnum) format
    let async' = (fromIntegral . fromEnum) async
    result <- gst_event_new_buffer_size format' minsize maxsize async'
    checkUnexpectedReturnNULL "eventNewBufferSize" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_caps
-- method type : Constructor
-- Args : [Arg {argCName = "caps", argType = TInterface (Name {namespace = "Gst", name = "Caps"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstCaps", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_caps" gst_event_new_caps ::
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO (Ptr Event)

{- |
Create a new CAPS event for /@caps@/. The caps event can only travel downstream
synchronized with the buffer flow and contains the format of the buffers
that will follow after the event.
-}
eventNewCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Caps.Caps
    {- ^ /@caps@/: a 'GI.Gst.Structs.Caps.Caps' -}
    -> m (Maybe Event)
    {- ^ __Returns:__ the new CAPS event. -}
eventNewCaps caps = liftIO $ do
    caps' <- unsafeManagedPtrGetPtr caps
    result <- gst_event_new_caps caps'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Event) result'
        return result''
    touchManagedPtr caps
    return maybeResult

#if ENABLE_OVERLOADING
#endif

-- method Event::new_custom
-- method type : Constructor
-- Args : [Arg {argCName = "type", argType = TInterface (Name {namespace = "Gst", name = "EventType"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The type of the new event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "structure", argType = TInterface (Name {namespace = "Gst", name = "Structure"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the structure for the event. The event will\n    take ownership of the structure.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_custom" gst_event_new_custom ::
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "EventType"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Event)

{- |
Create a new custom-typed event. This can be used for anything not
handled by other event-specific functions to pass an event to another
element.

Make sure to allocate an event type with the @/GST_EVENT_MAKE_TYPE/@ macro,
assigning a free number and filling in the correct direction and
serialization flags.

New custom events can also be created by subclassing the event type if
needed.
-}
eventNewCustom ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.EventType
    {- ^ /@type@/: The type of the new event -}
    -> Gst.Structure.Structure
    {- ^ /@structure@/: the structure for the event. The event will
    take ownership of the structure. -}
    -> m (Maybe Event)
    {- ^ __Returns:__ the new custom event. -}
eventNewCustom type_ structure = liftIO $ do
    let type_' = (fromIntegral . fromEnum) type_
    structure' <- B.ManagedPtr.disownBoxed structure
    result <- gst_event_new_custom type_' structure'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Event) result'
        return result''
    touchManagedPtr structure
    return maybeResult

#if ENABLE_OVERLOADING
#endif

-- method Event::new_eos
-- method type : Constructor
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_eos" gst_event_new_eos ::
    IO (Ptr Event)

{- |
Create a new EOS event. The eos event can only travel downstream
synchronized with the buffer flow. Elements that receive the EOS
event on a pad can return @/GST_FLOW_EOS/@ as a 'GI.Gst.Enums.FlowReturn'
when data after the EOS event arrives.

The EOS event will travel down to the sink elements in the pipeline
which will then post the @/GST_MESSAGE_EOS/@ on the bus after they have
finished playing any buffered data.

When all sinks have posted an EOS message, an EOS message is
forwarded to the application.

The EOS event itself will not cause any state transitions of the pipeline.
-}
eventNewEos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Event
    {- ^ __Returns:__ the new EOS event. -}
eventNewEos  = liftIO $ do
    result <- gst_event_new_eos
    checkUnexpectedReturnNULL "eventNewEos" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_flush_start
-- method type : Constructor
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_flush_start" gst_event_new_flush_start ::
    IO (Ptr Event)

{- |
Allocate a new flush start event. The flush start event can be sent
upstream and downstream and travels out-of-bounds with the dataflow.

It marks pads as being flushing and will make them return
@/GST_FLOW_FLUSHING/@ when used for data flow with 'GI.Gst.Objects.Pad.padPush',
'GI.Gst.Objects.Pad.padChain', 'GI.Gst.Objects.Pad.padGetRange' and 'GI.Gst.Objects.Pad.padPullRange'.
Any event (except a @/GST_EVENT_FLUSH_STOP/@) received
on a flushing pad will return 'False' immediately.

Elements should unlock any blocking functions and exit their streaming
functions as fast as possible when this event is received.

This event is typically generated after a seek to flush out all queued data
in the pipeline so that the new media is played as soon as possible.
-}
eventNewFlushStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Event
    {- ^ __Returns:__ a new flush start event. -}
eventNewFlushStart  = liftIO $ do
    result <- gst_event_new_flush_start
    checkUnexpectedReturnNULL "eventNewFlushStart" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_flush_stop
-- method type : Constructor
-- Args : [Arg {argCName = "reset_time", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "if time should be reset", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_flush_stop" gst_event_new_flush_stop ::
    CInt ->                                 -- reset_time : TBasicType TBoolean
    IO (Ptr Event)

{- |
Allocate a new flush stop event. The flush stop event can be sent
upstream and downstream and travels serialized with the dataflow.
It is typically sent after sending a FLUSH_START event to make the
pads accept data again.

Elements can process this event synchronized with the dataflow since
the preceding FLUSH_START event stopped the dataflow.

This event is typically generated to complete a seek and to resume
dataflow.
-}
eventNewFlushStop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Bool
    {- ^ /@resetTime@/: if time should be reset -}
    -> m Event
    {- ^ __Returns:__ a new flush stop event. -}
eventNewFlushStop resetTime = liftIO $ do
    let resetTime' = (fromIntegral . fromEnum) resetTime
    result <- gst_event_new_flush_stop resetTime'
    checkUnexpectedReturnNULL "eventNewFlushStop" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_gap
-- method type : Constructor
-- Args : [Arg {argCName = "timestamp", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the start time (pts) of the gap", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "duration", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the duration of the gap", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_gap" gst_event_new_gap ::
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Word64 ->                               -- duration : TBasicType TUInt64
    IO (Ptr Event)

{- |
Create a new GAP event. A gap event can be thought of as conceptually
equivalent to a buffer to signal that there is no data for a certain
amount of time. This is useful to signal a gap to downstream elements
which may wait for data, such as muxers or mixers or overlays, especially
for sparse streams such as subtitle streams.
-}
eventNewGap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word64
    {- ^ /@timestamp@/: the start time (pts) of the gap -}
    -> Word64
    {- ^ /@duration@/: the duration of the gap -}
    -> m Event
    {- ^ __Returns:__ the new GAP event. -}
eventNewGap timestamp duration = liftIO $ do
    result <- gst_event_new_gap timestamp duration
    checkUnexpectedReturnNULL "eventNewGap" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_latency
-- method type : Constructor
-- Args : [Arg {argCName = "latency", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the new latency value", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_latency" gst_event_new_latency ::
    Word64 ->                               -- latency : TBasicType TUInt64
    IO (Ptr Event)

{- |
Create a new latency event. The event is sent upstream from the sinks and
notifies elements that they should add an additional /@latency@/ to the
running time before synchronising against the clock.

The latency is mostly used in live sinks and is always expressed in
the time format.
-}
eventNewLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word64
    {- ^ /@latency@/: the new latency value -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewLatency latency = liftIO $ do
    result <- gst_event_new_latency latency
    checkUnexpectedReturnNULL "eventNewLatency" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_navigation
-- method type : Constructor
-- Args : [Arg {argCName = "structure", argType = TInterface (Name {namespace = "Gst", name = "Structure"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "description of the event. The event will take\n    ownership of the structure.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_navigation" gst_event_new_navigation ::
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Event)

{- |
Create a new navigation event from the given description.
-}
eventNewNavigation ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Structure.Structure
    {- ^ /@structure@/: description of the event. The event will take
    ownership of the structure. -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewNavigation structure = liftIO $ do
    structure' <- B.ManagedPtr.disownBoxed structure
    result <- gst_event_new_navigation structure'
    checkUnexpectedReturnNULL "eventNewNavigation" result
    result' <- (wrapBoxed Event) result
    touchManagedPtr structure
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_protection
-- method type : Constructor
-- Args : [Arg {argCName = "system_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a string holding a UUID that uniquely\nidentifies a protection system.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TInterface (Name {namespace = "Gst", name = "Buffer"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBuffer holding protection system specific\ninformation. The reference count of the buffer will be incremented by one.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "origin", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a string indicating where the protection\ninformation carried in the event was extracted from. The allowed values\nof this string will depend upon the protection scheme.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_protection" gst_event_new_protection ::
    CString ->                              -- system_id : TBasicType TUTF8
    Ptr Gst.Buffer.Buffer ->                -- data : TInterface (Name {namespace = "Gst", name = "Buffer"})
    CString ->                              -- origin : TBasicType TUTF8
    IO (Ptr Event)

{- |
Creates a new event containing information specific to a particular
protection system (uniquely identified by /@systemId@/), by which that
protection system can acquire key(s) to decrypt a protected stream.

In order for a decryption element to decrypt media
protected using a specific system, it first needs all the
protection system specific information necessary to acquire the decryption
key(s) for that stream. The functions defined here enable this information
to be passed in events from elements that extract it
(e.g., ISOBMFF demuxers, MPEG DASH demuxers) to protection decrypter
elements that use it.

Events containing protection system specific information are created using
@/gst_event_new_protection/@, and they can be parsed by downstream elements
using @/gst_event_parse_protection/@.

In Common Encryption, protection system specific information may be located
within ISOBMFF files, both in movie (moov) boxes and movie fragment (moof)
boxes; it may also be contained in ContentProtection elements within MPEG
DASH MPDs. The events created by @/gst_event_new_protection/@ contain data
identifying from which of these locations the encapsulated protection system
specific information originated. This origin information is required as
some protection systems use different encodings depending upon where the
information originates.

The events returned by 'GI.Gst.Structs.Event.eventNewProtection' are implemented
in such a way as to ensure that the most recently-pushed protection info
event of a particular /@origin@/ and /@systemId@/ will
be stuck to the output pad of the sending element.

/Since: 1.6/
-}
eventNewProtection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@systemId@/: a string holding a UUID that uniquely
identifies a protection system. -}
    -> Gst.Buffer.Buffer
    {- ^ /@data@/: a 'GI.Gst.Structs.Buffer.Buffer' holding protection system specific
information. The reference count of the buffer will be incremented by one. -}
    -> T.Text
    {- ^ /@origin@/: a string indicating where the protection
information carried in the event was extracted from. The allowed values
of this string will depend upon the protection scheme. -}
    -> m Event
    {- ^ __Returns:__ a @/GST_EVENT_PROTECTION/@ event, if successful; 'Nothing'
if unsuccessful. -}
eventNewProtection systemId data_ origin = liftIO $ do
    systemId' <- textToCString systemId
    data_' <- unsafeManagedPtrGetPtr data_
    origin' <- textToCString origin
    result <- gst_event_new_protection systemId' data_' origin'
    checkUnexpectedReturnNULL "eventNewProtection" result
    result' <- (wrapBoxed Event) result
    touchManagedPtr data_
    freeMem systemId'
    freeMem origin'
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_qos
-- method type : Constructor
-- Args : [Arg {argCName = "type", argType = TInterface (Name {namespace = "Gst", name = "QOSType"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the QoS type", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "proportion", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the proportion of the qos message", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "diff", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The time difference of the last Clock sync", 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 "The timestamp of the buffer", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_qos" gst_event_new_qos ::
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "QOSType"})
    CDouble ->                              -- proportion : TBasicType TDouble
    Int64 ->                                -- diff : TBasicType TInt64
    Word64 ->                               -- timestamp : TBasicType TUInt64
    IO (Ptr Event)

{- |
Allocate a new qos event with the given values.
The QOS event is generated in an element that wants an upstream
element to either reduce or increase its rate because of
high\/low CPU load or other resource usage such as network performance or
throttling. Typically sinks generate these events for each buffer
they receive.

/@type@/ indicates the reason for the QoS event. @/GST_QOS_TYPE_OVERFLOW/@ is
used when a buffer arrived in time or when the sink cannot keep up with
the upstream datarate. @/GST_QOS_TYPE_UNDERFLOW/@ is when the sink is not
receiving buffers fast enough and thus has to drop late buffers.
@/GST_QOS_TYPE_THROTTLE/@ is used when the datarate is artificially limited
by the application, for example to reduce power consumption.

/@proportion@/ indicates the real-time performance of the streaming in the
element that generated the QoS event (usually the sink). The value is
generally computed based on more long term statistics about the streams
timestamps compared to the clock.
A value \< 1.0 indicates that the upstream element is producing data faster
than real-time. A value > 1.0 indicates that the upstream element is not
producing data fast enough. 1.0 is the ideal /@proportion@/ value. The
proportion value can safely be used to lower or increase the quality of
the element.

/@diff@/ is the difference against the clock in running time of the last
buffer that caused the element to generate the QOS event. A negative value
means that the buffer with /@timestamp@/ arrived in time. A positive value
indicates how late the buffer with /@timestamp@/ was. When throttling is
enabled, /@diff@/ will be set to the requested throttling interval.

/@timestamp@/ is the timestamp of the last buffer that cause the element
to generate the QOS event. It is expressed in running time and thus an ever
increasing value.

The upstream element can use the /@diff@/ and /@timestamp@/ values to decide
whether to process more buffers. For positive /@diff@/, all buffers with
timestamp \<= /@timestamp@/ + /@diff@/ will certainly arrive late in the sink
as well. A (negative) /@diff@/ value so that /@timestamp@/ + /@diff@/ would yield a
result smaller than 0 is not allowed.

The application can use general event probes to intercept the QoS
event and implement custom application specific QoS handling.
-}
eventNewQos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.QOSType
    {- ^ /@type@/: the QoS type -}
    -> Double
    {- ^ /@proportion@/: the proportion of the qos message -}
    -> Int64
    {- ^ /@diff@/: The time difference of the last Clock sync -}
    -> Word64
    {- ^ /@timestamp@/: The timestamp of the buffer -}
    -> m (Maybe Event)
    {- ^ __Returns:__ a new QOS event. -}
eventNewQos type_ proportion diff timestamp = liftIO $ do
    let type_' = (fromIntegral . fromEnum) type_
    let proportion' = realToFrac proportion
    result <- gst_event_new_qos type_' proportion' diff timestamp
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Event) result'
        return result''
    return maybeResult

#if ENABLE_OVERLOADING
#endif

-- method Event::new_reconfigure
-- method type : Constructor
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_reconfigure" gst_event_new_reconfigure ::
    IO (Ptr Event)

{- |
Create a new reconfigure event. The purpose of the reconfigure event is
to travel upstream and make elements renegotiate their caps or reconfigure
their buffer pools. This is useful when changing properties on elements
or changing the topology of the pipeline.
-}
eventNewReconfigure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewReconfigure  = liftIO $ do
    result <- gst_event_new_reconfigure
    checkUnexpectedReturnNULL "eventNewReconfigure" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_seek
-- method type : Constructor
-- Args : [Arg {argCName = "rate", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The new playback rate", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The format of the seek values", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flags", argType = TInterface (Name {namespace = "Gst", name = "SeekFlags"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The optional seek flags", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "start_type", argType = TInterface (Name {namespace = "Gst", name = "SeekType"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The type and flags for the new start position", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "start", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The value of the new start position", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stop_type", argType = TInterface (Name {namespace = "Gst", name = "SeekType"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The type and flags for the new stop position", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stop", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The value of the new stop position", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_seek" gst_event_new_seek ::
    CDouble ->                              -- rate : TBasicType TDouble
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "SeekFlags"})
    CUInt ->                                -- start_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Int64 ->                                -- start : TBasicType TInt64
    CUInt ->                                -- stop_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Int64 ->                                -- stop : TBasicType TInt64
    IO (Ptr Event)

{- |
Allocate a new seek event with the given parameters.

The seek event configures playback of the pipeline between /@start@/ to /@stop@/
at the speed given in /@rate@/, also called a playback segment.
The /@start@/ and /@stop@/ values are expressed in /@format@/.

A /@rate@/ of 1.0 means normal playback rate, 2.0 means double speed.
Negatives values means backwards playback. A value of 0.0 for the
rate is not allowed and should be accomplished instead by PAUSING the
pipeline.

A pipeline has a default playback segment configured with a start
position of 0, a stop position of -1 and a rate of 1.0. The currently
configured playback segment can be queried with @/GST_QUERY_SEGMENT/@.

/@startType@/ and /@stopType@/ specify how to adjust the currently configured
start and stop fields in playback segment. Adjustments can be made relative
or absolute to the last configured values. A type of @/GST_SEEK_TYPE_NONE/@
means that the position should not be updated.

When the rate is positive and /@start@/ has been updated, playback will start
from the newly configured start position.

For negative rates, playback will start from the newly configured stop
position (if any). If the stop position is updated, it must be different from
-1 ('GI.Gst.Constants.CLOCK_TIME_NONE') for negative rates.

It is not possible to seek relative to the current playback position, to do
this, PAUSE the pipeline, query the current playback position with
@/GST_QUERY_POSITION/@ and update the playback segment current position with a
@/GST_SEEK_TYPE_SET/@ to the desired position.
-}
eventNewSeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    {- ^ /@rate@/: The new playback rate -}
    -> Gst.Enums.Format
    {- ^ /@format@/: The format of the seek values -}
    -> [Gst.Flags.SeekFlags]
    {- ^ /@flags@/: The optional seek flags -}
    -> Gst.Enums.SeekType
    {- ^ /@startType@/: The type and flags for the new start position -}
    -> Int64
    {- ^ /@start@/: The value of the new start position -}
    -> Gst.Enums.SeekType
    {- ^ /@stopType@/: The type and flags for the new stop position -}
    -> Int64
    {- ^ /@stop@/: The value of the new stop position -}
    -> m (Maybe Event)
    {- ^ __Returns:__ a new seek event. -}
eventNewSeek rate format flags startType start stopType stop = liftIO $ do
    let rate' = realToFrac rate
    let format' = (fromIntegral . fromEnum) format
    let flags' = gflagsToWord flags
    let startType' = (fromIntegral . fromEnum) startType
    let stopType' = (fromIntegral . fromEnum) stopType
    result <- gst_event_new_seek rate' format' flags' startType' start stopType' stop
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Event) result'
        return result''
    return maybeResult

#if ENABLE_OVERLOADING
#endif

-- method Event::new_segment
-- method type : Constructor
-- Args : [Arg {argCName = "segment", argType = TInterface (Name {namespace = "Gst", name = "Segment"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstSegment", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_segment" gst_event_new_segment ::
    Ptr Gst.Segment.Segment ->              -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO (Ptr Event)

{- |
Create a new SEGMENT event for /@segment@/. The segment event can only travel
downstream synchronized with the buffer flow and contains timing information
and playback properties for the buffers that will follow.

The segment event marks the range of buffers to be processed. All
data not within the segment range is not to be processed. This can be
used intelligently by plugins to apply more efficient methods of skipping
unneeded data. The valid range is expressed with the /@start@/ and /@stop@/
values.

The time value of the segment is used in conjunction with the start
value to convert the buffer timestamps into the stream time. This is
usually done in sinks to report the current stream_time.
/@time@/ represents the stream_time of a buffer carrying a timestamp of
/@start@/. /@time@/ cannot be -1.

/@start@/ cannot be -1, /@stop@/ can be -1. If there
is a valid /@stop@/ given, it must be greater or equal the /@start@/, including
when the indicated playback /@rate@/ is \< 0.

The /@appliedRate@/ value provides information about any rate adjustment that
has already been made to the timestamps and content on the buffers of the
stream. (/@rate@/ * /@appliedRate@/) should always equal the rate that has been
requested for playback. For example, if an element has an input segment
with intended playback /@rate@/ of 2.0 and applied_rate of 1.0, it can adjust
incoming timestamps and buffer content by half and output a segment event
with /@rate@/ of 1.0 and /@appliedRate@/ of 2.0

After a segment event, the buffer stream time is calculated with:

  time + (TIMESTAMP(buf) - start) * ABS (rate * applied_rate)
-}
eventNewSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Segment.Segment
    {- ^ /@segment@/: a 'GI.Gst.Structs.Segment.Segment' -}
    -> m (Maybe Event)
    {- ^ __Returns:__ the new SEGMENT event. -}
eventNewSegment segment = liftIO $ do
    segment' <- unsafeManagedPtrGetPtr segment
    result <- gst_event_new_segment segment'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Event) result'
        return result''
    touchManagedPtr segment
    return maybeResult

#if ENABLE_OVERLOADING
#endif

-- method Event::new_segment_done
-- method type : Constructor
-- Args : [Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The format of the position being done", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "position", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The position of the segment being done", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_segment_done" gst_event_new_segment_done ::
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- position : TBasicType TInt64
    IO (Ptr Event)

{- |
Create a new segment-done event. This event is sent by elements that
finish playback of a segment as a result of a segment seek.
-}
eventNewSegmentDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    {- ^ /@format@/: The format of the position being done -}
    -> Int64
    {- ^ /@position@/: The position of the segment being done -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewSegmentDone format position = liftIO $ do
    let format' = (fromIntegral . fromEnum) format
    result <- gst_event_new_segment_done format' position
    checkUnexpectedReturnNULL "eventNewSegmentDone" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_select_streams
-- method type : Constructor
-- Args : [Arg {argCName = "streams", argType = TGList (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the list of streams to\nactivate", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_select_streams" gst_event_new_select_streams ::
    Ptr (GList CString) ->                  -- streams : TGList (TBasicType TUTF8)
    IO (Ptr Event)

{- |
Allocate a new select-streams event.

The select-streams event requests the specified /@streams@/ to be activated.

The list of /@streams@/ corresponds to the \"Stream ID\" of each stream to be
activated. Those ID can be obtained via the 'GI.Gst.Objects.Stream.Stream' objects present
in @/GST_EVENT_STREAM_START/@, @/GST_EVENT_STREAM_COLLECTION/@ or
@/GST_MESSAGE_STREAM_COLLECTION/@.

Note: The list of /@streams@/ can not be empty.

/Since: 1.10/
-}
eventNewSelectStreams ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [T.Text]
    {- ^ /@streams@/: the list of streams to
activate -}
    -> m Event
    {- ^ __Returns:__ a new select-streams event or 'Nothing' in case of
an error (like an empty streams list). -}
eventNewSelectStreams streams = liftIO $ do
    streams' <- mapM textToCString streams
    streams'' <- packGList streams'
    result <- gst_event_new_select_streams streams''
    checkUnexpectedReturnNULL "eventNewSelectStreams" result
    result' <- (wrapBoxed Event) result
    mapGList freeMem streams''
    g_list_free streams''
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_sink_message
-- method type : Constructor
-- Args : [Arg {argCName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a name for the event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "msg", argType = TInterface (Name {namespace = "Gst", name = "Message"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #GstMessage to be posted", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_sink_message" gst_event_new_sink_message ::
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gst.Message.Message ->              -- msg : TInterface (Name {namespace = "Gst", name = "Message"})
    IO (Ptr Event)

{- |
Create a new sink-message event. The purpose of the sink-message event is
to instruct a sink to post the message contained in the event synchronized
with the stream.

/@name@/ is used to store multiple sticky events on one pad.
-}
eventNewSinkMessage ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@name@/: a name for the event -}
    -> Gst.Message.Message
    {- ^ /@msg@/: the 'GI.Gst.Structs.Message.Message' to be posted -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewSinkMessage name msg = liftIO $ do
    name' <- textToCString name
    msg' <- unsafeManagedPtrGetPtr msg
    result <- gst_event_new_sink_message name' msg'
    checkUnexpectedReturnNULL "eventNewSinkMessage" result
    result' <- (wrapBoxed Event) result
    touchManagedPtr msg
    freeMem name'
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_step
-- method type : Constructor
-- Args : [Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the format of @amount", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "amount", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the amount of data to step", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "rate", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the step rate", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flush", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "flushing steps", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "intermediate", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "intermediate steps", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_step" gst_event_new_step ::
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- amount : TBasicType TUInt64
    CDouble ->                              -- rate : TBasicType TDouble
    CInt ->                                 -- flush : TBasicType TBoolean
    CInt ->                                 -- intermediate : TBasicType TBoolean
    IO (Ptr Event)

{- |
Create a new step event. The purpose of the step event is to instruct a sink
to skip /@amount@/ (expressed in /@format@/) of media. It can be used to implement
stepping through the video frame by frame or for doing fast trick modes.

A rate of \<= 0.0 is not allowed. Pause the pipeline, for the effect of rate
= 0.0 or first reverse the direction of playback using a seek event to get
the same effect as rate \< 0.0.

The /@flush@/ flag will clear any pending data in the pipeline before starting
the step operation.

The /@intermediate@/ flag instructs the pipeline that this step operation is
part of a larger step operation.
-}
eventNewStep ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Enums.Format
    {- ^ /@format@/: the format of /@amount@/ -}
    -> Word64
    {- ^ /@amount@/: the amount of data to step -}
    -> Double
    {- ^ /@rate@/: the step rate -}
    -> Bool
    {- ^ /@flush@/: flushing steps -}
    -> Bool
    {- ^ /@intermediate@/: intermediate steps -}
    -> m (Maybe Event)
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewStep format amount rate flush intermediate = liftIO $ do
    let format' = (fromIntegral . fromEnum) format
    let rate' = realToFrac rate
    let flush' = (fromIntegral . fromEnum) flush
    let intermediate' = (fromIntegral . fromEnum) intermediate
    result <- gst_event_new_step format' amount rate' flush' intermediate'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (wrapBoxed Event) result'
        return result''
    return maybeResult

#if ENABLE_OVERLOADING
#endif

-- method Event::new_stream_collection
-- method type : Constructor
-- Args : [Arg {argCName = "collection", argType = TInterface (Name {namespace = "Gst", name = "StreamCollection"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Active collection for this data flow", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_stream_collection" gst_event_new_stream_collection ::
    Ptr Gst.StreamCollection.StreamCollection -> -- collection : TInterface (Name {namespace = "Gst", name = "StreamCollection"})
    IO (Ptr Event)

{- |
Create a new STREAM_COLLECTION event. The stream collection event can only
travel downstream synchronized with the buffer flow.

Source elements, demuxers and other elements that manage collections
of streams and post 'GI.Gst.Objects.StreamCollection.StreamCollection' messages on the bus also send
this event downstream on each pad involved in the collection, so that
activation of a new collection can be tracked through the downstream
data flow.

/Since: 1.10/
-}
eventNewStreamCollection ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.StreamCollection.IsStreamCollection a) =>
    a
    {- ^ /@collection@/: Active collection for this data flow -}
    -> m Event
    {- ^ __Returns:__ the new STREAM_COLLECTION event. -}
eventNewStreamCollection collection = liftIO $ do
    collection' <- unsafeManagedPtrCastPtr collection
    result <- gst_event_new_stream_collection collection'
    checkUnexpectedReturnNULL "eventNewStreamCollection" result
    result' <- (wrapBoxed Event) result
    touchManagedPtr collection
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_stream_group_done
-- method type : Constructor
-- Args : [Arg {argCName = "group_id", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the group id of the stream group which is ending", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_stream_group_done" gst_event_new_stream_group_done ::
    Word32 ->                               -- group_id : TBasicType TUInt
    IO (Ptr Event)

{- |
Create a new Stream Group Done event. The stream-group-done event can
only travel downstream synchronized with the buffer flow. Elements
that receive the event on a pad should handle it mostly like EOS,
and emit any data or pending buffers that would depend on more data
arriving and unblock, since there won\'t be any more data.

This event is followed by EOS at some point in the future, and is
generally used when switching pads - to unblock downstream so that
new pads can be exposed before sending EOS on the existing pads.

/Since: 1.10/
-}
eventNewStreamGroupDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    {- ^ /@groupId@/: the group id of the stream group which is ending -}
    -> m Event
    {- ^ __Returns:__ the new stream-group-done event. -}
eventNewStreamGroupDone groupId = liftIO $ do
    result <- gst_event_new_stream_group_done groupId
    checkUnexpectedReturnNULL "eventNewStreamGroupDone" result
    result' <- (wrapBoxed Event) result
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_stream_start
-- method type : Constructor
-- Args : [Arg {argCName = "stream_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Identifier for this stream", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_stream_start" gst_event_new_stream_start ::
    CString ->                              -- stream_id : TBasicType TUTF8
    IO (Ptr Event)

{- |
Create a new STREAM_START event. The stream start event can only
travel downstream synchronized with the buffer flow. It is expected
to be the first event that is sent for a new stream.

Source elements, demuxers and other elements that create new streams
are supposed to send this event as the first event of a new stream. It
should not be sent after a flushing seek or in similar situations
and is used to mark the beginning of a new logical stream. Elements
combining multiple streams must ensure that this event is only forwarded
downstream once and not for every single input stream.

The /@streamId@/ should be a unique string that consists of the upstream
stream-id, \/ as separator and a unique stream-id for this specific
stream. A new stream-id should only be created for a stream if the upstream
stream is split into (potentially) multiple new streams, e.g. in a demuxer,
but not for every single element in the pipeline.
'GI.Gst.Objects.Pad.padCreateStreamId' or @/gst_pad_create_stream_id_printf()/@ can be
used to create a stream-id.  There are no particular semantics for the
stream-id, though it should be deterministic (to support stream matching)
and it might be used to order streams (besides any information conveyed by
stream flags).
-}
eventNewStreamStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@streamId@/: Identifier for this stream -}
    -> m Event
    {- ^ __Returns:__ the new STREAM_START event. -}
eventNewStreamStart streamId = liftIO $ do
    streamId' <- textToCString streamId
    result <- gst_event_new_stream_start streamId'
    checkUnexpectedReturnNULL "eventNewStreamStart" result
    result' <- (wrapBoxed Event) result
    freeMem streamId'
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_tag
-- method type : Constructor
-- Args : [Arg {argCName = "taglist", argType = TInterface (Name {namespace = "Gst", name = "TagList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "metadata list. The event will take ownership\n    of the taglist.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_tag" gst_event_new_tag ::
    Ptr Gst.TagList.TagList ->              -- taglist : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO (Ptr Event)

{- |
Generates a metadata tag event from the given /@taglist@/.

The scope of the taglist specifies if the taglist applies to the
complete medium or only to this specific stream. As the tag event
is a sticky event, elements should merge tags received from
upstream with a given scope with their own tags with the same
scope and create a new tag event from it.
-}
eventNewTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.TagList.TagList
    {- ^ /@taglist@/: metadata list. The event will take ownership
    of the taglist. -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event' -}
eventNewTag taglist = liftIO $ do
    taglist' <- B.ManagedPtr.disownBoxed taglist
    result <- gst_event_new_tag taglist'
    checkUnexpectedReturnNULL "eventNewTag" result
    result' <- (wrapBoxed Event) result
    touchManagedPtr taglist
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_toc
-- method type : Constructor
-- Args : [Arg {argCName = "toc", argType = TInterface (Name {namespace = "Gst", name = "Toc"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "#GstToc structure.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "updated", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "whether @toc was updated or not.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_toc" gst_event_new_toc ::
    Ptr Gst.Toc.Toc ->                      -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    CInt ->                                 -- updated : TBasicType TBoolean
    IO (Ptr Event)

{- |
Generate a TOC event from the given /@toc@/. The purpose of the TOC event is to
inform elements that some kind of the TOC was found.
-}
eventNewToc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gst.Toc.Toc
    {- ^ /@toc@/: 'GI.Gst.Structs.Toc.Toc' structure. -}
    -> Bool
    {- ^ /@updated@/: whether /@toc@/ was updated or not. -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event'. -}
eventNewToc toc updated = liftIO $ do
    toc' <- unsafeManagedPtrGetPtr toc
    let updated' = (fromIntegral . fromEnum) updated
    result <- gst_event_new_toc toc' updated'
    checkUnexpectedReturnNULL "eventNewToc" result
    result' <- (wrapBoxed Event) result
    touchManagedPtr toc
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::new_toc_select
-- method type : Constructor
-- Args : [Arg {argCName = "uid", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "UID in the TOC to start playback from.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Event"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_new_toc_select" gst_event_new_toc_select ::
    CString ->                              -- uid : TBasicType TUTF8
    IO (Ptr Event)

{- |
Generate a TOC select event with the given /@uid@/. The purpose of the
TOC select event is to start playback based on the TOC\'s entry with the
given /@uid@/.
-}
eventNewTocSelect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@uid@/: UID in the TOC to start playback from. -}
    -> m Event
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Event.Event'. -}
eventNewTocSelect uid = liftIO $ do
    uid' <- textToCString uid
    result <- gst_event_new_toc_select uid'
    checkUnexpectedReturnNULL "eventNewTocSelect" result
    result' <- (wrapBoxed Event) result
    freeMem uid'
    return result'

#if ENABLE_OVERLOADING
#endif

-- method Event::copy_segment
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to parse", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "segment", argType = TInterface (Name {namespace = "Gst", name = "Segment"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to a #GstSegment", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_copy_segment" gst_event_copy_segment ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Gst.Segment.Segment ->              -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO ()

{- |
Parses a segment /@event@/ and copies the 'GI.Gst.Structs.Segment.Segment' into the location
given by /@segment@/.
-}
eventCopySegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to parse -}
    -> Gst.Segment.Segment
    {- ^ /@segment@/: a pointer to a 'GI.Gst.Structs.Segment.Segment' -}
    -> m ()
eventCopySegment event segment = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    segment' <- unsafeManagedPtrGetPtr segment
    gst_event_copy_segment event' segment'
    touchManagedPtr event
    touchManagedPtr segment
    return ()

#if ENABLE_OVERLOADING
data EventCopySegmentMethodInfo
instance (signature ~ (Gst.Segment.Segment -> m ()), MonadIO m) => O.MethodInfo EventCopySegmentMethodInfo Event signature where
    overloadedMethod _ = eventCopySegment

#endif

-- method Event::get_running_time_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_get_running_time_offset" gst_event_get_running_time_offset ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO Int64

{- |
Retrieve the accumulated running time offset of the event.

Events passing through @/GstPads/@ that have a running time
offset set via 'GI.Gst.Objects.Pad.padSetOffset' will get their offset
adjusted according to the pad\'s offset.

If the event contains any information that related to the
running time, this information will need to be updated
before usage with this offset.

/Since: 1.4/
-}
eventGetRunningTimeOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: A 'GI.Gst.Structs.Event.Event'. -}
    -> m Int64
    {- ^ __Returns:__ The event\'s running time offset

MT safe. -}
eventGetRunningTimeOffset event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    result <- gst_event_get_running_time_offset event'
    touchManagedPtr event
    return result

#if ENABLE_OVERLOADING
data EventGetRunningTimeOffsetMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.MethodInfo EventGetRunningTimeOffsetMethodInfo Event signature where
    overloadedMethod _ = eventGetRunningTimeOffset

#endif

-- method Event::get_seqnum
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_get_seqnum" gst_event_get_seqnum ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO Word32

{- |
Retrieve the sequence number of a event.

Events have ever-incrementing sequence numbers, which may also be set
explicitly via 'GI.Gst.Structs.Event.eventSetSeqnum'. Sequence numbers are typically used to
indicate that a event corresponds to some other set of events or messages,
for example an EOS event corresponding to a SEEK event. It is considered good
practice to make this correspondence when possible, though it is not
required.

Note that events and messages share the same sequence number incrementor;
two events or messages will never have the same sequence number unless
that correspondence was made explicitly.
-}
eventGetSeqnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: A 'GI.Gst.Structs.Event.Event'. -}
    -> m Word32
    {- ^ __Returns:__ The event\'s sequence number.

MT safe. -}
eventGetSeqnum event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    result <- gst_event_get_seqnum event'
    touchManagedPtr event
    return result

#if ENABLE_OVERLOADING
data EventGetSeqnumMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo EventGetSeqnumMethodInfo Event signature where
    overloadedMethod _ = eventGetSeqnum

#endif

-- method Event::get_structure
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Structure"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_get_structure" gst_event_get_structure ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO (Ptr Gst.Structure.Structure)

{- |
Access the structure of the event.
-}
eventGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The 'GI.Gst.Structs.Event.Event'. -}
    -> m (Maybe Gst.Structure.Structure)
    {- ^ __Returns:__ The structure of the event. The
structure is still owned by the event, which means that you should not free
it and that the pointer becomes invalid when you free the event.

MT safe. -}
eventGetStructure event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    result <- gst_event_get_structure event'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (newBoxed Gst.Structure.Structure) result'
        return result''
    touchManagedPtr event
    return maybeResult

#if ENABLE_OVERLOADING
data EventGetStructureMethodInfo
instance (signature ~ (m (Maybe Gst.Structure.Structure)), MonadIO m) => O.MethodInfo EventGetStructureMethodInfo Event signature where
    overloadedMethod _ = eventGetStructure

#endif

-- method Event::has_name
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "name to check", 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_event_has_name" gst_event_has_name ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

{- |
Checks if /@event@/ has the given /@name@/. This function is usually used to
check the name of a custom event.
-}
eventHasName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The 'GI.Gst.Structs.Event.Event'. -}
    -> T.Text
    {- ^ /@name@/: name to check -}
    -> m Bool
    {- ^ __Returns:__ 'True' if /@name@/ matches the name of the event structure. -}
eventHasName event name = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    name' <- textToCString name
    result <- gst_event_has_name event' name'
    let result' = (/= 0) result
    touchManagedPtr event
    freeMem name'
    return result'

#if ENABLE_OVERLOADING
data EventHasNameMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo EventHasNameMethodInfo Event signature where
    overloadedMethod _ = eventHasName

#endif

-- method Event::parse_buffer_size
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the format in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "minsize", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the minsize in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "maxsize", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the maxsize in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "async", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the async-flag in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_buffer_size" gst_event_parse_buffer_size ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- minsize : TBasicType TInt64
    Ptr Int64 ->                            -- maxsize : TBasicType TInt64
    Ptr CInt ->                             -- async : TBasicType TBoolean
    IO ()

{- |
Get the format, minsize, maxsize and async-flag in the buffersize event.
-}
eventParseBufferSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to query -}
    -> m ((Gst.Enums.Format, Int64, Int64, Bool))
eventParseBufferSize event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    format <- allocMem :: IO (Ptr CUInt)
    minsize <- allocMem :: IO (Ptr Int64)
    maxsize <- allocMem :: IO (Ptr Int64)
    async <- allocMem :: IO (Ptr CInt)
    gst_event_parse_buffer_size event' format minsize maxsize async
    format' <- peek format
    let format'' = (toEnum . fromIntegral) format'
    minsize' <- peek minsize
    maxsize' <- peek maxsize
    async' <- peek async
    let async'' = (/= 0) async'
    touchManagedPtr event
    freeMem format
    freeMem minsize
    freeMem maxsize
    freeMem async
    return (format'', minsize', maxsize', async'')

#if ENABLE_OVERLOADING
data EventParseBufferSizeMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64, Int64, Bool))), MonadIO m) => O.MethodInfo EventParseBufferSizeMethodInfo Event signature where
    overloadedMethod _ = eventParseBufferSize

#endif

-- method Event::parse_caps
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to parse", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "caps", argType = TInterface (Name {namespace = "Gst", name = "Caps"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to the caps", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_caps" gst_event_parse_caps ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.Caps.Caps) ->              -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

{- |
Get the caps from /@event@/. The caps remains valid as long as /@event@/ remains
valid.
-}
eventParseCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to parse -}
    -> m (Gst.Caps.Caps)
eventParseCaps event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    caps <- allocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    gst_event_parse_caps event' caps
    caps' <- peek caps
    caps'' <- (newBoxed Gst.Caps.Caps) caps'
    touchManagedPtr event
    freeMem caps
    return caps''

#if ENABLE_OVERLOADING
data EventParseCapsMethodInfo
instance (signature ~ (m (Gst.Caps.Caps)), MonadIO m) => O.MethodInfo EventParseCapsMethodInfo Event signature where
    overloadedMethod _ = eventParseCaps

#endif

-- method Event::parse_flush_stop
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to parse", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "reset_time", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "if time should be reset", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_flush_stop" gst_event_parse_flush_stop ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CInt ->                             -- reset_time : TBasicType TBoolean
    IO ()

{- |
Parse the FLUSH_STOP event and retrieve the /@resetTime@/ member.
-}
eventParseFlushStop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to parse -}
    -> m (Bool)
eventParseFlushStop event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    resetTime <- allocMem :: IO (Ptr CInt)
    gst_event_parse_flush_stop event' resetTime
    resetTime' <- peek resetTime
    let resetTime'' = (/= 0) resetTime'
    touchManagedPtr event
    freeMem resetTime
    return resetTime''

#if ENABLE_OVERLOADING
data EventParseFlushStopMethodInfo
instance (signature ~ (m (Bool)), MonadIO m) => O.MethodInfo EventParseFlushStopMethodInfo Event signature where
    overloadedMethod _ = eventParseFlushStop

#endif

-- method Event::parse_gap
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstEvent of type #GST_EVENT_GAP", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "timestamp", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "location where to store the\n    start time (pts) of the gap, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "duration", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "location where to store the duration of\n    the gap, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_gap" gst_event_parse_gap ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Word64 ->                           -- timestamp : TBasicType TUInt64
    Ptr Word64 ->                           -- duration : TBasicType TUInt64
    IO ()

{- |
Extract timestamp and duration from a new GAP event.
-}
eventParseGap ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a 'GI.Gst.Structs.Event.Event' of type @/GST_EVENT_GAP/@ -}
    -> m ((Word64, Word64))
eventParseGap event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    timestamp <- allocMem :: IO (Ptr Word64)
    duration <- allocMem :: IO (Ptr Word64)
    gst_event_parse_gap event' timestamp duration
    timestamp' <- peek timestamp
    duration' <- peek duration
    touchManagedPtr event
    freeMem timestamp
    freeMem duration
    return (timestamp', duration')

#if ENABLE_OVERLOADING
data EventParseGapMethodInfo
instance (signature ~ (m ((Word64, Word64))), MonadIO m) => O.MethodInfo EventParseGapMethodInfo Event signature where
    overloadedMethod _ = eventParseGap

#endif

-- method Event::parse_group_id
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "group_id", argType = TBasicType TUInt, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "address of variable where to store the group id", 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_event_parse_group_id" gst_event_parse_group_id ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Word32 ->                           -- group_id : TBasicType TUInt
    IO CInt

{- |
/No description available in the introspection data./

/Since: 1.2/
-}
eventParseGroupId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-start event -}
    -> m ((Bool, Word32))
    {- ^ __Returns:__ 'True' if a group id was set on the event and could be parsed,
  'False' otherwise. -}
eventParseGroupId event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    groupId <- allocMem :: IO (Ptr Word32)
    result <- gst_event_parse_group_id event' groupId
    let result' = (/= 0) result
    groupId' <- peek groupId
    touchManagedPtr event
    freeMem groupId
    return (result', groupId')

#if ENABLE_OVERLOADING
data EventParseGroupIdMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m) => O.MethodInfo EventParseGroupIdMethodInfo Event signature where
    overloadedMethod _ = eventParseGroupId

#endif

-- method Event::parse_latency
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "latency", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the latency in.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_latency" gst_event_parse_latency ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Word64 ->                           -- latency : TBasicType TUInt64
    IO ()

{- |
Get the latency in the latency event.
-}
eventParseLatency ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to query -}
    -> m (Word64)
eventParseLatency event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    latency <- allocMem :: IO (Ptr Word64)
    gst_event_parse_latency event' latency
    latency' <- peek latency
    touchManagedPtr event
    freeMem latency
    return latency'

#if ENABLE_OVERLOADING
data EventParseLatencyMethodInfo
instance (signature ~ (m (Word64)), MonadIO m) => O.MethodInfo EventParseLatencyMethodInfo Event signature where
    overloadedMethod _ = eventParseLatency

#endif

-- method Event::parse_protection
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GST_EVENT_PROTECTION event.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "system_id", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to store the UUID\nstring uniquely identifying a content protection system.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TInterface (Name {namespace = "Gst", name = "Buffer"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to store a #GstBuffer\nholding protection system specific information.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "origin", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = True, argDoc = Documentation {rawDocText = Just "pointer to store a value that\nindicates where the protection information carried by @event was extracted\nfrom.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_protection" gst_event_parse_protection ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CString ->                          -- system_id : TBasicType TUTF8
    Ptr (Ptr Gst.Buffer.Buffer) ->          -- data : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr CString ->                          -- origin : TBasicType TUTF8
    IO ()

{- |
Parses an event containing protection system specific information and stores
the results in /@systemId@/, /@data@/ and /@origin@/. The data stored in /@systemId@/,
/@origin@/ and /@data@/ are valid until /@event@/ is released.

/Since: 1.6/
-}
eventParseProtection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a @/GST_EVENT_PROTECTION/@ event. -}
    -> m ((T.Text, Gst.Buffer.Buffer, Maybe T.Text))
eventParseProtection event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    systemId <- allocMem :: IO (Ptr CString)
    data_ <- allocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    origin <- allocMem :: IO (Ptr CString)
    gst_event_parse_protection event' systemId data_ origin
    systemId' <- peek systemId
    systemId'' <- cstringToText systemId'
    data_' <- peek data_
    data_'' <- (newBoxed Gst.Buffer.Buffer) data_'
    origin' <- peek origin
    maybeOrigin' <- convertIfNonNull origin' $ \origin'' -> do
        origin''' <- cstringToText origin''
        return origin'''
    touchManagedPtr event
    freeMem systemId
    freeMem data_
    freeMem origin
    return (systemId'', data_'', maybeOrigin')

#if ENABLE_OVERLOADING
data EventParseProtectionMethodInfo
instance (signature ~ (m ((T.Text, Gst.Buffer.Buffer, Maybe T.Text))), MonadIO m) => O.MethodInfo EventParseProtectionMethodInfo Event signature where
    overloadedMethod _ = eventParseProtection

#endif

-- method Event::parse_qos
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "type", argType = TInterface (Name {namespace = "Gst", name = "QOSType"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the QoS type in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "proportion", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the proportion in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "diff", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the diff in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "timestamp", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A pointer to store the timestamp in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_qos" gst_event_parse_qos ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- type : TInterface (Name {namespace = "Gst", name = "QOSType"})
    Ptr CDouble ->                          -- proportion : TBasicType TDouble
    Ptr Int64 ->                            -- diff : TBasicType TInt64
    Ptr Word64 ->                           -- timestamp : TBasicType TUInt64
    IO ()

{- |
Get the type, proportion, diff and timestamp in the qos event. See
'GI.Gst.Structs.Event.eventNewQos' for more information about the different QoS values.

/@timestamp@/ will be adjusted for any pad offsets of pads it was passing through.
-}
eventParseQos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to query -}
    -> m ((Gst.Enums.QOSType, Double, Int64, Word64))
eventParseQos event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    type_ <- allocMem :: IO (Ptr CUInt)
    proportion <- allocMem :: IO (Ptr CDouble)
    diff <- allocMem :: IO (Ptr Int64)
    timestamp <- allocMem :: IO (Ptr Word64)
    gst_event_parse_qos event' type_ proportion diff timestamp
    type_' <- peek type_
    let type_'' = (toEnum . fromIntegral) type_'
    proportion' <- peek proportion
    let proportion'' = realToFrac proportion'
    diff' <- peek diff
    timestamp' <- peek timestamp
    touchManagedPtr event
    freeMem type_
    freeMem proportion
    freeMem diff
    freeMem timestamp
    return (type_'', proportion'', diff', timestamp')

#if ENABLE_OVERLOADING
data EventParseQosMethodInfo
instance (signature ~ (m ((Gst.Enums.QOSType, Double, Int64, Word64))), MonadIO m) => O.MethodInfo EventParseQosMethodInfo Event signature where
    overloadedMethod _ = eventParseQos

#endif

-- method Event::parse_seek
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a seek event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "rate", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the rate", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the stream format", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "flags", argType = TInterface (Name {namespace = "Gst", name = "SeekFlags"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the #GstSeekFlags", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "start_type", argType = TInterface (Name {namespace = "Gst", name = "SeekType"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the #GstSeekType of the start position", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "start", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the start position expressed in @format", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "stop_type", argType = TInterface (Name {namespace = "Gst", name = "SeekType"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the #GstSeekType of the stop position", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "stop", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "result location for the stop position expressed in @format", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_seek" gst_event_parse_seek ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CDouble ->                          -- rate : TBasicType TDouble
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr CUInt ->                            -- flags : TInterface (Name {namespace = "Gst", name = "SeekFlags"})
    Ptr CUInt ->                            -- start_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Ptr Int64 ->                            -- start : TBasicType TInt64
    Ptr CUInt ->                            -- stop_type : TInterface (Name {namespace = "Gst", name = "SeekType"})
    Ptr Int64 ->                            -- stop : TBasicType TInt64
    IO ()

{- |
Parses a seek /@event@/ and stores the results in the given result locations.
-}
eventParseSeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a seek event -}
    -> m ((Double, Gst.Enums.Format, [Gst.Flags.SeekFlags], Gst.Enums.SeekType, Int64, Gst.Enums.SeekType, Int64))
eventParseSeek event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    rate <- allocMem :: IO (Ptr CDouble)
    format <- allocMem :: IO (Ptr CUInt)
    flags <- allocMem :: IO (Ptr CUInt)
    startType <- allocMem :: IO (Ptr CUInt)
    start <- allocMem :: IO (Ptr Int64)
    stopType <- allocMem :: IO (Ptr CUInt)
    stop <- allocMem :: IO (Ptr Int64)
    gst_event_parse_seek event' rate format flags startType start stopType stop
    rate' <- peek rate
    let rate'' = realToFrac rate'
    format' <- peek format
    let format'' = (toEnum . fromIntegral) format'
    flags' <- peek flags
    let flags'' = wordToGFlags flags'
    startType' <- peek startType
    let startType'' = (toEnum . fromIntegral) startType'
    start' <- peek start
    stopType' <- peek stopType
    let stopType'' = (toEnum . fromIntegral) stopType'
    stop' <- peek stop
    touchManagedPtr event
    freeMem rate
    freeMem format
    freeMem flags
    freeMem startType
    freeMem start
    freeMem stopType
    freeMem stop
    return (rate'', format'', flags'', startType'', start', stopType'', stop')

#if ENABLE_OVERLOADING
data EventParseSeekMethodInfo
instance (signature ~ (m ((Double, Gst.Enums.Format, [Gst.Flags.SeekFlags], Gst.Enums.SeekType, Int64, Gst.Enums.SeekType, Int64))), MonadIO m) => O.MethodInfo EventParseSeekMethodInfo Event signature where
    overloadedMethod _ = eventParseSeek

#endif

-- method Event::parse_seek_trickmode_interval
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "interval", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_seek_trickmode_interval" gst_event_parse_seek_trickmode_interval ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Word64 ->                           -- interval : TBasicType TUInt64
    IO ()

{- |
Retrieve the trickmode interval that may have been set on a
seek event with 'GI.Gst.Structs.Event.eventSetSeekTrickmodeInterval'.

/Since: 1.16/
-}
eventParseSeekTrickmodeInterval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -> m (Word64)
eventParseSeekTrickmodeInterval event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    interval <- allocMem :: IO (Ptr Word64)
    gst_event_parse_seek_trickmode_interval event' interval
    interval' <- peek interval
    touchManagedPtr event
    freeMem interval
    return interval'

#if ENABLE_OVERLOADING
data EventParseSeekTrickmodeIntervalMethodInfo
instance (signature ~ (m (Word64)), MonadIO m) => O.MethodInfo EventParseSeekTrickmodeIntervalMethodInfo Event signature where
    overloadedMethod _ = eventParseSeekTrickmodeInterval

#endif

-- method Event::parse_segment
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to parse", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "segment", argType = TInterface (Name {namespace = "Gst", name = "Segment"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to a #GstSegment", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_segment" gst_event_parse_segment ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.Segment.Segment) ->        -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO ()

{- |
Parses a segment /@event@/ and stores the result in the given /@segment@/ location.
/@segment@/ remains valid only until the /@event@/ is freed. Don\'t modify the segment
and make a copy if you want to modify it or store it for later use.
-}
eventParseSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to parse -}
    -> m (Gst.Segment.Segment)
eventParseSegment event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    segment <- allocMem :: IO (Ptr (Ptr Gst.Segment.Segment))
    gst_event_parse_segment event' segment
    segment' <- peek segment
    segment'' <- (newBoxed Gst.Segment.Segment) segment'
    touchManagedPtr event
    freeMem segment
    return segment''

#if ENABLE_OVERLOADING
data EventParseSegmentMethodInfo
instance (signature ~ (m (Gst.Segment.Segment)), MonadIO m) => O.MethodInfo EventParseSegmentMethodInfo Event signature where
    overloadedMethod _ = eventParseSegment

#endif

-- method Event::parse_segment_done
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A valid #GstEvent of type GST_EVENT_SEGMENT_DONE.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Result location for the format, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "position", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Result location for the position, or %NULL", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_segment_done" gst_event_parse_segment_done ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- position : TBasicType TInt64
    IO ()

{- |
Extracts the position and format from the segment done message.
-}
eventParseSegmentDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: A valid 'GI.Gst.Structs.Event.Event' of type GST_EVENT_SEGMENT_DONE. -}
    -> m ((Gst.Enums.Format, Int64))
eventParseSegmentDone event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    format <- allocMem :: IO (Ptr CUInt)
    position <- allocMem :: IO (Ptr Int64)
    gst_event_parse_segment_done event' format position
    format' <- peek format
    let format'' = (toEnum . fromIntegral) format'
    position' <- peek position
    touchManagedPtr event
    freeMem format
    freeMem position
    return (format'', position')

#if ENABLE_OVERLOADING
data EventParseSegmentDoneMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64))), MonadIO m) => O.MethodInfo EventParseSegmentDoneMethodInfo Event signature where
    overloadedMethod _ = eventParseSegmentDone

#endif

-- method Event::parse_select_streams
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to parse", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "streams", argType = TGList (TBasicType TUTF8), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the streams", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_select_streams" gst_event_parse_select_streams ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr (GList CString)) ->            -- streams : TGList (TBasicType TUTF8)
    IO ()

{- |
Parse the SELECT_STREAMS event and retrieve the contained streams.

/Since: 1.10/
-}
eventParseSelectStreams ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to parse -}
    -> m ([T.Text])
eventParseSelectStreams event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    streams <- allocMem :: IO (Ptr (Ptr (GList CString)))
    gst_event_parse_select_streams event' streams
    streams' <- peek streams
    streams'' <- unpackGList streams'
    streams''' <- mapM cstringToText streams''
    mapGList freeMem streams'
    g_list_free streams'
    touchManagedPtr event
    freeMem streams
    return streams'''

#if ENABLE_OVERLOADING
data EventParseSelectStreamsMethodInfo
instance (signature ~ (m ([T.Text])), MonadIO m) => O.MethodInfo EventParseSelectStreamsMethodInfo Event signature where
    overloadedMethod _ = eventParseSelectStreams

#endif

-- method Event::parse_sink_message
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "msg", argType = TInterface (Name {namespace = "Gst", name = "Message"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to store the #GstMessage in.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_sink_message" gst_event_parse_sink_message ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.Message.Message) ->        -- msg : TInterface (Name {namespace = "Gst", name = "Message"})
    IO ()

{- |
Parse the sink-message event. Unref /@msg@/ after usage.
-}
eventParseSinkMessage ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to query -}
    -> m (Gst.Message.Message)
eventParseSinkMessage event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    msg <- allocMem :: IO (Ptr (Ptr Gst.Message.Message))
    gst_event_parse_sink_message event' msg
    msg' <- peek msg
    msg'' <- (wrapBoxed Gst.Message.Message) msg'
    touchManagedPtr event
    freeMem msg
    return msg''

#if ENABLE_OVERLOADING
data EventParseSinkMessageMethodInfo
instance (signature ~ (m (Gst.Message.Message)), MonadIO m) => O.MethodInfo EventParseSinkMessageMethodInfo Event signature where
    overloadedMethod _ = eventParseSinkMessage

#endif

-- method Event::parse_step
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The event to query", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to store the format in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "amount", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to store the amount in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "rate", argType = TBasicType TDouble, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to store the rate in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "flush", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to store the flush boolean in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "intermediate", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a pointer to store the intermediate\n    boolean in", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_step" gst_event_parse_step ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Word64 ->                           -- amount : TBasicType TUInt64
    Ptr CDouble ->                          -- rate : TBasicType TDouble
    Ptr CInt ->                             -- flush : TBasicType TBoolean
    Ptr CInt ->                             -- intermediate : TBasicType TBoolean
    IO ()

{- |
Parse the step event.
-}
eventParseStep ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The event to query -}
    -> m ((Gst.Enums.Format, Word64, Double, Bool, Bool))
eventParseStep event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    format <- allocMem :: IO (Ptr CUInt)
    amount <- allocMem :: IO (Ptr Word64)
    rate <- allocMem :: IO (Ptr CDouble)
    flush <- allocMem :: IO (Ptr CInt)
    intermediate <- allocMem :: IO (Ptr CInt)
    gst_event_parse_step event' format amount rate flush intermediate
    format' <- peek format
    let format'' = (toEnum . fromIntegral) format'
    amount' <- peek amount
    rate' <- peek rate
    let rate'' = realToFrac rate'
    flush' <- peek flush
    let flush'' = (/= 0) flush'
    intermediate' <- peek intermediate
    let intermediate'' = (/= 0) intermediate'
    touchManagedPtr event
    freeMem format
    freeMem amount
    freeMem rate
    freeMem flush
    freeMem intermediate
    return (format'', amount', rate'', flush'', intermediate'')

#if ENABLE_OVERLOADING
data EventParseStepMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Word64, Double, Bool, Bool))), MonadIO m) => O.MethodInfo EventParseStepMethodInfo Event signature where
    overloadedMethod _ = eventParseStep

#endif

-- method Event::parse_stream
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stream", argType = TInterface (Name {namespace = "Gst", name = "Stream"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "address of variable to store the stream", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_stream" gst_event_parse_stream ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.Stream.Stream) ->          -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    IO ()

{- |
Parse a stream-start /@event@/ and extract the 'GI.Gst.Objects.Stream.Stream' from it.

/Since: 1.10/
-}
eventParseStream ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-start event -}
    -> m (Gst.Stream.Stream)
eventParseStream event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    stream <- allocMem :: IO (Ptr (Ptr Gst.Stream.Stream))
    gst_event_parse_stream event' stream
    stream' <- peek stream
    stream'' <- (wrapObject Gst.Stream.Stream) stream'
    touchManagedPtr event
    freeMem stream
    return stream''

#if ENABLE_OVERLOADING
data EventParseStreamMethodInfo
instance (signature ~ (m (Gst.Stream.Stream)), MonadIO m) => O.MethodInfo EventParseStreamMethodInfo Event signature where
    overloadedMethod _ = eventParseStream

#endif

-- method Event::parse_stream_collection
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-collection event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "collection", argType = TInterface (Name {namespace = "Gst", name = "StreamCollection"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to store the collection", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_stream_collection" gst_event_parse_stream_collection ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.StreamCollection.StreamCollection) -> -- collection : TInterface (Name {namespace = "Gst", name = "StreamCollection"})
    IO ()

{- |
Retrieve new 'GI.Gst.Objects.StreamCollection.StreamCollection' from STREAM_COLLECTION event /@event@/.

/Since: 1.10/
-}
eventParseStreamCollection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-collection event -}
    -> m (Gst.StreamCollection.StreamCollection)
eventParseStreamCollection event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    collection <- allocMem :: IO (Ptr (Ptr Gst.StreamCollection.StreamCollection))
    gst_event_parse_stream_collection event' collection
    collection' <- peek collection
    collection'' <- (wrapObject Gst.StreamCollection.StreamCollection) collection'
    touchManagedPtr event
    freeMem collection
    return collection''

#if ENABLE_OVERLOADING
data EventParseStreamCollectionMethodInfo
instance (signature ~ (m (Gst.StreamCollection.StreamCollection)), MonadIO m) => O.MethodInfo EventParseStreamCollectionMethodInfo Event signature where
    overloadedMethod _ = eventParseStreamCollection

#endif

-- method Event::parse_stream_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flags", argType = TInterface (Name {namespace = "Gst", name = "StreamFlags"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "address of variable where to store the stream flags", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_stream_flags" gst_event_parse_stream_flags ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- flags : TInterface (Name {namespace = "Gst", name = "StreamFlags"})
    IO ()

{- |
/No description available in the introspection data./

/Since: 1.2/
-}
eventParseStreamFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-start event -}
    -> m ([Gst.Flags.StreamFlags])
eventParseStreamFlags event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    flags <- allocMem :: IO (Ptr CUInt)
    gst_event_parse_stream_flags event' flags
    flags' <- peek flags
    let flags'' = wordToGFlags flags'
    touchManagedPtr event
    freeMem flags
    return flags''

#if ENABLE_OVERLOADING
data EventParseStreamFlagsMethodInfo
instance (signature ~ (m ([Gst.Flags.StreamFlags])), MonadIO m) => O.MethodInfo EventParseStreamFlagsMethodInfo Event signature where
    overloadedMethod _ = eventParseStreamFlags

#endif

-- method Event::parse_stream_group_done
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-group-done event.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "group_id", argType = TBasicType TUInt, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "address of variable to store the group id into", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_stream_group_done" gst_event_parse_stream_group_done ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Word32 ->                           -- group_id : TBasicType TUInt
    IO ()

{- |
Parse a stream-group-done /@event@/ and store the result in the given
/@groupId@/ location.

/Since: 1.10/
-}
eventParseStreamGroupDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-group-done event. -}
    -> m (Word32)
eventParseStreamGroupDone event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    groupId <- allocMem :: IO (Ptr Word32)
    gst_event_parse_stream_group_done event' groupId
    groupId' <- peek groupId
    touchManagedPtr event
    freeMem groupId
    return groupId'

#if ENABLE_OVERLOADING
data EventParseStreamGroupDoneMethodInfo
instance (signature ~ (m (Word32)), MonadIO m) => O.MethodInfo EventParseStreamGroupDoneMethodInfo Event signature where
    overloadedMethod _ = eventParseStreamGroupDone

#endif

-- method Event::parse_stream_start
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stream_id", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to store the stream-id", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_stream_start" gst_event_parse_stream_start ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CString ->                          -- stream_id : TBasicType TUTF8
    IO ()

{- |
Parse a stream-id /@event@/ and store the result in the given /@streamId@/
location. The string stored in /@streamId@/ must not be modified and will
remain valid only until /@event@/ gets freed. Make a copy if you want to
modify it or store it for later use.
-}
eventParseStreamStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-start event. -}
    -> m (T.Text)
eventParseStreamStart event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    streamId <- allocMem :: IO (Ptr CString)
    gst_event_parse_stream_start event' streamId
    streamId' <- peek streamId
    streamId'' <- cstringToText streamId'
    touchManagedPtr event
    freeMem streamId
    return streamId''

#if ENABLE_OVERLOADING
data EventParseStreamStartMethodInfo
instance (signature ~ (m (T.Text)), MonadIO m) => O.MethodInfo EventParseStreamStartMethodInfo Event signature where
    overloadedMethod _ = eventParseStreamStart

#endif

-- method Event::parse_tag
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a tag event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "taglist", argType = TInterface (Name {namespace = "Gst", name = "TagList"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to metadata list", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_tag" gst_event_parse_tag ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.TagList.TagList) ->        -- taglist : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO ()

{- |
Parses a tag /@event@/ and stores the results in the given /@taglist@/ location.
No reference to the taglist will be returned, it remains valid only until
the /@event@/ is freed. Don\'t modify or free the taglist, make a copy if you
want to modify it or store it for later use.
-}
eventParseTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a tag event -}
    -> m (Gst.TagList.TagList)
eventParseTag event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    taglist <- allocMem :: IO (Ptr (Ptr Gst.TagList.TagList))
    gst_event_parse_tag event' taglist
    taglist' <- peek taglist
    taglist'' <- (newBoxed Gst.TagList.TagList) taglist'
    touchManagedPtr event
    freeMem taglist
    return taglist''

#if ENABLE_OVERLOADING
data EventParseTagMethodInfo
instance (signature ~ (m (Gst.TagList.TagList)), MonadIO m) => O.MethodInfo EventParseTagMethodInfo Event signature where
    overloadedMethod _ = eventParseTag

#endif

-- method Event::parse_toc
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a TOC event.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "toc", argType = TInterface (Name {namespace = "Gst", name = "Toc"}), direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to #GstToc structure.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "updated", argType = TBasicType TBoolean, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to store TOC updated flag.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_toc" gst_event_parse_toc ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr (Ptr Gst.Toc.Toc) ->                -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    Ptr CInt ->                             -- updated : TBasicType TBoolean
    IO ()

{- |
Parse a TOC /@event@/ and store the results in the given /@toc@/ and /@updated@/ locations.
-}
eventParseToc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a TOC event. -}
    -> m ((Gst.Toc.Toc, Bool))
eventParseToc event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    toc <- allocMem :: IO (Ptr (Ptr Gst.Toc.Toc))
    updated <- allocMem :: IO (Ptr CInt)
    gst_event_parse_toc event' toc updated
    toc' <- peek toc
    toc'' <- (wrapBoxed Gst.Toc.Toc) toc'
    updated' <- peek updated
    let updated'' = (/= 0) updated'
    touchManagedPtr event
    freeMem toc
    freeMem updated
    return (toc'', updated'')

#if ENABLE_OVERLOADING
data EventParseTocMethodInfo
instance (signature ~ (m ((Gst.Toc.Toc, Bool))), MonadIO m) => O.MethodInfo EventParseTocMethodInfo Event signature where
    overloadedMethod _ = eventParseToc

#endif

-- method Event::parse_toc_select
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a TOC select event.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "uid", argType = TBasicType TUTF8, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "storage for the selection UID.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_parse_toc_select" gst_event_parse_toc_select ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CString ->                          -- uid : TBasicType TUTF8
    IO ()

{- |
Parse a TOC select /@event@/ and store the results in the given /@uid@/ location.
-}
eventParseTocSelect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a TOC select event. -}
    -> m (T.Text)
eventParseTocSelect event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    uid <- allocMem :: IO (Ptr CString)
    gst_event_parse_toc_select event' uid
    uid' <- peek uid
    uid'' <- cstringToText uid'
    freeMem uid'
    touchManagedPtr event
    freeMem uid
    return uid''

#if ENABLE_OVERLOADING
data EventParseTocSelectMethodInfo
instance (signature ~ (m (T.Text)), MonadIO m) => O.MethodInfo EventParseTocSelectMethodInfo Event signature where
    overloadedMethod _ = eventParseTocSelect

#endif

-- method Event::set_group_id
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "group_id", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the group id to set", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_set_group_id" gst_event_set_group_id ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Word32 ->                               -- group_id : TBasicType TUInt
    IO ()

{- |
All streams that have the same group id are supposed to be played
together, i.e. all streams inside a container file should have the
same group id but different stream ids. The group id should change
each time the stream is started, resulting in different group ids
each time a file is played for example.

Use 'GI.Gst.Functions.utilGroupIdNext' to get a new group id.

/Since: 1.2/
-}
eventSetGroupId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-start event -}
    -> Word32
    {- ^ /@groupId@/: the group id to set -}
    -> m ()
eventSetGroupId event groupId = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    gst_event_set_group_id event' groupId
    touchManagedPtr event
    return ()

#if ENABLE_OVERLOADING
data EventSetGroupIdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo EventSetGroupIdMethodInfo Event signature where
    overloadedMethod _ = eventSetGroupId

#endif

-- method Event::set_running_time_offset
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A the new running time offset", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_set_running_time_offset" gst_event_set_running_time_offset ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Int64 ->                                -- offset : TBasicType TInt64
    IO ()

{- |
Set the running time offset of a event. See
'GI.Gst.Structs.Event.eventGetRunningTimeOffset' for more information.

MT safe.

/Since: 1.4/
-}
eventSetRunningTimeOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: A 'GI.Gst.Structs.Event.Event'. -}
    -> Int64
    {- ^ /@offset@/: A the new running time offset -}
    -> m ()
eventSetRunningTimeOffset event offset = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    gst_event_set_running_time_offset event' offset
    touchManagedPtr event
    return ()

#if ENABLE_OVERLOADING
data EventSetRunningTimeOffsetMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.MethodInfo EventSetRunningTimeOffsetMethodInfo Event signature where
    overloadedMethod _ = eventSetRunningTimeOffset

#endif

-- method Event::set_seek_trickmode_interval
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "interval", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_set_seek_trickmode_interval" gst_event_set_seek_trickmode_interval ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Word64 ->                               -- interval : TBasicType TUInt64
    IO ()

{- |
Sets a trickmode interval on a (writable) seek event. Elements
that support TRICKMODE_KEY_UNITS seeks SHOULD use this as the minimal
interval between each frame they may output.

/Since: 1.16/
-}
eventSetSeekTrickmodeInterval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -> Word64
    -> m ()
eventSetSeekTrickmodeInterval event interval = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    gst_event_set_seek_trickmode_interval event' interval
    touchManagedPtr event
    return ()

#if ENABLE_OVERLOADING
data EventSetSeekTrickmodeIntervalMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.MethodInfo EventSetSeekTrickmodeIntervalMethodInfo Event signature where
    overloadedMethod _ = eventSetSeekTrickmodeInterval

#endif

-- method Event::set_seqnum
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "seqnum", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "A sequence number.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_set_seqnum" gst_event_set_seqnum ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Word32 ->                               -- seqnum : TBasicType TUInt32
    IO ()

{- |
Set the sequence number of a event.

This function might be called by the creator of a event to indicate that the
event relates to other events or messages. See 'GI.Gst.Structs.Event.eventGetSeqnum' for
more information.

MT safe.
-}
eventSetSeqnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: A 'GI.Gst.Structs.Event.Event'. -}
    -> Word32
    {- ^ /@seqnum@/: A sequence number. -}
    -> m ()
eventSetSeqnum event seqnum = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    gst_event_set_seqnum event' seqnum
    touchManagedPtr event
    return ()

#if ENABLE_OVERLOADING
data EventSetSeqnumMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo EventSetSeqnumMethodInfo Event signature where
    overloadedMethod _ = eventSetSeqnum

#endif

-- method Event::set_stream
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "stream", argType = TInterface (Name {namespace = "Gst", name = "Stream"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the stream object to set", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_set_stream" gst_event_set_stream ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr Gst.Stream.Stream ->                -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    IO ()

{- |
Set the /@stream@/ on the stream-start /@event@/

/Since: 1.10/
-}
eventSetStream ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Stream.IsStream a) =>
    Event
    {- ^ /@event@/: a stream-start event -}
    -> a
    {- ^ /@stream@/: the stream object to set -}
    -> m ()
eventSetStream event stream = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    stream' <- unsafeManagedPtrCastPtr stream
    gst_event_set_stream event' stream'
    touchManagedPtr event
    touchManagedPtr stream
    return ()

#if ENABLE_OVERLOADING
data EventSetStreamMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Gst.Stream.IsStream a) => O.MethodInfo EventSetStreamMethodInfo Event signature where
    overloadedMethod _ = eventSetStream

#endif

-- method Event::set_stream_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a stream-start event", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "flags", argType = TInterface (Name {namespace = "Gst", name = "StreamFlags"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the stream flags to set", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_set_stream_flags" gst_event_set_stream_flags ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "StreamFlags"})
    IO ()

{- |
/No description available in the introspection data./

/Since: 1.2/
-}
eventSetStreamFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: a stream-start event -}
    -> [Gst.Flags.StreamFlags]
    {- ^ /@flags@/: the stream flags to set -}
    -> m ()
eventSetStreamFlags event flags = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    let flags' = gflagsToWord flags
    gst_event_set_stream_flags event' flags'
    touchManagedPtr event
    return ()

#if ENABLE_OVERLOADING
data EventSetStreamFlagsMethodInfo
instance (signature ~ ([Gst.Flags.StreamFlags] -> m ()), MonadIO m) => O.MethodInfo EventSetStreamFlagsMethodInfo Event signature where
    overloadedMethod _ = eventSetStreamFlags

#endif

-- method Event::writable_structure
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "event", argType = TInterface (Name {namespace = "Gst", name = "Event"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstEvent.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Structure"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_event_writable_structure" gst_event_writable_structure ::
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    IO (Ptr Gst.Structure.Structure)

{- |
Get a writable version of the structure.
-}
eventWritableStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    {- ^ /@event@/: The 'GI.Gst.Structs.Event.Event'. -}
    -> m Gst.Structure.Structure
    {- ^ __Returns:__ The structure of the event. The structure
is still owned by the event, which means that you should not free
it and that the pointer becomes invalid when you free the event.
This function checks if /@event@/ is writable and will never return
'Nothing'.

MT safe. -}
eventWritableStructure event = liftIO $ do
    event' <- unsafeManagedPtrGetPtr event
    result <- gst_event_writable_structure event'
    checkUnexpectedReturnNULL "eventWritableStructure" result
    result' <- (newBoxed Gst.Structure.Structure) result
    touchManagedPtr event
    return result'

#if ENABLE_OVERLOADING
data EventWritableStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.MethodInfo EventWritableStructureMethodInfo Event signature where
    overloadedMethod _ = eventWritableStructure

#endif

#if ENABLE_OVERLOADING
type family ResolveEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveEventMethod "copySegment" o = EventCopySegmentMethodInfo
    ResolveEventMethod "hasName" o = EventHasNameMethodInfo
    ResolveEventMethod "parseBufferSize" o = EventParseBufferSizeMethodInfo
    ResolveEventMethod "parseCaps" o = EventParseCapsMethodInfo
    ResolveEventMethod "parseFlushStop" o = EventParseFlushStopMethodInfo
    ResolveEventMethod "parseGap" o = EventParseGapMethodInfo
    ResolveEventMethod "parseGroupId" o = EventParseGroupIdMethodInfo
    ResolveEventMethod "parseLatency" o = EventParseLatencyMethodInfo
    ResolveEventMethod "parseProtection" o = EventParseProtectionMethodInfo
    ResolveEventMethod "parseQos" o = EventParseQosMethodInfo
    ResolveEventMethod "parseSeek" o = EventParseSeekMethodInfo
    ResolveEventMethod "parseSeekTrickmodeInterval" o = EventParseSeekTrickmodeIntervalMethodInfo
    ResolveEventMethod "parseSegment" o = EventParseSegmentMethodInfo
    ResolveEventMethod "parseSegmentDone" o = EventParseSegmentDoneMethodInfo
    ResolveEventMethod "parseSelectStreams" o = EventParseSelectStreamsMethodInfo
    ResolveEventMethod "parseSinkMessage" o = EventParseSinkMessageMethodInfo
    ResolveEventMethod "parseStep" o = EventParseStepMethodInfo
    ResolveEventMethod "parseStream" o = EventParseStreamMethodInfo
    ResolveEventMethod "parseStreamCollection" o = EventParseStreamCollectionMethodInfo
    ResolveEventMethod "parseStreamFlags" o = EventParseStreamFlagsMethodInfo
    ResolveEventMethod "parseStreamGroupDone" o = EventParseStreamGroupDoneMethodInfo
    ResolveEventMethod "parseStreamStart" o = EventParseStreamStartMethodInfo
    ResolveEventMethod "parseTag" o = EventParseTagMethodInfo
    ResolveEventMethod "parseToc" o = EventParseTocMethodInfo
    ResolveEventMethod "parseTocSelect" o = EventParseTocSelectMethodInfo
    ResolveEventMethod "writableStructure" o = EventWritableStructureMethodInfo
    ResolveEventMethod "getRunningTimeOffset" o = EventGetRunningTimeOffsetMethodInfo
    ResolveEventMethod "getSeqnum" o = EventGetSeqnumMethodInfo
    ResolveEventMethod "getStructure" o = EventGetStructureMethodInfo
    ResolveEventMethod "setGroupId" o = EventSetGroupIdMethodInfo
    ResolveEventMethod "setRunningTimeOffset" o = EventSetRunningTimeOffsetMethodInfo
    ResolveEventMethod "setSeekTrickmodeInterval" o = EventSetSeekTrickmodeIntervalMethodInfo
    ResolveEventMethod "setSeqnum" o = EventSetSeqnumMethodInfo
    ResolveEventMethod "setStream" o = EventSetStreamMethodInfo
    ResolveEventMethod "setStreamFlags" o = EventSetStreamFlagsMethodInfo
    ResolveEventMethod l o = O.MethodResolutionFailed l o

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

#endif