{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- 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 'P.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");
-- >  ...
-- 

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

module GI.Gst.Structs.Event
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copySegment]("GI.Gst.Structs.Event#g:method:copySegment"), [hasName]("GI.Gst.Structs.Event#g:method:hasName"), [hasNameId]("GI.Gst.Structs.Event#g:method:hasNameId"), [parseBufferSize]("GI.Gst.Structs.Event#g:method:parseBufferSize"), [parseCaps]("GI.Gst.Structs.Event#g:method:parseCaps"), [parseFlushStop]("GI.Gst.Structs.Event#g:method:parseFlushStop"), [parseGap]("GI.Gst.Structs.Event#g:method:parseGap"), [parseGapFlags]("GI.Gst.Structs.Event#g:method:parseGapFlags"), [parseGroupId]("GI.Gst.Structs.Event#g:method:parseGroupId"), [parseInstantRateChange]("GI.Gst.Structs.Event#g:method:parseInstantRateChange"), [parseInstantRateSyncTime]("GI.Gst.Structs.Event#g:method:parseInstantRateSyncTime"), [parseLatency]("GI.Gst.Structs.Event#g:method:parseLatency"), [parseProtection]("GI.Gst.Structs.Event#g:method:parseProtection"), [parseQos]("GI.Gst.Structs.Event#g:method:parseQos"), [parseSeek]("GI.Gst.Structs.Event#g:method:parseSeek"), [parseSeekTrickmodeInterval]("GI.Gst.Structs.Event#g:method:parseSeekTrickmodeInterval"), [parseSegment]("GI.Gst.Structs.Event#g:method:parseSegment"), [parseSegmentDone]("GI.Gst.Structs.Event#g:method:parseSegmentDone"), [parseSelectStreams]("GI.Gst.Structs.Event#g:method:parseSelectStreams"), [parseSinkMessage]("GI.Gst.Structs.Event#g:method:parseSinkMessage"), [parseStep]("GI.Gst.Structs.Event#g:method:parseStep"), [parseStream]("GI.Gst.Structs.Event#g:method:parseStream"), [parseStreamCollection]("GI.Gst.Structs.Event#g:method:parseStreamCollection"), [parseStreamFlags]("GI.Gst.Structs.Event#g:method:parseStreamFlags"), [parseStreamGroupDone]("GI.Gst.Structs.Event#g:method:parseStreamGroupDone"), [parseStreamStart]("GI.Gst.Structs.Event#g:method:parseStreamStart"), [parseTag]("GI.Gst.Structs.Event#g:method:parseTag"), [parseToc]("GI.Gst.Structs.Event#g:method:parseToc"), [parseTocSelect]("GI.Gst.Structs.Event#g:method:parseTocSelect"), [writableStructure]("GI.Gst.Structs.Event#g:method:writableStructure").
-- 
-- ==== Getters
-- [getRunningTimeOffset]("GI.Gst.Structs.Event#g:method:getRunningTimeOffset"), [getSeqnum]("GI.Gst.Structs.Event#g:method:getSeqnum"), [getStructure]("GI.Gst.Structs.Event#g:method:getStructure").
-- 
-- ==== Setters
-- [setGapFlags]("GI.Gst.Structs.Event#g:method:setGapFlags"), [setGroupId]("GI.Gst.Structs.Event#g:method:setGroupId"), [setRunningTimeOffset]("GI.Gst.Structs.Event#g:method:setRunningTimeOffset"), [setSeekTrickmodeInterval]("GI.Gst.Structs.Event#g:method:setSeekTrickmodeInterval"), [setSeqnum]("GI.Gst.Structs.Event#g:method:setSeqnum"), [setStream]("GI.Gst.Structs.Event#g:method:setStream"), [setStreamFlags]("GI.Gst.Structs.Event#g:method:setStreamFlags").

#if defined(ENABLE_OVERLOADING)
    ResolveEventMethod                      ,
#endif

-- ** copySegment #method:copySegment#

#if defined(ENABLE_OVERLOADING)
    EventCopySegmentMethodInfo              ,
#endif
    eventCopySegment                        ,


-- ** getRunningTimeOffset #method:getRunningTimeOffset#

#if defined(ENABLE_OVERLOADING)
    EventGetRunningTimeOffsetMethodInfo     ,
#endif
    eventGetRunningTimeOffset               ,


-- ** getSeqnum #method:getSeqnum#

#if defined(ENABLE_OVERLOADING)
    EventGetSeqnumMethodInfo                ,
#endif
    eventGetSeqnum                          ,


-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    EventGetStructureMethodInfo             ,
#endif
    eventGetStructure                       ,


-- ** hasName #method:hasName#

#if defined(ENABLE_OVERLOADING)
    EventHasNameMethodInfo                  ,
#endif
    eventHasName                            ,


-- ** hasNameId #method:hasNameId#

#if defined(ENABLE_OVERLOADING)
    EventHasNameIdMethodInfo                ,
#endif
    eventHasNameId                          ,


-- ** 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                             ,


-- ** newInstantRateChange #method:newInstantRateChange#

    eventNewInstantRateChange               ,


-- ** newInstantRateSyncTime #method:newInstantRateSyncTime#

    eventNewInstantRateSyncTime             ,


-- ** 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 defined(ENABLE_OVERLOADING)
    EventParseBufferSizeMethodInfo          ,
#endif
    eventParseBufferSize                    ,


-- ** parseCaps #method:parseCaps#

#if defined(ENABLE_OVERLOADING)
    EventParseCapsMethodInfo                ,
#endif
    eventParseCaps                          ,


-- ** parseFlushStop #method:parseFlushStop#

#if defined(ENABLE_OVERLOADING)
    EventParseFlushStopMethodInfo           ,
#endif
    eventParseFlushStop                     ,


-- ** parseGap #method:parseGap#

#if defined(ENABLE_OVERLOADING)
    EventParseGapMethodInfo                 ,
#endif
    eventParseGap                           ,


-- ** parseGapFlags #method:parseGapFlags#

#if defined(ENABLE_OVERLOADING)
    EventParseGapFlagsMethodInfo            ,
#endif
    eventParseGapFlags                      ,


-- ** parseGroupId #method:parseGroupId#

#if defined(ENABLE_OVERLOADING)
    EventParseGroupIdMethodInfo             ,
#endif
    eventParseGroupId                       ,


-- ** parseInstantRateChange #method:parseInstantRateChange#

#if defined(ENABLE_OVERLOADING)
    EventParseInstantRateChangeMethodInfo   ,
#endif
    eventParseInstantRateChange             ,


-- ** parseInstantRateSyncTime #method:parseInstantRateSyncTime#

#if defined(ENABLE_OVERLOADING)
    EventParseInstantRateSyncTimeMethodInfo ,
#endif
    eventParseInstantRateSyncTime           ,


-- ** parseLatency #method:parseLatency#

#if defined(ENABLE_OVERLOADING)
    EventParseLatencyMethodInfo             ,
#endif
    eventParseLatency                       ,


-- ** parseProtection #method:parseProtection#

#if defined(ENABLE_OVERLOADING)
    EventParseProtectionMethodInfo          ,
#endif
    eventParseProtection                    ,


-- ** parseQos #method:parseQos#

#if defined(ENABLE_OVERLOADING)
    EventParseQosMethodInfo                 ,
#endif
    eventParseQos                           ,


-- ** parseSeek #method:parseSeek#

#if defined(ENABLE_OVERLOADING)
    EventParseSeekMethodInfo                ,
#endif
    eventParseSeek                          ,


-- ** parseSeekTrickmodeInterval #method:parseSeekTrickmodeInterval#

#if defined(ENABLE_OVERLOADING)
    EventParseSeekTrickmodeIntervalMethodInfo,
#endif
    eventParseSeekTrickmodeInterval         ,


-- ** parseSegment #method:parseSegment#

#if defined(ENABLE_OVERLOADING)
    EventParseSegmentMethodInfo             ,
#endif
    eventParseSegment                       ,


-- ** parseSegmentDone #method:parseSegmentDone#

#if defined(ENABLE_OVERLOADING)
    EventParseSegmentDoneMethodInfo         ,
#endif
    eventParseSegmentDone                   ,


-- ** parseSelectStreams #method:parseSelectStreams#

#if defined(ENABLE_OVERLOADING)
    EventParseSelectStreamsMethodInfo       ,
#endif
    eventParseSelectStreams                 ,


-- ** parseSinkMessage #method:parseSinkMessage#

#if defined(ENABLE_OVERLOADING)
    EventParseSinkMessageMethodInfo         ,
#endif
    eventParseSinkMessage                   ,


-- ** parseStep #method:parseStep#

#if defined(ENABLE_OVERLOADING)
    EventParseStepMethodInfo                ,
#endif
    eventParseStep                          ,


-- ** parseStream #method:parseStream#

#if defined(ENABLE_OVERLOADING)
    EventParseStreamMethodInfo              ,
#endif
    eventParseStream                        ,


-- ** parseStreamCollection #method:parseStreamCollection#

#if defined(ENABLE_OVERLOADING)
    EventParseStreamCollectionMethodInfo    ,
#endif
    eventParseStreamCollection              ,


-- ** parseStreamFlags #method:parseStreamFlags#

#if defined(ENABLE_OVERLOADING)
    EventParseStreamFlagsMethodInfo         ,
#endif
    eventParseStreamFlags                   ,


-- ** parseStreamGroupDone #method:parseStreamGroupDone#

#if defined(ENABLE_OVERLOADING)
    EventParseStreamGroupDoneMethodInfo     ,
#endif
    eventParseStreamGroupDone               ,


-- ** parseStreamStart #method:parseStreamStart#

#if defined(ENABLE_OVERLOADING)
    EventParseStreamStartMethodInfo         ,
#endif
    eventParseStreamStart                   ,


-- ** parseTag #method:parseTag#

#if defined(ENABLE_OVERLOADING)
    EventParseTagMethodInfo                 ,
#endif
    eventParseTag                           ,


-- ** parseToc #method:parseToc#

#if defined(ENABLE_OVERLOADING)
    EventParseTocMethodInfo                 ,
#endif
    eventParseToc                           ,


-- ** parseTocSelect #method:parseTocSelect#

#if defined(ENABLE_OVERLOADING)
    EventParseTocSelectMethodInfo           ,
#endif
    eventParseTocSelect                     ,


-- ** setGapFlags #method:setGapFlags#

#if defined(ENABLE_OVERLOADING)
    EventSetGapFlagsMethodInfo              ,
#endif
    eventSetGapFlags                        ,


-- ** setGroupId #method:setGroupId#

#if defined(ENABLE_OVERLOADING)
    EventSetGroupIdMethodInfo               ,
#endif
    eventSetGroupId                         ,


-- ** setRunningTimeOffset #method:setRunningTimeOffset#

#if defined(ENABLE_OVERLOADING)
    EventSetRunningTimeOffsetMethodInfo     ,
#endif
    eventSetRunningTimeOffset               ,


-- ** setSeekTrickmodeInterval #method:setSeekTrickmodeInterval#

#if defined(ENABLE_OVERLOADING)
    EventSetSeekTrickmodeIntervalMethodInfo ,
#endif
    eventSetSeekTrickmodeInterval           ,


-- ** setSeqnum #method:setSeqnum#

#if defined(ENABLE_OVERLOADING)
    EventSetSeqnumMethodInfo                ,
#endif
    eventSetSeqnum                          ,


-- ** setStream #method:setStream#

#if defined(ENABLE_OVERLOADING)
    EventSetStreamMethodInfo                ,
#endif
    eventSetStream                          ,


-- ** setStreamFlags #method:setStreamFlags#

#if defined(ENABLE_OVERLOADING)
    EventSetStreamFlagsMethodInfo           ,
#endif
    eventSetStreamFlags                     ,


-- ** writableStructure #method:writableStructure#

#if defined(ENABLE_OVERLOADING)
    EventWritableStructureMethodInfo        ,
#endif
    eventWritableStructure                  ,




 -- * Properties


-- ** miniObject #attr:miniObject#
-- | the parent structure

#if defined(ENABLE_OVERLOADING)
    event_miniObject                        ,
#endif
    getEventMiniObject                      ,


-- ** seqnum #attr:seqnum#
-- | the sequence number of the event

#if defined(ENABLE_OVERLOADING)
    event_seqnum                            ,
#endif
    getEventSeqnum                          ,
    setEventSeqnum                          ,


-- ** timestamp #attr:timestamp#
-- | the timestamp of the event

#if defined(ENABLE_OVERLOADING)
    event_timestamp                         ,
#endif
    getEventTimestamp                       ,
    setEventTimestamp                       ,


-- ** type #attr:type#
-- | the t'GI.Gst.Enums.EventType' of the event

#if defined(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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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 (SP.ManagedPtr Event)
    deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

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

foreign import ccall "gst_event_get_type" c_gst_event_get_type :: 
    IO GType

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

instance B.Types.TypedObject Event where
    glibType :: IO GType
glibType = IO GType
c_gst_event_get_type

instance B.Types.GBoxed Event

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

-- | Construct a `Event` struct initialized to zero.
newZeroEvent :: MonadIO m => m Event
newZeroEvent :: forall (m :: * -> *). MonadIO m => m Event
newZeroEvent = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Event)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
88 IO (Ptr Event) -> (Ptr Event -> IO Event) -> IO Event
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event

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


-- | 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 :: forall (m :: * -> *). MonadIO m => Event -> m MiniObject
getEventMiniObject Event
s = IO MiniObject -> m MiniObject
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MiniObject -> m MiniObject) -> IO MiniObject -> m MiniObject
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO MiniObject) -> IO MiniObject
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO MiniObject) -> IO MiniObject)
-> (Ptr Event -> IO MiniObject) -> IO MiniObject
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    let val :: Ptr MiniObject
val = Ptr Event
ptr Ptr Event -> Int -> Ptr MiniObject
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Gst.MiniObject.MiniObject)
    MiniObject
val' <- ((ManagedPtr MiniObject -> MiniObject)
-> Ptr MiniObject -> IO MiniObject
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr MiniObject -> MiniObject
Gst.MiniObject.MiniObject) Ptr MiniObject
val
    MiniObject -> IO MiniObject
forall (m :: * -> *) a. Monad m => a -> m a
return MiniObject
val'

#if defined(ENABLE_OVERLOADING)
data EventMiniObjectFieldInfo
instance AttrInfo EventMiniObjectFieldInfo where
    type AttrBaseTypeConstraint EventMiniObjectFieldInfo = (~) Event
    type AttrAllowedOps EventMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint EventMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrTransferTypeConstraint EventMiniObjectFieldInfo = (~)(Ptr Gst.MiniObject.MiniObject)
    type AttrTransferType EventMiniObjectFieldInfo = (Ptr Gst.MiniObject.MiniObject)
    type AttrGetType EventMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel EventMiniObjectFieldInfo = "mini_object"
    type AttrOrigin EventMiniObjectFieldInfo = Event
    attrGet = getEventMiniObject
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.miniObject"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#g:attr:miniObject"
        })

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 :: forall (m :: * -> *). MonadIO m => Event -> m EventType
getEventType Event
s = IO EventType -> m EventType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EventType -> m EventType) -> IO EventType -> m EventType
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO EventType) -> IO EventType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO EventType) -> IO EventType)
-> (Ptr Event -> IO EventType) -> IO EventType
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Event
ptr Ptr Event -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO CUInt
    let val' :: EventType
val' = (Int -> EventType
forall a. Enum a => Int -> a
toEnum (Int -> EventType) -> (CUInt -> Int) -> CUInt -> EventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    EventType -> IO EventType
forall (m :: * -> *) a. Monad m => a -> m a
return EventType
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 :: forall (m :: * -> *). MonadIO m => Event -> EventType -> m ()
setEventType Event
s EventType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO ()) -> IO ()) -> (Ptr Event -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (EventType -> Int) -> EventType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventType -> Int
forall a. Enum a => a -> Int
fromEnum) EventType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Event
ptr Ptr Event -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data EventTypeFieldInfo
instance AttrInfo EventTypeFieldInfo where
    type AttrBaseTypeConstraint EventTypeFieldInfo = (~) Event
    type AttrAllowedOps EventTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventTypeFieldInfo = (~) Gst.Enums.EventType
    type AttrTransferTypeConstraint EventTypeFieldInfo = (~)Gst.Enums.EventType
    type AttrTransferType EventTypeFieldInfo = Gst.Enums.EventType
    type AttrGetType EventTypeFieldInfo = Gst.Enums.EventType
    type AttrLabel EventTypeFieldInfo = "type"
    type AttrOrigin EventTypeFieldInfo = Event
    attrGet = getEventType
    attrSet = setEventType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#g:attr:type"
        })

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 :: forall (m :: * -> *). MonadIO m => Event -> m Word64
getEventTimestamp Event
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO Word64) -> IO Word64)
-> (Ptr Event -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Event
ptr Ptr Event -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
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 :: forall (m :: * -> *). MonadIO m => Event -> Word64 -> m ()
setEventTimestamp Event
s Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO ()) -> IO ()) -> (Ptr Event -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Event
ptr Ptr Event -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data EventTimestampFieldInfo
instance AttrInfo EventTimestampFieldInfo where
    type AttrBaseTypeConstraint EventTimestampFieldInfo = (~) Event
    type AttrAllowedOps EventTimestampFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventTimestampFieldInfo = (~) Word64
    type AttrTransferTypeConstraint EventTimestampFieldInfo = (~)Word64
    type AttrTransferType EventTimestampFieldInfo = Word64
    type AttrGetType EventTimestampFieldInfo = Word64
    type AttrLabel EventTimestampFieldInfo = "timestamp"
    type AttrOrigin EventTimestampFieldInfo = Event
    attrGet = getEventTimestamp
    attrSet = setEventTimestamp
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.timestamp"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#g:attr:timestamp"
        })

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 :: forall (m :: * -> *). MonadIO m => Event -> m Word32
getEventSeqnum Event
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO Word32) -> IO Word32)
-> (Ptr Event -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Event
ptr Ptr Event -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
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 :: forall (m :: * -> *). MonadIO m => Event -> Word32 -> m ()
setEventSeqnum Event
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Event -> (Ptr Event -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Event
s ((Ptr Event -> IO ()) -> IO ()) -> (Ptr Event -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Event
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Event
ptr Ptr Event -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
80) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data EventSeqnumFieldInfo
instance AttrInfo EventSeqnumFieldInfo where
    type AttrBaseTypeConstraint EventSeqnumFieldInfo = (~) Event
    type AttrAllowedOps EventSeqnumFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventSeqnumFieldInfo = (~) Word32
    type AttrTransferTypeConstraint EventSeqnumFieldInfo = (~)Word32
    type AttrTransferType EventSeqnumFieldInfo = Word32
    type AttrGetType EventSeqnumFieldInfo = Word32
    type AttrLabel EventSeqnumFieldInfo = "seqnum"
    type AttrOrigin EventSeqnumFieldInfo = Event
    attrGet = getEventSeqnum
    attrSet = setEventSeqnum
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.seqnum"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#g:attr:seqnum"
        })

event_seqnum :: AttrLabelProxy "seqnum"
event_seqnum = AttrLabelProxy

#endif



#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewBufferSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Format -> Int64 -> Int64 -> Bool -> m Event
eventNewBufferSize Format
format Int64
minsize Int64
maxsize Bool
async = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let async' :: CInt
async' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
async
    Ptr Event
result <- CUInt -> Int64 -> Int64 -> CInt -> IO (Ptr Event)
gst_event_new_buffer_size CUInt
format' Int64
minsize Int64
maxsize CInt
async'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewBufferSize" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Caps.Caps'
    -> m (Maybe Event)
    -- ^ __Returns:__ the new CAPS event.
eventNewCaps :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Caps -> m (Maybe Event)
eventNewCaps Caps
caps = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Event
result <- Ptr Caps -> IO (Ptr Event)
gst_event_new_caps Ptr Caps
caps'
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
EventType -> Structure -> m (Maybe Event)
eventNewCustom EventType
type_ Structure
structure = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (EventType -> Int) -> EventType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventType -> Int
forall a. Enum a => a -> Int
fromEnum) EventType
type_
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Event
result <- CUInt -> Ptr Structure -> IO (Ptr Event)
gst_event_new_custom CUInt
type_' Ptr Structure
structure'
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(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 t'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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Event
eventNewEos  = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- IO (Ptr Event)
gst_event_new_eos
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewEos" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 'P.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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Event
eventNewFlushStart  = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- IO (Ptr Event)
gst_event_new_flush_start
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewFlushStart" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Bool -> m Event
eventNewFlushStop Bool
resetTime = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    let resetTime' :: CInt
resetTime' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
resetTime
    Ptr Event
result <- CInt -> IO (Ptr Event)
gst_event_new_flush_stop CInt
resetTime'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewFlushStop" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word64 -> Word64 -> m Event
eventNewGap Word64
timestamp Word64
duration = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- Word64 -> Word64 -> IO (Ptr Event)
gst_event_new_gap Word64
timestamp Word64
duration
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewGap" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Event::new_instant_rate_change
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "rate_multiplier"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the multiplier to be applied to the playback rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SegmentFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A new subset of segment flags to replace in segments"
--                 , 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_instant_rate_change" gst_event_new_instant_rate_change :: 
    CDouble ->                              -- rate_multiplier : TBasicType TDouble
    CUInt ->                                -- new_flags : TInterface (Name {namespace = "Gst", name = "SegmentFlags"})
    IO (Ptr Event)

-- | Create a new instant-rate-change event. This event is sent by seek
-- handlers (e.g. demuxers) when receiving a seek with the
-- 'GI.Gst.Flags.SeekFlagsInstantRateChange' and signals to downstream elements that
-- the playback rate in the existing segment should be immediately multiplied
-- by the /@rateMultiplier@/ factor.
-- 
-- The flags provided replace any flags in the existing segment, for the
-- flags within the 'GI.Gst.Constants.SEGMENT_INSTANT_FLAGS' set. Other GstSegmentFlags
-- are ignored and not transferred in the event.
-- 
-- /Since: 1.18/
eventNewInstantRateChange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    -- ^ /@rateMultiplier@/: the multiplier to be applied to the playback rate
    -> [Gst.Flags.SegmentFlags]
    -- ^ /@newFlags@/: A new subset of segment flags to replace in segments
    -> m Event
    -- ^ __Returns:__ the new instant-rate-change event.
eventNewInstantRateChange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double -> [SegmentFlags] -> m Event
eventNewInstantRateChange Double
rateMultiplier [SegmentFlags]
newFlags = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    let rateMultiplier' :: CDouble
rateMultiplier' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rateMultiplier
    let newFlags' :: CUInt
newFlags' = [SegmentFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SegmentFlags]
newFlags
    Ptr Event
result <- CDouble -> CUInt -> IO (Ptr Event)
gst_event_new_instant_rate_change CDouble
rateMultiplier' CUInt
newFlags'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewInstantRateChange" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Event::new_instant_rate_sync_time
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "rate_multiplier"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the new playback rate multiplier to be applied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Running time when the rate change should be applied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "upstream_running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The upstream-centric running-time when the\n   rate change should be applied."
--                 , 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_instant_rate_sync_time" gst_event_new_instant_rate_sync_time :: 
    CDouble ->                              -- rate_multiplier : TBasicType TDouble
    Word64 ->                               -- running_time : TBasicType TUInt64
    Word64 ->                               -- upstream_running_time : TBasicType TUInt64
    IO (Ptr Event)

-- | Create a new instant-rate-sync-time event. This event is sent by the
-- pipeline to notify elements handling the instant-rate-change event about
-- the running-time when the new rate should be applied. The running time
-- may be in the past when elements handle this event, which can lead to
-- switching artifacts. The magnitude of those depends on the exact timing
-- of event delivery to each element and the magnitude of the change in
-- playback rate being applied.
-- 
-- The /@runningTime@/ and /@upstreamRunningTime@/ are the same if this
-- is the first instant-rate adjustment, but will differ for later ones
-- to compensate for the accumulated offset due to playing at a rate
-- different to the one indicated in the playback segments.
-- 
-- /Since: 1.18/
eventNewInstantRateSyncTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    -- ^ /@rateMultiplier@/: the new playback rate multiplier to be applied
    -> Word64
    -- ^ /@runningTime@/: Running time when the rate change should be applied
    -> Word64
    -- ^ /@upstreamRunningTime@/: The upstream-centric running-time when the
    --    rate change should be applied.
    -> m Event
    -- ^ __Returns:__ the new instant-rate-sync-time event.
eventNewInstantRateSyncTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double -> Word64 -> Word64 -> m Event
eventNewInstantRateSyncTime Double
rateMultiplier Word64
runningTime Word64
upstreamRunningTime = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    let rateMultiplier' :: CDouble
rateMultiplier' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rateMultiplier
    Ptr Event
result <- CDouble -> Word64 -> Word64 -> IO (Ptr Event)
gst_event_new_instant_rate_sync_time CDouble
rateMultiplier' Word64
runningTime Word64
upstreamRunningTime
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewInstantRateSyncTime" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewLatency :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word64 -> m Event
eventNewLatency Word64
latency = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- Word64 -> IO (Ptr Event)
gst_event_new_latency Word64
latency
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewLatency" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewNavigation :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Structure -> m Event
eventNewNavigation Structure
structure = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Event
result <- Ptr Structure -> IO (Ptr Event)
gst_event_new_navigation Ptr Structure
structure'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewNavigation" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'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; 'P.Nothing'
    -- if unsuccessful.
eventNewProtection :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Buffer -> Text -> m Event
eventNewProtection Text
systemId Buffer
data_ Text
origin = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    CString
systemId' <- Text -> IO CString
textToCString Text
systemId
    Ptr Buffer
data_' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
data_
    CString
origin' <- Text -> IO CString
textToCString Text
origin
    Ptr Event
result <- CString -> Ptr Buffer -> CString -> IO (Ptr Event)
gst_event_new_protection CString
systemId' Ptr Buffer
data_' CString
origin'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewProtection" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
data_
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
systemId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
origin'
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
QOSType -> Double -> Int64 -> Word64 -> m (Maybe Event)
eventNewQos QOSType
type_ Double
proportion Int64
diff Word64
timestamp = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (QOSType -> Int) -> QOSType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QOSType -> Int
forall a. Enum a => a -> Int
fromEnum) QOSType
type_
    let proportion' :: CDouble
proportion' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
proportion
    Ptr Event
result <- CUInt -> CDouble -> Int64 -> Word64 -> IO (Ptr Event)
gst_event_new_qos CUInt
type_' CDouble
proportion' Int64
diff Word64
timestamp
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewReconfigure :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Event
eventNewReconfigure  = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- IO (Ptr Event)
gst_event_new_reconfigure
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewReconfigure" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double
-> Format
-> [SeekFlags]
-> SeekType
-> Int64
-> SeekType
-> Int64
-> m (Maybe Event)
eventNewSeek Double
rate Format
format [SeekFlags]
flags SeekType
startType Int64
start SeekType
stopType Int64
stop = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    let rate' :: CDouble
rate' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rate
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let flags' :: CUInt
flags' = [SeekFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SeekFlags]
flags
    let startType' :: CUInt
startType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
startType
    let stopType' :: CUInt
stopType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SeekType -> Int) -> SeekType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeekType -> Int
forall a. Enum a => a -> Int
fromEnum) SeekType
stopType
    Ptr Event
result <- CDouble
-> CUInt
-> CUInt
-> CUInt
-> Int64
-> CUInt
-> Int64
-> IO (Ptr Event)
gst_event_new_seek CDouble
rate' CUInt
format' CUInt
flags' CUInt
startType' Int64
start CUInt
stopType' Int64
stop
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(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 t'GI.Gst.Structs.Segment.Segment'
    -> m (Maybe Event)
    -- ^ __Returns:__ the new SEGMENT event.
eventNewSegment :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Segment -> m (Maybe Event)
eventNewSegment Segment
segment = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    Ptr Event
result <- Ptr Segment -> IO (Ptr Event)
gst_event_new_segment Ptr Segment
segment'
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewSegmentDone :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Format -> Int64 -> m Event
eventNewSegmentDone Format
format Int64
position = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    Ptr Event
result <- CUInt -> Int64 -> IO (Ptr Event)
gst_event_new_segment_done CUInt
format' Int64
position
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewSegmentDone" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'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 'P.Nothing' in case of
    -- an error (like an empty streams list).
eventNewSelectStreams :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Text] -> m Event
eventNewSelectStreams [Text]
streams = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    [CString]
streams' <- (Text -> IO CString) -> [Text] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO CString
textToCString [Text]
streams
    Ptr (GList CString)
streams'' <- [CString] -> IO (Ptr (GList CString))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [CString]
streams'
    Ptr Event
result <- Ptr (GList CString) -> IO (Ptr Event)
gst_event_new_select_streams Ptr (GList CString)
streams''
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewSelectStreams" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
streams''
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
streams''
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Message.Message' to be posted
    -> m Event
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Event.Event'
eventNewSinkMessage :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Message -> m Event
eventNewSinkMessage Text
name Message
msg = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Message
msg' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
msg
    Ptr Event
result <- CString -> Ptr Message -> IO (Ptr Event)
gst_event_new_sink_message CString
name' Ptr Message
msg'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewSinkMessage" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewStep :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Format -> Word64 -> Double -> Bool -> Bool -> m (Maybe Event)
eventNewStep Format
format Word64
amount Double
rate Bool
flush Bool
intermediate = IO (Maybe Event) -> m (Maybe Event)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Event) -> m (Maybe Event))
-> IO (Maybe Event) -> m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
format
    let rate' :: CDouble
rate' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rate
    let flush' :: CInt
flush' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
flush
    let intermediate' :: CInt
intermediate' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
intermediate
    Ptr Event
result <- CUInt -> Word64 -> CDouble -> CInt -> CInt -> IO (Ptr Event)
gst_event_new_step CUInt
format' Word64
amount CDouble
rate' CInt
flush' CInt
intermediate'
    Maybe Event
maybeResult <- Ptr Event -> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Event
result ((Ptr Event -> IO Event) -> IO (Maybe Event))
-> (Ptr Event -> IO Event) -> IO (Maybe Event)
forall a b. (a -> b) -> a -> b
$ \Ptr Event
result' -> do
        Event
result'' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result'
        Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result''
    Maybe Event -> IO (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
maybeResult

#if defined(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 t'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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStreamCollection a) =>
a -> m Event
eventNewStreamCollection a
collection = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr StreamCollection
collection' <- a -> IO (Ptr StreamCollection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
collection
    Ptr Event
result <- Ptr StreamCollection -> IO (Ptr Event)
gst_event_new_stream_collection Ptr StreamCollection
collection'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewStreamCollection" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
collection
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Event
eventNewStreamGroupDone Word32
groupId = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
result <- Word32 -> IO (Ptr Event)
gst_event_new_stream_group_done Word32
groupId
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewStreamGroupDone" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Event
eventNewStreamStart Text
streamId = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    CString
streamId' <- Text -> IO CString
textToCString Text
streamId
    Ptr Event
result <- CString -> IO (Ptr Event)
gst_event_new_stream_start CString
streamId'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewStreamStart" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
streamId'
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Event.Event'
eventNewTag :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TagList -> m Event
eventNewTag TagList
taglist = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr TagList
taglist' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TagList
taglist
    Ptr Event
result <- Ptr TagList -> IO (Ptr Event)
gst_event_new_tag Ptr TagList
taglist'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewTag" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
taglist
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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@/: t'GI.Gst.Structs.Toc.Toc' structure.
    -> Bool
    -- ^ /@updated@/: whether /@toc@/ was updated or not.
    -> m Event
    -- ^ __Returns:__ a new t'GI.Gst.Structs.Event.Event'.
eventNewToc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Toc -> Bool -> m Event
eventNewToc Toc
toc Bool
updated = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toc
toc' <- Toc -> IO (Ptr Toc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Toc
toc
    let updated' :: CInt
updated' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
updated
    Ptr Event
result <- Ptr Toc -> CInt -> IO (Ptr Event)
gst_event_new_toc Ptr Toc
toc' CInt
updated'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewToc" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'GI.Gst.Structs.Event.Event'.
eventNewTocSelect :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Event
eventNewTocSelect Text
uid = IO Event -> m Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> m Event) -> IO Event -> m Event
forall a b. (a -> b) -> a -> b
$ do
    CString
uid' <- Text -> IO CString
textToCString Text
uid
    Ptr Event
result <- CString -> IO (Ptr Event)
gst_event_new_toc_select CString
uid'
    Text -> Ptr Event -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventNewTocSelect" Ptr Event
result
    Event
result' <- ((ManagedPtr Event -> Event) -> Ptr Event -> IO Event
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Event -> Event
Event) Ptr Event
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uid'
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return Event
result'

#if defined(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 t'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 t'GI.Gst.Structs.Segment.Segment'
    -> m ()
eventCopySegment :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Segment -> m ()
eventCopySegment Event
event Segment
segment = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    Ptr Event -> Ptr Segment -> IO ()
gst_event_copy_segment Ptr Event
event' Ptr Segment
segment'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventCopySegmentMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventCopySegment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event'.
    -> m Int64
    -- ^ __Returns:__ The event\'s running time offset
    -- 
    -- MT safe.
eventGetRunningTimeOffset :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Event -> m Int64
eventGetRunningTimeOffset Event
event = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Int64
result <- Ptr Event -> IO Int64
gst_event_get_running_time_offset Ptr Event
event'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

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

instance O.OverloadedMethodInfo EventGetRunningTimeOffsetMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventGetRunningTimeOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event'.
    -> m Word32
    -- ^ __Returns:__ The event\'s sequence number.
    -- 
    -- MT safe.
eventGetSeqnum :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Word32
eventGetSeqnum Event
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Word32
result <- Ptr Event -> IO Word32
gst_event_get_seqnum Ptr Event
event'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

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

instance O.OverloadedMethodInfo EventGetSeqnumMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventGetSeqnum",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Maybe Structure)
eventGetStructure Event
event = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Structure
result <- Ptr Event -> IO (Ptr Structure)
gst_event_get_structure Ptr Event
event'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

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

instance O.OverloadedMethodInfo EventGetStructureMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventGetStructure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event'.
    -> T.Text
    -- ^ /@name@/: name to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@name@/ matches the name of the event structure.
eventHasName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Text -> m Bool
eventHasName Event
event Text
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Event -> CString -> IO CInt
gst_event_has_name Ptr Event
event' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo EventHasNameMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventHasName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventHasName"
        })


#endif

-- method Event::has_name_id
-- 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 TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name to check as a GQuark"
--                 , 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_id" gst_event_has_name_id :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Word32 ->                               -- name : TBasicType TUInt32
    IO CInt

-- | Checks if /@event@/ has the given /@name@/. This function is usually used to
-- check the name of a custom event.
-- 
-- /Since: 1.18/
eventHasNameId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -- ^ /@event@/: The t'GI.Gst.Structs.Event.Event'.
    -> Word32
    -- ^ /@name@/: name to check as a GQuark
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@name@/ matches the name of the event structure.
eventHasNameId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Word32 -> m Bool
eventHasNameId Event
event Word32
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    CInt
result <- Ptr Event -> Word32 -> IO CInt
gst_event_has_name_id Ptr Event
event' Word32
name
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EventHasNameIdMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod EventHasNameIdMethodInfo Event signature where
    overloadedMethod = eventHasNameId

instance O.OverloadedMethodInfo EventHasNameIdMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventHasNameId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventHasNameId"
        })


#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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Format, Int64, Int64, Bool)
eventParseBufferSize Event
event = IO (Format, Int64, Int64, Bool) -> m (Format, Int64, Int64, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Int64, Int64, Bool) -> m (Format, Int64, Int64, Bool))
-> IO (Format, Int64, Int64, Bool)
-> m (Format, Int64, Int64, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
minsize <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Int64
maxsize <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr CInt
async <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Event
-> Ptr CUInt -> Ptr Int64 -> Ptr Int64 -> Ptr CInt -> IO ()
gst_event_parse_buffer_size Ptr Event
event' Ptr CUInt
format Ptr Int64
minsize Ptr Int64
maxsize Ptr CInt
async
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Int64
minsize' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
minsize
    Int64
maxsize' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
maxsize
    CInt
async' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
async
    let async'' :: Bool
async'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
async'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
minsize
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
maxsize
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
async
    (Format, Int64, Int64, Bool) -> IO (Format, Int64, Int64, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Int64
minsize', Int64
maxsize', Bool
async'')

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

instance O.OverloadedMethodInfo EventParseBufferSizeMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseBufferSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Event -> m Caps
eventParseCaps Event
event = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr Caps)
caps <- IO (Ptr (Ptr Caps))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Caps.Caps))
    Ptr Event -> Ptr (Ptr Caps) -> IO ()
gst_event_parse_caps Ptr Event
event' Ptr (Ptr Caps)
caps
    Ptr Caps
caps' <- Ptr (Ptr Caps) -> IO (Ptr Caps)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Caps)
caps
    Caps
caps'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
caps'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr Caps) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Caps)
caps
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
caps''

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

instance O.OverloadedMethodInfo EventParseCapsMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseCaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Event -> m Bool
eventParseFlushStop Event
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CInt
resetTime <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Event -> Ptr CInt -> IO ()
gst_event_parse_flush_stop Ptr Event
event' Ptr CInt
resetTime
    CInt
resetTime' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
resetTime
    let resetTime'' :: Bool
resetTime'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
resetTime'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
resetTime
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
resetTime''

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

instance O.OverloadedMethodInfo EventParseFlushStopMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseFlushStop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event' of type @/GST_EVENT_GAP/@
    -> m ((Word64, Word64))
eventParseGap :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Word64, Word64)
eventParseGap Event
event = IO (Word64, Word64) -> m (Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64) -> m (Word64, Word64))
-> IO (Word64, Word64) -> m (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Word64
timestamp <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
duration <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Event -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_event_parse_gap Ptr Event
event' Ptr Word64
timestamp Ptr Word64
duration
    Word64
timestamp' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
timestamp
    Word64
duration' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
duration
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
timestamp
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
duration
    (Word64, Word64) -> IO (Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
timestamp', Word64
duration')

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

instance O.OverloadedMethodInfo EventParseGapMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseGap",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventParseGap"
        })


#endif

-- method Event::parse_gap_flags
-- 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 = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "GapFlags" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstGapFlags 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_flags" gst_event_parse_gap_flags :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CUInt ->                            -- flags : TInterface (Name {namespace = "Gst", name = "GapFlags"})
    IO ()

-- | Retrieve the gap flags that may have been set on a gap event with
-- 'GI.Gst.Structs.Event.eventSetGapFlags'.
-- 
-- /Since: 1.20/
eventParseGapFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -- ^ /@event@/: a t'GI.Gst.Structs.Event.Event' of type @/GST_EVENT_GAP/@
    -> m ([Gst.Flags.GapFlags])
eventParseGapFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m [GapFlags]
eventParseGapFlags Event
event = IO [GapFlags] -> m [GapFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GapFlags] -> m [GapFlags]) -> IO [GapFlags] -> m [GapFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Event -> Ptr CUInt -> IO ()
gst_event_parse_gap_flags Ptr Event
event' Ptr CUInt
flags
    CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
    let flags'' :: [GapFlags]
flags'' = CUInt -> [GapFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
    [GapFlags] -> IO [GapFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [GapFlags]
flags''

#if defined(ENABLE_OVERLOADING)
data EventParseGapFlagsMethodInfo
instance (signature ~ (m ([Gst.Flags.GapFlags])), MonadIO m) => O.OverloadedMethod EventParseGapFlagsMethodInfo Event signature where
    overloadedMethod = eventParseGapFlags

instance O.OverloadedMethodInfo EventParseGapFlagsMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseGapFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventParseGapFlags"
        })


#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:__ 'P.True' if a group id was set on the event and could be parsed,
    --   'P.False' otherwise.
eventParseGroupId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Bool, Word32)
eventParseGroupId Event
event = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Word32
groupId <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Event -> Ptr Word32 -> IO CInt
gst_event_parse_group_id Ptr Event
event' Ptr Word32
groupId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
groupId' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
groupId
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
groupId
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
groupId')

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

instance O.OverloadedMethodInfo EventParseGroupIdMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseGroupId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventParseGroupId"
        })


#endif

-- method Event::parse_instant_rate_change
-- 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_INSTANT_RATE_CHANGE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate_multiplier"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location in which to store the rate\n    multiplier of the instant-rate-change event, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "new_flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "SegmentFlags" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location in which to store the new\n    segment flags of the instant-rate-change event, 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_instant_rate_change" gst_event_parse_instant_rate_change :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CDouble ->                          -- rate_multiplier : TBasicType TDouble
    Ptr CUInt ->                            -- new_flags : TInterface (Name {namespace = "Gst", name = "SegmentFlags"})
    IO ()

-- | Extract rate and flags from an instant-rate-change event.
-- 
-- /Since: 1.18/
eventParseInstantRateChange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -- ^ /@event@/: a t'GI.Gst.Structs.Event.Event' of type @/GST_EVENT_INSTANT_RATE_CHANGE/@
    -> m ((Double, [Gst.Flags.SegmentFlags]))
eventParseInstantRateChange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Double, [SegmentFlags])
eventParseInstantRateChange Event
event = IO (Double, [SegmentFlags]) -> m (Double, [SegmentFlags])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, [SegmentFlags]) -> m (Double, [SegmentFlags]))
-> IO (Double, [SegmentFlags]) -> m (Double, [SegmentFlags])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CDouble
rateMultiplier <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CUInt
newFlags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Event -> Ptr CDouble -> Ptr CUInt -> IO ()
gst_event_parse_instant_rate_change Ptr Event
event' Ptr CDouble
rateMultiplier Ptr CUInt
newFlags
    CDouble
rateMultiplier' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rateMultiplier
    let rateMultiplier'' :: Double
rateMultiplier'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rateMultiplier'
    CUInt
newFlags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
newFlags
    let newFlags'' :: [SegmentFlags]
newFlags'' = CUInt -> [SegmentFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
newFlags'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rateMultiplier
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
newFlags
    (Double, [SegmentFlags]) -> IO (Double, [SegmentFlags])
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
rateMultiplier'', [SegmentFlags]
newFlags'')

#if defined(ENABLE_OVERLOADING)
data EventParseInstantRateChangeMethodInfo
instance (signature ~ (m ((Double, [Gst.Flags.SegmentFlags]))), MonadIO m) => O.OverloadedMethod EventParseInstantRateChangeMethodInfo Event signature where
    overloadedMethod = eventParseInstantRateChange

instance O.OverloadedMethodInfo EventParseInstantRateChangeMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseInstantRateChange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventParseInstantRateChange"
        })


#endif

-- method Event::parse_instant_rate_sync_time
-- 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_INSTANT_RATE_CHANGE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate_multiplier"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location where to store the rate of\n    the instant-rate-sync-time event, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location in which to store the running time\n    of the instant-rate-sync-time event, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "upstream_running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location in which to store the\n    upstream running time of the instant-rate-sync-time event, 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_instant_rate_sync_time" gst_event_parse_instant_rate_sync_time :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    Ptr CDouble ->                          -- rate_multiplier : TBasicType TDouble
    Ptr Word64 ->                           -- running_time : TBasicType TUInt64
    Ptr Word64 ->                           -- upstream_running_time : TBasicType TUInt64
    IO ()

-- | Extract the rate multiplier and running times from an instant-rate-sync-time event.
-- 
-- /Since: 1.18/
eventParseInstantRateSyncTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -- ^ /@event@/: a t'GI.Gst.Structs.Event.Event' of type @/GST_EVENT_INSTANT_RATE_CHANGE/@
    -> m ((Double, Word64, Word64))
eventParseInstantRateSyncTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Double, Word64, Word64)
eventParseInstantRateSyncTime Event
event = IO (Double, Word64, Word64) -> m (Double, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Word64, Word64) -> m (Double, Word64, Word64))
-> IO (Double, Word64, Word64) -> m (Double, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CDouble
rateMultiplier <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Word64
runningTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
upstreamRunningTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Event -> Ptr CDouble -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_event_parse_instant_rate_sync_time Ptr Event
event' Ptr CDouble
rateMultiplier Ptr Word64
runningTime Ptr Word64
upstreamRunningTime
    CDouble
rateMultiplier' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rateMultiplier
    let rateMultiplier'' :: Double
rateMultiplier'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rateMultiplier'
    Word64
runningTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
runningTime
    Word64
upstreamRunningTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
upstreamRunningTime
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rateMultiplier
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
runningTime
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
upstreamRunningTime
    (Double, Word64, Word64) -> IO (Double, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
rateMultiplier'', Word64
runningTime', Word64
upstreamRunningTime')

#if defined(ENABLE_OVERLOADING)
data EventParseInstantRateSyncTimeMethodInfo
instance (signature ~ (m ((Double, Word64, Word64))), MonadIO m) => O.OverloadedMethod EventParseInstantRateSyncTimeMethodInfo Event signature where
    overloadedMethod = eventParseInstantRateSyncTime

instance O.OverloadedMethodInfo EventParseInstantRateSyncTimeMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseInstantRateSyncTime",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventParseInstantRateSyncTime"
        })


#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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Word64
eventParseLatency Event
event = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Word64
latency <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Event -> Ptr Word64 -> IO ()
gst_event_parse_latency Ptr Event
event' Ptr Word64
latency
    Word64
latency' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
latency
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
latency
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
latency'

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

instance O.OverloadedMethodInfo EventParseLatencyMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseLatency",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Text, Buffer, Maybe Text)
eventParseProtection Event
event = IO (Text, Buffer, Maybe Text) -> m (Text, Buffer, Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Buffer, Maybe Text) -> m (Text, Buffer, Maybe Text))
-> IO (Text, Buffer, Maybe Text) -> m (Text, Buffer, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CString
systemId <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr (Ptr Buffer)
data_ <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Buffer.Buffer))
    Ptr CString
origin <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Event
-> Ptr CString -> Ptr (Ptr Buffer) -> Ptr CString -> IO ()
gst_event_parse_protection Ptr Event
event' Ptr CString
systemId Ptr (Ptr Buffer)
data_ Ptr CString
origin
    CString
systemId' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
systemId
    Text
systemId'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
systemId'
    Ptr Buffer
data_' <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Buffer)
data_
    Buffer
data_'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
data_'
    CString
origin' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
origin
    Maybe Text
maybeOrigin' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
origin' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
origin'' -> do
        Text
origin''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
origin''
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
origin'''
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
systemId
    Ptr (Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Buffer)
data_
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
origin
    (Text, Buffer, Maybe Text) -> IO (Text, Buffer, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
systemId'', Buffer
data_'', Maybe Text
maybeOrigin')

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

instance O.OverloadedMethodInfo EventParseProtectionMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseProtection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (QOSType, Double, Int64, Word64)
eventParseQos Event
event = IO (QOSType, Double, Int64, Word64)
-> m (QOSType, Double, Int64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (QOSType, Double, Int64, Word64)
 -> m (QOSType, Double, Int64, Word64))
-> IO (QOSType, Double, Int64, Word64)
-> m (QOSType, Double, Int64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
type_ <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CDouble
proportion <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Int64
diff <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Word64
timestamp <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Event
-> Ptr CUInt -> Ptr CDouble -> Ptr Int64 -> Ptr Word64 -> IO ()
gst_event_parse_qos Ptr Event
event' Ptr CUInt
type_ Ptr CDouble
proportion Ptr Int64
diff Ptr Word64
timestamp
    CUInt
type_' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
type_
    let type_'' :: QOSType
type_'' = (Int -> QOSType
forall a. Enum a => Int -> a
toEnum (Int -> QOSType) -> (CUInt -> Int) -> CUInt -> QOSType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
type_'
    CDouble
proportion' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
proportion
    let proportion'' :: Double
proportion'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
proportion'
    Int64
diff' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
diff
    Word64
timestamp' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
timestamp
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
type_
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
proportion
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
diff
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
timestamp
    (QOSType, Double, Int64, Word64)
-> IO (QOSType, Double, Int64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (QOSType
type_'', Double
proportion'', Int64
diff', Word64
timestamp')

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

instance O.OverloadedMethodInfo EventParseQosMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseQos",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event
-> m (Double, Format, [SeekFlags], SeekType, Int64, SeekType,
      Int64)
eventParseSeek Event
event = IO (Double, Format, [SeekFlags], SeekType, Int64, SeekType, Int64)
-> m (Double, Format, [SeekFlags], SeekType, Int64, SeekType,
      Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Format, [SeekFlags], SeekType, Int64, SeekType, Int64)
 -> m (Double, Format, [SeekFlags], SeekType, Int64, SeekType,
       Int64))
-> IO
     (Double, Format, [SeekFlags], SeekType, Int64, SeekType, Int64)
-> m (Double, Format, [SeekFlags], SeekType, Int64, SeekType,
      Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CDouble
rate <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
startType <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
start <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr CUInt
stopType <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
stop <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Event
-> Ptr CDouble
-> Ptr CUInt
-> Ptr CUInt
-> Ptr CUInt
-> Ptr Int64
-> Ptr CUInt
-> Ptr Int64
-> IO ()
gst_event_parse_seek Ptr Event
event' Ptr CDouble
rate Ptr CUInt
format Ptr CUInt
flags Ptr CUInt
startType Ptr Int64
start Ptr CUInt
stopType Ptr Int64
stop
    CDouble
rate' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rate
    let rate'' :: Double
rate'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rate'
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
    let flags'' :: [SeekFlags]
flags'' = CUInt -> [SeekFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
    CUInt
startType' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
startType
    let startType'' :: SeekType
startType'' = (Int -> SeekType
forall a. Enum a => Int -> a
toEnum (Int -> SeekType) -> (CUInt -> Int) -> CUInt -> SeekType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
startType'
    Int64
start' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
start
    CUInt
stopType' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
stopType
    let stopType'' :: SeekType
stopType'' = (Int -> SeekType
forall a. Enum a => Int -> a
toEnum (Int -> SeekType) -> (CUInt -> Int) -> CUInt -> SeekType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
stopType'
    Int64
stop' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
stop
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rate
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
startType
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
start
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
stopType
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
stop
    (Double, Format, [SeekFlags], SeekType, Int64, SeekType, Int64)
-> IO
     (Double, Format, [SeekFlags], SeekType, Int64, SeekType, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
rate'', Format
format'', [SeekFlags]
flags'', SeekType
startType'', Int64
start', SeekType
stopType'', Int64
stop')

#if defined(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.OverloadedMethod EventParseSeekMethodInfo Event signature where
    overloadedMethod = eventParseSeek

instance O.OverloadedMethodInfo EventParseSeekMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseSeek",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Word64
eventParseSeekTrickmodeInterval Event
event = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Word64
interval <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Event -> Ptr Word64 -> IO ()
gst_event_parse_seek_trickmode_interval Ptr Event
event' Ptr Word64
interval
    Word64
interval' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
interval
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
interval
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
interval'

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

instance O.OverloadedMethodInfo EventParseSeekTrickmodeIntervalMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseSeekTrickmodeInterval",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Segment
eventParseSegment Event
event = IO Segment -> m Segment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Segment -> m Segment) -> IO Segment -> m Segment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr Segment)
segment <- IO (Ptr (Ptr Segment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Segment.Segment))
    Ptr Event -> Ptr (Ptr Segment) -> IO ()
gst_event_parse_segment Ptr Event
event' Ptr (Ptr Segment)
segment
    Ptr Segment
segment' <- Ptr (Ptr Segment) -> IO (Ptr Segment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Segment)
segment
    Segment
segment'' <- ((ManagedPtr Segment -> Segment) -> Ptr Segment -> IO Segment
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Segment -> Segment
Gst.Segment.Segment) Ptr Segment
segment'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr Segment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Segment)
segment
    Segment -> IO Segment
forall (m :: * -> *) a. Monad m => a -> m a
return Segment
segment''

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

instance O.OverloadedMethodInfo EventParseSegmentMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseSegment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event' of type GST_EVENT_SEGMENT_DONE.
    -> m ((Gst.Enums.Format, Int64))
eventParseSegmentDone :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Format, Int64)
eventParseSegmentDone Event
event = IO (Format, Int64) -> m (Format, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Int64) -> m (Format, Int64))
-> IO (Format, Int64) -> m (Format, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int64
position <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Event -> Ptr CUInt -> Ptr Int64 -> IO ()
gst_event_parse_segment_done Ptr Event
event' Ptr CUInt
format Ptr Int64
position
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Int64
position' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
position
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
position
    (Format, Int64) -> IO (Format, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Int64
position')

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

instance O.OverloadedMethodInfo EventParseSegmentDoneMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseSegmentDone",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m [Text]
eventParseSelectStreams Event
event = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr (GList CString))
streams <- IO (Ptr (Ptr (GList CString)))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr (GList CString)))
    Ptr Event -> Ptr (Ptr (GList CString)) -> IO ()
gst_event_parse_select_streams Ptr Event
event' Ptr (Ptr (GList CString))
streams
    Ptr (GList CString)
streams' <- Ptr (Ptr (GList CString)) -> IO (Ptr (GList CString))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GList CString))
streams
    [CString]
streams'' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
streams'
    [Text]
streams''' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
streams''
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
streams'
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
streams'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr (GList CString)) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList CString))
streams
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
streams'''

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

instance O.OverloadedMethodInfo EventParseSelectStreamsMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseSelectStreams",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Message
eventParseSinkMessage Event
event = IO Message -> m Message
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Message -> m Message) -> IO Message -> m Message
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr Message)
msg <- IO (Ptr (Ptr Message))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Message.Message))
    Ptr Event -> Ptr (Ptr Message) -> IO ()
gst_event_parse_sink_message Ptr Event
event' Ptr (Ptr Message)
msg
    Ptr Message
msg' <- Ptr (Ptr Message) -> IO (Ptr Message)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Message)
msg
    Message
msg'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Gst.Message.Message) Ptr Message
msg'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr Message) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Message)
msg
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
msg''

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

instance O.OverloadedMethodInfo EventParseSinkMessageMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseSinkMessage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Format, Word64, Double, Bool, Bool)
eventParseStep Event
event = IO (Format, Word64, Double, Bool, Bool)
-> m (Format, Word64, Double, Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Word64, Double, Bool, Bool)
 -> m (Format, Word64, Double, Bool, Bool))
-> IO (Format, Word64, Double, Bool, Bool)
-> m (Format, Word64, Double, Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Word64
amount <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CDouble
rate <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CInt
flush <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr CInt
intermediate <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Event
-> Ptr CUInt
-> Ptr Word64
-> Ptr CDouble
-> Ptr CInt
-> Ptr CInt
-> IO ()
gst_event_parse_step Ptr Event
event' Ptr CUInt
format Ptr Word64
amount Ptr CDouble
rate Ptr CInt
flush Ptr CInt
intermediate
    CUInt
format' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
format
    let format'' :: Format
format'' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
format'
    Word64
amount' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
amount
    CDouble
rate' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rate
    let rate'' :: Double
rate'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rate'
    CInt
flush' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
flush
    let flush'' :: Bool
flush'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
flush'
    CInt
intermediate' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
intermediate
    let intermediate'' :: Bool
intermediate'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
intermediate'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
amount
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rate
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
flush
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
intermediate
    (Format, Word64, Double, Bool, Bool)
-> IO (Format, Word64, Double, Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Word64
amount', Double
rate'', Bool
flush'', Bool
intermediate'')

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

instance O.OverloadedMethodInfo EventParseStepMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseStep",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Stream
eventParseStream Event
event = IO Stream -> m Stream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stream -> m Stream) -> IO Stream -> m Stream
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr Stream)
stream <- IO (Ptr (Ptr Stream))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Stream.Stream))
    Ptr Event -> Ptr (Ptr Stream) -> IO ()
gst_event_parse_stream Ptr Event
event' Ptr (Ptr Stream)
stream
    Ptr Stream
stream' <- Ptr (Ptr Stream) -> IO (Ptr Stream)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Stream)
stream
    Stream
stream'' <- ((ManagedPtr Stream -> Stream) -> Ptr Stream -> IO Stream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Stream -> Stream
Gst.Stream.Stream) Ptr Stream
stream'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr Stream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Stream)
stream
    Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
stream''

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

instance O.OverloadedMethodInfo EventParseStreamMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseStream",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m StreamCollection
eventParseStreamCollection Event
event = IO StreamCollection -> m StreamCollection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StreamCollection -> m StreamCollection)
-> IO StreamCollection -> m StreamCollection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr StreamCollection)
collection <- IO (Ptr (Ptr StreamCollection))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.StreamCollection.StreamCollection))
    Ptr Event -> Ptr (Ptr StreamCollection) -> IO ()
gst_event_parse_stream_collection Ptr Event
event' Ptr (Ptr StreamCollection)
collection
    Ptr StreamCollection
collection' <- Ptr (Ptr StreamCollection) -> IO (Ptr StreamCollection)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr StreamCollection)
collection
    StreamCollection
collection'' <- ((ManagedPtr StreamCollection -> StreamCollection)
-> Ptr StreamCollection -> IO StreamCollection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StreamCollection -> StreamCollection
Gst.StreamCollection.StreamCollection) Ptr StreamCollection
collection'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr StreamCollection) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr StreamCollection)
collection
    StreamCollection -> IO StreamCollection
forall (m :: * -> *) a. Monad m => a -> m a
return StreamCollection
collection''

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

instance O.OverloadedMethodInfo EventParseStreamCollectionMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseStreamCollection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m [StreamFlags]
eventParseStreamFlags Event
event = IO [StreamFlags] -> m [StreamFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StreamFlags] -> m [StreamFlags])
-> IO [StreamFlags] -> m [StreamFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CUInt
flags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Event -> Ptr CUInt -> IO ()
gst_event_parse_stream_flags Ptr Event
event' Ptr CUInt
flags
    CUInt
flags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
flags
    let flags'' :: [StreamFlags]
flags'' = CUInt -> [StreamFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
flags
    [StreamFlags] -> IO [StreamFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [StreamFlags]
flags''

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

instance O.OverloadedMethodInfo EventParseStreamFlagsMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseStreamFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Word32
eventParseStreamGroupDone Event
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Word32
groupId <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Event -> Ptr Word32 -> IO ()
gst_event_parse_stream_group_done Ptr Event
event' Ptr Word32
groupId
    Word32
groupId' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
groupId
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
groupId
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
groupId'

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

instance O.OverloadedMethodInfo EventParseStreamGroupDoneMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseStreamGroupDone",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Event -> m Text
eventParseStreamStart Event
event = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CString
streamId <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Event -> Ptr CString -> IO ()
gst_event_parse_stream_start Ptr Event
event' Ptr CString
streamId
    CString
streamId' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
streamId
    Text
streamId'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
streamId'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
streamId
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
streamId''

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

instance O.OverloadedMethodInfo EventParseStreamStartMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseStreamStart",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m TagList
eventParseTag Event
event = IO TagList -> m TagList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TagList -> m TagList) -> IO TagList -> m TagList
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr TagList)
taglist <- IO (Ptr (Ptr TagList))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.TagList.TagList))
    Ptr Event -> Ptr (Ptr TagList) -> IO ()
gst_event_parse_tag Ptr Event
event' Ptr (Ptr TagList)
taglist
    Ptr TagList
taglist' <- Ptr (Ptr TagList) -> IO (Ptr TagList)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr TagList)
taglist
    TagList
taglist'' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
taglist'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr TagList) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr TagList)
taglist
    TagList -> IO TagList
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
taglist''

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

instance O.OverloadedMethodInfo EventParseTagMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseTag",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m (Toc, Bool)
eventParseToc Event
event = IO (Toc, Bool) -> m (Toc, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Toc, Bool) -> m (Toc, Bool))
-> IO (Toc, Bool) -> m (Toc, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr (Ptr Toc)
toc <- IO (Ptr (Ptr Toc))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gst.Toc.Toc))
    Ptr CInt
updated <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Event -> Ptr (Ptr Toc) -> Ptr CInt -> IO ()
gst_event_parse_toc Ptr Event
event' Ptr (Ptr Toc)
toc Ptr CInt
updated
    Ptr Toc
toc' <- Ptr (Ptr Toc) -> IO (Ptr Toc)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Toc)
toc
    Toc
toc'' <- ((ManagedPtr Toc -> Toc) -> Ptr Toc -> IO Toc
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Toc -> Toc
Gst.Toc.Toc) Ptr Toc
toc'
    CInt
updated' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
updated
    let updated'' :: Bool
updated'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
updated'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr (Ptr Toc) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Toc)
toc
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
updated
    (Toc, Bool) -> IO (Toc, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Toc
toc'', Bool
updated'')

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

instance O.OverloadedMethodInfo EventParseTocMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseToc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Event -> m Text
eventParseTocSelect Event
event = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr CString
uid <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Event -> Ptr CString -> IO ()
gst_event_parse_toc_select Ptr Event
event' Ptr CString
uid
    CString
uid' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
uid
    Text
uid'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
uid'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uid'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
uid
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
uid''

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

instance O.OverloadedMethodInfo EventParseTocSelectMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventParseTocSelect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventParseTocSelect"
        })


#endif

-- method Event::set_gap_flags
-- 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 = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "GapFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstGapFlags" , 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_gap_flags" gst_event_set_gap_flags :: 
    Ptr Event ->                            -- event : TInterface (Name {namespace = "Gst", name = "Event"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "GapFlags"})
    IO ()

-- | Sets /@flags@/ on /@event@/ to give additional information about the reason for
-- the @/GST_EVENT_GAP/@.
-- 
-- /Since: 1.20/
eventSetGapFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Event
    -- ^ /@event@/: a t'GI.Gst.Structs.Event.Event' of type @/GST_EVENT_GAP/@
    -> [Gst.Flags.GapFlags]
    -- ^ /@flags@/: a t'GI.Gst.Flags.GapFlags'
    -> m ()
eventSetGapFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> [GapFlags] -> m ()
eventSetGapFlags Event
event [GapFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    let flags' :: CUInt
flags' = [GapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [GapFlags]
flags
    Ptr Event -> CUInt -> IO ()
gst_event_set_gap_flags Ptr Event
event' CUInt
flags'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EventSetGapFlagsMethodInfo
instance (signature ~ ([Gst.Flags.GapFlags] -> m ()), MonadIO m) => O.OverloadedMethod EventSetGapFlagsMethodInfo Event signature where
    overloadedMethod = eventSetGapFlags

instance O.OverloadedMethodInfo EventSetGapFlagsMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetGapFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventSetGapFlags"
        })


#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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Word32 -> m ()
eventSetGroupId Event
event Word32
groupId = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Event -> Word32 -> IO ()
gst_event_set_group_id Ptr Event
event' Word32
groupId
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventSetGroupIdMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetGroupId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event'.
    -> Int64
    -- ^ /@offset@/: A the new running time offset
    -> m ()
eventSetRunningTimeOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Int64 -> m ()
eventSetRunningTimeOffset Event
event Int64
offset = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Event -> Int64 -> IO ()
gst_event_set_running_time_offset Ptr Event
event' Int64
offset
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventSetRunningTimeOffsetMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetRunningTimeOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Word64 -> m ()
eventSetSeekTrickmodeInterval Event
event Word64
interval = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Event -> Word64 -> IO ()
gst_event_set_seek_trickmode_interval Ptr Event
event' Word64
interval
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventSetSeekTrickmodeIntervalMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetSeekTrickmodeInterval",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'GI.Gst.Structs.Event.Event'.
    -> Word32
    -- ^ /@seqnum@/: A sequence number.
    -> m ()
eventSetSeqnum :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> Word32 -> m ()
eventSetSeqnum Event
event Word32
seqnum = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Event -> Word32 -> IO ()
gst_event_set_seqnum Ptr Event
event' Word32
seqnum
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventSetSeqnumMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetSeqnum",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStream a) =>
Event -> a -> m ()
eventSetStream Event
event a
stream = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Event -> Ptr Stream -> IO ()
gst_event_set_stream Ptr Event
event' Ptr Stream
stream'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventSetStreamMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetStream",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> [StreamFlags] -> m ()
eventSetStreamFlags Event
event [StreamFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    let flags' :: CUInt
flags' = [StreamFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StreamFlags]
flags
    Ptr Event -> CUInt -> IO ()
gst_event_set_stream_flags Ptr Event
event' CUInt
flags'
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo EventSetStreamFlagsMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventSetStreamFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v: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 t'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
    -- 'P.Nothing'.
    -- 
    -- MT safe.
eventWritableStructure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Event -> m Structure
eventWritableStructure Event
event = IO Structure -> m Structure
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    Ptr Structure
result <- Ptr Event -> IO (Ptr Structure)
gst_event_writable_structure Ptr Event
event'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"eventWritableStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

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

instance O.OverloadedMethodInfo EventWritableStructureMethodInfo Event where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Event.eventWritableStructure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.25/docs/GI-Gst-Structs-Event.html#v:eventWritableStructure"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveEventMethod "copySegment" o = EventCopySegmentMethodInfo
    ResolveEventMethod "hasName" o = EventHasNameMethodInfo
    ResolveEventMethod "hasNameId" o = EventHasNameIdMethodInfo
    ResolveEventMethod "parseBufferSize" o = EventParseBufferSizeMethodInfo
    ResolveEventMethod "parseCaps" o = EventParseCapsMethodInfo
    ResolveEventMethod "parseFlushStop" o = EventParseFlushStopMethodInfo
    ResolveEventMethod "parseGap" o = EventParseGapMethodInfo
    ResolveEventMethod "parseGapFlags" o = EventParseGapFlagsMethodInfo
    ResolveEventMethod "parseGroupId" o = EventParseGroupIdMethodInfo
    ResolveEventMethod "parseInstantRateChange" o = EventParseInstantRateChangeMethodInfo
    ResolveEventMethod "parseInstantRateSyncTime" o = EventParseInstantRateSyncTimeMethodInfo
    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 "setGapFlags" o = EventSetGapFlagsMethodInfo
    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.OverloadedMethod info Event p) => OL.IsLabel t (Event -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

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

#endif

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

#endif