{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Messages are implemented as a subclass of t'GI.Gst.Structs.MiniObject.MiniObject' with a generic
-- t'GI.Gst.Structs.Structure.Structure' as the content. This allows for writing custom messages without
-- requiring an API change while allowing a wide range of different types
-- of messages.
-- 
-- Messages are posted by objects in the pipeline and are passed to the
-- application using the t'GI.Gst.Objects.Bus.Bus'.
-- 
-- The basic use pattern of posting a message on a t'GI.Gst.Objects.Bus.Bus' is as follows:
-- 
-- === /C code/
-- >
-- >  gst_bus_post (bus, gst_message_new_eos());
-- 
-- 
-- A t'GI.Gst.Objects.Element.Element' usually posts messages on the bus provided by the parent
-- container using 'GI.Gst.Objects.Element.elementPostMessage'.

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

module GI.Gst.Structs.Message
    ( 

-- * Exported types
    Message(..)                             ,
    newZeroMessage                          ,
    noMessage                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMessageMethod                    ,
#endif


-- ** addRedirectEntry #method:addRedirectEntry#

#if defined(ENABLE_OVERLOADING)
    MessageAddRedirectEntryMethodInfo       ,
#endif
    messageAddRedirectEntry                 ,


-- ** getNumRedirectEntries #method:getNumRedirectEntries#

#if defined(ENABLE_OVERLOADING)
    MessageGetNumRedirectEntriesMethodInfo  ,
#endif
    messageGetNumRedirectEntries            ,


-- ** getSeqnum #method:getSeqnum#

#if defined(ENABLE_OVERLOADING)
    MessageGetSeqnumMethodInfo              ,
#endif
    messageGetSeqnum                        ,


-- ** getStreamStatusObject #method:getStreamStatusObject#

#if defined(ENABLE_OVERLOADING)
    MessageGetStreamStatusObjectMethodInfo  ,
#endif
    messageGetStreamStatusObject            ,


-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    MessageGetStructureMethodInfo           ,
#endif
    messageGetStructure                     ,


-- ** hasName #method:hasName#

#if defined(ENABLE_OVERLOADING)
    MessageHasNameMethodInfo                ,
#endif
    messageHasName                          ,


-- ** newApplication #method:newApplication#

    messageNewApplication                   ,


-- ** newAsyncDone #method:newAsyncDone#

    messageNewAsyncDone                     ,


-- ** newAsyncStart #method:newAsyncStart#

    messageNewAsyncStart                    ,


-- ** newBuffering #method:newBuffering#

    messageNewBuffering                     ,


-- ** newClockLost #method:newClockLost#

    messageNewClockLost                     ,


-- ** newClockProvide #method:newClockProvide#

    messageNewClockProvide                  ,


-- ** newCustom #method:newCustom#

    messageNewCustom                        ,


-- ** newDeviceAdded #method:newDeviceAdded#

    messageNewDeviceAdded                   ,


-- ** newDeviceChanged #method:newDeviceChanged#

    messageNewDeviceChanged                 ,


-- ** newDeviceRemoved #method:newDeviceRemoved#

    messageNewDeviceRemoved                 ,


-- ** newDurationChanged #method:newDurationChanged#

    messageNewDurationChanged               ,


-- ** newElement #method:newElement#

    messageNewElement                       ,


-- ** newEos #method:newEos#

    messageNewEos                           ,


-- ** newError #method:newError#

    messageNewError                         ,


-- ** newErrorWithDetails #method:newErrorWithDetails#

    messageNewErrorWithDetails              ,


-- ** newHaveContext #method:newHaveContext#

    messageNewHaveContext                   ,


-- ** newInfo #method:newInfo#

    messageNewInfo                          ,


-- ** newInfoWithDetails #method:newInfoWithDetails#

    messageNewInfoWithDetails               ,


-- ** newLatency #method:newLatency#

    messageNewLatency                       ,


-- ** newNeedContext #method:newNeedContext#

    messageNewNeedContext                   ,


-- ** newNewClock #method:newNewClock#

    messageNewNewClock                      ,


-- ** newProgress #method:newProgress#

    messageNewProgress                      ,


-- ** newPropertyNotify #method:newPropertyNotify#

    messageNewPropertyNotify                ,


-- ** newQos #method:newQos#

    messageNewQos                           ,


-- ** newRedirect #method:newRedirect#

    messageNewRedirect                      ,


-- ** newRequestState #method:newRequestState#

    messageNewRequestState                  ,


-- ** newResetTime #method:newResetTime#

    messageNewResetTime                     ,


-- ** newSegmentDone #method:newSegmentDone#

    messageNewSegmentDone                   ,


-- ** newSegmentStart #method:newSegmentStart#

    messageNewSegmentStart                  ,


-- ** newStateChanged #method:newStateChanged#

    messageNewStateChanged                  ,


-- ** newStateDirty #method:newStateDirty#

    messageNewStateDirty                    ,


-- ** newStepDone #method:newStepDone#

    messageNewStepDone                      ,


-- ** newStepStart #method:newStepStart#

    messageNewStepStart                     ,


-- ** newStreamCollection #method:newStreamCollection#

    messageNewStreamCollection              ,


-- ** newStreamStart #method:newStreamStart#

    messageNewStreamStart                   ,


-- ** newStreamStatus #method:newStreamStatus#

    messageNewStreamStatus                  ,


-- ** newStreamsSelected #method:newStreamsSelected#

    messageNewStreamsSelected               ,


-- ** newStructureChange #method:newStructureChange#

    messageNewStructureChange               ,


-- ** newTag #method:newTag#

    messageNewTag                           ,


-- ** newToc #method:newToc#

    messageNewToc                           ,


-- ** newWarning #method:newWarning#

    messageNewWarning                       ,


-- ** newWarningWithDetails #method:newWarningWithDetails#

    messageNewWarningWithDetails            ,


-- ** parseAsyncDone #method:parseAsyncDone#

#if defined(ENABLE_OVERLOADING)
    MessageParseAsyncDoneMethodInfo         ,
#endif
    messageParseAsyncDone                   ,


-- ** parseBuffering #method:parseBuffering#

#if defined(ENABLE_OVERLOADING)
    MessageParseBufferingMethodInfo         ,
#endif
    messageParseBuffering                   ,


-- ** parseBufferingStats #method:parseBufferingStats#

#if defined(ENABLE_OVERLOADING)
    MessageParseBufferingStatsMethodInfo    ,
#endif
    messageParseBufferingStats              ,


-- ** parseClockLost #method:parseClockLost#

#if defined(ENABLE_OVERLOADING)
    MessageParseClockLostMethodInfo         ,
#endif
    messageParseClockLost                   ,


-- ** parseClockProvide #method:parseClockProvide#

#if defined(ENABLE_OVERLOADING)
    MessageParseClockProvideMethodInfo      ,
#endif
    messageParseClockProvide                ,


-- ** parseContextType #method:parseContextType#

#if defined(ENABLE_OVERLOADING)
    MessageParseContextTypeMethodInfo       ,
#endif
    messageParseContextType                 ,


-- ** parseDeviceAdded #method:parseDeviceAdded#

#if defined(ENABLE_OVERLOADING)
    MessageParseDeviceAddedMethodInfo       ,
#endif
    messageParseDeviceAdded                 ,


-- ** parseDeviceChanged #method:parseDeviceChanged#

#if defined(ENABLE_OVERLOADING)
    MessageParseDeviceChangedMethodInfo     ,
#endif
    messageParseDeviceChanged               ,


-- ** parseDeviceRemoved #method:parseDeviceRemoved#

#if defined(ENABLE_OVERLOADING)
    MessageParseDeviceRemovedMethodInfo     ,
#endif
    messageParseDeviceRemoved               ,


-- ** parseError #method:parseError#

#if defined(ENABLE_OVERLOADING)
    MessageParseErrorMethodInfo             ,
#endif
    messageParseError                       ,


-- ** parseErrorDetails #method:parseErrorDetails#

#if defined(ENABLE_OVERLOADING)
    MessageParseErrorDetailsMethodInfo      ,
#endif
    messageParseErrorDetails                ,


-- ** parseGroupId #method:parseGroupId#

#if defined(ENABLE_OVERLOADING)
    MessageParseGroupIdMethodInfo           ,
#endif
    messageParseGroupId                     ,


-- ** parseHaveContext #method:parseHaveContext#

#if defined(ENABLE_OVERLOADING)
    MessageParseHaveContextMethodInfo       ,
#endif
    messageParseHaveContext                 ,


-- ** parseInfo #method:parseInfo#

#if defined(ENABLE_OVERLOADING)
    MessageParseInfoMethodInfo              ,
#endif
    messageParseInfo                        ,


-- ** parseInfoDetails #method:parseInfoDetails#

#if defined(ENABLE_OVERLOADING)
    MessageParseInfoDetailsMethodInfo       ,
#endif
    messageParseInfoDetails                 ,


-- ** parseNewClock #method:parseNewClock#

#if defined(ENABLE_OVERLOADING)
    MessageParseNewClockMethodInfo          ,
#endif
    messageParseNewClock                    ,


-- ** parseProgress #method:parseProgress#

#if defined(ENABLE_OVERLOADING)
    MessageParseProgressMethodInfo          ,
#endif
    messageParseProgress                    ,


-- ** parsePropertyNotify #method:parsePropertyNotify#

#if defined(ENABLE_OVERLOADING)
    MessageParsePropertyNotifyMethodInfo    ,
#endif
    messageParsePropertyNotify              ,


-- ** parseQos #method:parseQos#

#if defined(ENABLE_OVERLOADING)
    MessageParseQosMethodInfo               ,
#endif
    messageParseQos                         ,


-- ** parseQosStats #method:parseQosStats#

#if defined(ENABLE_OVERLOADING)
    MessageParseQosStatsMethodInfo          ,
#endif
    messageParseQosStats                    ,


-- ** parseQosValues #method:parseQosValues#

#if defined(ENABLE_OVERLOADING)
    MessageParseQosValuesMethodInfo         ,
#endif
    messageParseQosValues                   ,


-- ** parseRedirectEntry #method:parseRedirectEntry#

#if defined(ENABLE_OVERLOADING)
    MessageParseRedirectEntryMethodInfo     ,
#endif
    messageParseRedirectEntry               ,


-- ** parseRequestState #method:parseRequestState#

#if defined(ENABLE_OVERLOADING)
    MessageParseRequestStateMethodInfo      ,
#endif
    messageParseRequestState                ,


-- ** parseResetTime #method:parseResetTime#

#if defined(ENABLE_OVERLOADING)
    MessageParseResetTimeMethodInfo         ,
#endif
    messageParseResetTime                   ,


-- ** parseSegmentDone #method:parseSegmentDone#

#if defined(ENABLE_OVERLOADING)
    MessageParseSegmentDoneMethodInfo       ,
#endif
    messageParseSegmentDone                 ,


-- ** parseSegmentStart #method:parseSegmentStart#

#if defined(ENABLE_OVERLOADING)
    MessageParseSegmentStartMethodInfo      ,
#endif
    messageParseSegmentStart                ,


-- ** parseStateChanged #method:parseStateChanged#

#if defined(ENABLE_OVERLOADING)
    MessageParseStateChangedMethodInfo      ,
#endif
    messageParseStateChanged                ,


-- ** parseStepDone #method:parseStepDone#

#if defined(ENABLE_OVERLOADING)
    MessageParseStepDoneMethodInfo          ,
#endif
    messageParseStepDone                    ,


-- ** parseStepStart #method:parseStepStart#

#if defined(ENABLE_OVERLOADING)
    MessageParseStepStartMethodInfo         ,
#endif
    messageParseStepStart                   ,


-- ** parseStreamCollection #method:parseStreamCollection#

#if defined(ENABLE_OVERLOADING)
    MessageParseStreamCollectionMethodInfo  ,
#endif
    messageParseStreamCollection            ,


-- ** parseStreamStatus #method:parseStreamStatus#

#if defined(ENABLE_OVERLOADING)
    MessageParseStreamStatusMethodInfo      ,
#endif
    messageParseStreamStatus                ,


-- ** parseStreamsSelected #method:parseStreamsSelected#

#if defined(ENABLE_OVERLOADING)
    MessageParseStreamsSelectedMethodInfo   ,
#endif
    messageParseStreamsSelected             ,


-- ** parseStructureChange #method:parseStructureChange#

#if defined(ENABLE_OVERLOADING)
    MessageParseStructureChangeMethodInfo   ,
#endif
    messageParseStructureChange             ,


-- ** parseTag #method:parseTag#

#if defined(ENABLE_OVERLOADING)
    MessageParseTagMethodInfo               ,
#endif
    messageParseTag                         ,


-- ** parseToc #method:parseToc#

#if defined(ENABLE_OVERLOADING)
    MessageParseTocMethodInfo               ,
#endif
    messageParseToc                         ,


-- ** parseWarning #method:parseWarning#

#if defined(ENABLE_OVERLOADING)
    MessageParseWarningMethodInfo           ,
#endif
    messageParseWarning                     ,


-- ** parseWarningDetails #method:parseWarningDetails#

#if defined(ENABLE_OVERLOADING)
    MessageParseWarningDetailsMethodInfo    ,
#endif
    messageParseWarningDetails              ,


-- ** setBufferingStats #method:setBufferingStats#

#if defined(ENABLE_OVERLOADING)
    MessageSetBufferingStatsMethodInfo      ,
#endif
    messageSetBufferingStats                ,


-- ** setGroupId #method:setGroupId#

#if defined(ENABLE_OVERLOADING)
    MessageSetGroupIdMethodInfo             ,
#endif
    messageSetGroupId                       ,


-- ** setQosStats #method:setQosStats#

#if defined(ENABLE_OVERLOADING)
    MessageSetQosStatsMethodInfo            ,
#endif
    messageSetQosStats                      ,


-- ** setQosValues #method:setQosValues#

#if defined(ENABLE_OVERLOADING)
    MessageSetQosValuesMethodInfo           ,
#endif
    messageSetQosValues                     ,


-- ** setSeqnum #method:setSeqnum#

#if defined(ENABLE_OVERLOADING)
    MessageSetSeqnumMethodInfo              ,
#endif
    messageSetSeqnum                        ,


-- ** setStreamStatusObject #method:setStreamStatusObject#

#if defined(ENABLE_OVERLOADING)
    MessageSetStreamStatusObjectMethodInfo  ,
#endif
    messageSetStreamStatusObject            ,


-- ** streamsSelectedAdd #method:streamsSelectedAdd#

#if defined(ENABLE_OVERLOADING)
    MessageStreamsSelectedAddMethodInfo     ,
#endif
    messageStreamsSelectedAdd               ,


-- ** streamsSelectedGetSize #method:streamsSelectedGetSize#

#if defined(ENABLE_OVERLOADING)
    MessageStreamsSelectedGetSizeMethodInfo ,
#endif
    messageStreamsSelectedGetSize           ,


-- ** streamsSelectedGetStream #method:streamsSelectedGetStream#

#if defined(ENABLE_OVERLOADING)
    MessageStreamsSelectedGetStreamMethodInfo,
#endif
    messageStreamsSelectedGetStream         ,


-- ** writableStructure #method:writableStructure#

#if defined(ENABLE_OVERLOADING)
    MessageWritableStructureMethodInfo      ,
#endif
    messageWritableStructure                ,




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

    getMessageMiniObject                    ,
#if defined(ENABLE_OVERLOADING)
    message_miniObject                      ,
#endif


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

    getMessageSeqnum                        ,
#if defined(ENABLE_OVERLOADING)
    message_seqnum                          ,
#endif
    setMessageSeqnum                        ,


-- ** src #attr:src#
-- | the src of the message

    clearMessageSrc                         ,
    getMessageSrc                           ,
#if defined(ENABLE_OVERLOADING)
    message_src                             ,
#endif
    setMessageSrc                           ,


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

    getMessageTimestamp                     ,
#if defined(ENABLE_OVERLOADING)
    message_timestamp                       ,
#endif
    setMessageTimestamp                     ,


-- ** type #attr:type#
-- | the t'GI.Gst.Flags.MessageType' of the message

    getMessageType                          ,
#if defined(ENABLE_OVERLOADING)
    message_type                            ,
#endif
    setMessageType                          ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Clock as Gst.Clock
import {-# SOURCE #-} qualified GI.Gst.Objects.Device as Gst.Device
import {-# SOURCE #-} qualified GI.Gst.Objects.Element as Gst.Element
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
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.Context as Gst.Context
import {-# SOURCE #-} qualified GI.Gst.Structs.MiniObject as Gst.MiniObject
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 Message = Message (ManagedPtr Message)
    deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)
foreign import ccall "gst_message_get_type" c_gst_message_get_type :: 
    IO GType

instance BoxedObject Message where
    boxedType :: Message -> IO GType
boxedType _ = IO GType
c_gst_message_get_type

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

-- | Construct a `Message` struct initialized to zero.
newZeroMessage :: MonadIO m => m Message
newZeroMessage :: m Message
newZeroMessage = 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
$ Int -> IO (Ptr Message)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 120 IO (Ptr Message) -> (Ptr Message -> IO Message) -> IO Message
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message

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


-- | A convenience alias for `Nothing` :: `Maybe` `Message`.
noMessage :: Maybe Message
noMessage :: Maybe Message
noMessage = Maybe Message
forall a. Maybe a
Nothing

-- | Get the value of the “@mini_object@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #miniObject
-- @
getMessageMiniObject :: MonadIO m => Message -> m Gst.MiniObject.MiniObject
getMessageMiniObject :: Message -> m MiniObject
getMessageMiniObject s :: Message
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
$ Message -> (Ptr Message -> IO MiniObject) -> IO MiniObject
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO MiniObject) -> IO MiniObject)
-> (Ptr Message -> IO MiniObject) -> IO MiniObject
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    let val :: Ptr MiniObject
val = Ptr Message
ptr Ptr Message -> Int -> Ptr MiniObject
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: (Ptr Gst.MiniObject.MiniObject)
    MiniObject
val' <- ((ManagedPtr MiniObject -> MiniObject)
-> Ptr MiniObject -> IO MiniObject
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr 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 MessageMiniObjectFieldInfo
instance AttrInfo MessageMiniObjectFieldInfo where
    type AttrBaseTypeConstraint MessageMiniObjectFieldInfo = (~) Message
    type AttrAllowedOps MessageMiniObjectFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint MessageMiniObjectFieldInfo = (~) (Ptr Gst.MiniObject.MiniObject)
    type AttrTransferTypeConstraint MessageMiniObjectFieldInfo = (~)(Ptr Gst.MiniObject.MiniObject)
    type AttrTransferType MessageMiniObjectFieldInfo = (Ptr Gst.MiniObject.MiniObject)
    type AttrGetType MessageMiniObjectFieldInfo = Gst.MiniObject.MiniObject
    type AttrLabel MessageMiniObjectFieldInfo = "mini_object"
    type AttrOrigin MessageMiniObjectFieldInfo = Message
    attrGet = getMessageMiniObject
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

message_miniObject :: AttrLabelProxy "miniObject"
message_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' message #type
-- @
getMessageType :: MonadIO m => Message -> m [Gst.Flags.MessageType]
getMessageType :: Message -> m [MessageType]
getMessageType s :: Message
s = IO [MessageType] -> m [MessageType]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MessageType] -> m [MessageType])
-> IO [MessageType] -> m [MessageType]
forall a b. (a -> b) -> a -> b
$ Message -> (Ptr Message -> IO [MessageType]) -> IO [MessageType]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO [MessageType]) -> IO [MessageType])
-> (Ptr Message -> IO [MessageType]) -> IO [MessageType]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Message
ptr Ptr Message -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64) :: IO CUInt
    let val' :: [MessageType]
val' = CUInt -> [MessageType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [MessageType] -> IO [MessageType]
forall (m :: * -> *) a. Monad m => a -> m a
return [MessageType]
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' message [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageType :: MonadIO m => Message -> [Gst.Flags.MessageType] -> m ()
setMessageType :: Message -> [MessageType] -> m ()
setMessageType s :: Message
s val :: [MessageType]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Message -> (Ptr Message -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO ()) -> IO ())
-> (Ptr Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    let val' :: CUInt
val' = [MessageType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MessageType]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Message
ptr Ptr Message -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 64) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data MessageTypeFieldInfo
instance AttrInfo MessageTypeFieldInfo where
    type AttrBaseTypeConstraint MessageTypeFieldInfo = (~) Message
    type AttrAllowedOps MessageTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MessageTypeFieldInfo = (~) [Gst.Flags.MessageType]
    type AttrTransferTypeConstraint MessageTypeFieldInfo = (~)[Gst.Flags.MessageType]
    type AttrTransferType MessageTypeFieldInfo = [Gst.Flags.MessageType]
    type AttrGetType MessageTypeFieldInfo = [Gst.Flags.MessageType]
    type AttrLabel MessageTypeFieldInfo = "type"
    type AttrOrigin MessageTypeFieldInfo = Message
    attrGet = getMessageType
    attrSet = setMessageType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

message_type :: AttrLabelProxy "type"
message_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' message #timestamp
-- @
getMessageTimestamp :: MonadIO m => Message -> m Word64
getMessageTimestamp :: Message -> m Word64
getMessageTimestamp s :: Message
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
$ Message -> (Ptr Message -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO Word64) -> IO Word64)
-> (Ptr Message -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Message
ptr Ptr Message -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 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' message [ #timestamp 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageTimestamp :: MonadIO m => Message -> Word64 -> m ()
setMessageTimestamp :: Message -> Word64 -> m ()
setMessageTimestamp s :: Message
s val :: 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
$ Message -> (Ptr Message -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO ()) -> IO ())
-> (Ptr Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Message
ptr Ptr Message -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 72) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data MessageTimestampFieldInfo
instance AttrInfo MessageTimestampFieldInfo where
    type AttrBaseTypeConstraint MessageTimestampFieldInfo = (~) Message
    type AttrAllowedOps MessageTimestampFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MessageTimestampFieldInfo = (~) Word64
    type AttrTransferTypeConstraint MessageTimestampFieldInfo = (~)Word64
    type AttrTransferType MessageTimestampFieldInfo = Word64
    type AttrGetType MessageTimestampFieldInfo = Word64
    type AttrLabel MessageTimestampFieldInfo = "timestamp"
    type AttrOrigin MessageTimestampFieldInfo = Message
    attrGet = getMessageTimestamp
    attrSet = setMessageTimestamp
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

message_timestamp :: AttrLabelProxy "timestamp"
message_timestamp = AttrLabelProxy

#endif


-- | Get the value of the “@src@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' message #src
-- @
getMessageSrc :: MonadIO m => Message -> m (Maybe Gst.Object.Object)
getMessageSrc :: Message -> m (Maybe Object)
getMessageSrc s :: Message
s = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ Message -> (Ptr Message -> IO (Maybe Object)) -> IO (Maybe Object)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO (Maybe Object)) -> IO (Maybe Object))
-> (Ptr Message -> IO (Maybe Object)) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Ptr Object
val <- Ptr (Ptr Object) -> IO (Ptr Object)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Message
ptr Ptr Message -> Int -> Ptr (Ptr Object)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80) :: IO (Ptr Gst.Object.Object)
    Maybe Object
result <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Object
val ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \val' :: Ptr Object
val' -> do
        Object
val'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Gst.Object.Object) Ptr Object
val'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
val''
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
result

-- | Set the value of the “@src@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' message [ #src 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageSrc :: MonadIO m => Message -> Ptr Gst.Object.Object -> m ()
setMessageSrc :: Message -> Ptr Object -> m ()
setMessageSrc s :: Message
s val :: Ptr Object
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Message -> (Ptr Message -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO ()) -> IO ())
-> (Ptr Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Ptr (Ptr Object) -> Ptr Object -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Message
ptr Ptr Message -> Int -> Ptr (Ptr Object)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80) (Ptr Object
val :: Ptr Gst.Object.Object)

-- | Set the value of the “@src@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #src
-- @
clearMessageSrc :: MonadIO m => Message -> m ()
clearMessageSrc :: Message -> m ()
clearMessageSrc s :: Message
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Message -> (Ptr Message -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO ()) -> IO ())
-> (Ptr Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Ptr (Ptr Object) -> Ptr Object -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Message
ptr Ptr Message -> Int -> Ptr (Ptr Object)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80) (Ptr Object
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Object.Object)

#if defined(ENABLE_OVERLOADING)
data MessageSrcFieldInfo
instance AttrInfo MessageSrcFieldInfo where
    type AttrBaseTypeConstraint MessageSrcFieldInfo = (~) Message
    type AttrAllowedOps MessageSrcFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MessageSrcFieldInfo = (~) (Ptr Gst.Object.Object)
    type AttrTransferTypeConstraint MessageSrcFieldInfo = (~)(Ptr Gst.Object.Object)
    type AttrTransferType MessageSrcFieldInfo = (Ptr Gst.Object.Object)
    type AttrGetType MessageSrcFieldInfo = Maybe Gst.Object.Object
    type AttrLabel MessageSrcFieldInfo = "src"
    type AttrOrigin MessageSrcFieldInfo = Message
    attrGet = getMessageSrc
    attrSet = setMessageSrc
    attrConstruct = undefined
    attrClear = clearMessageSrc
    attrTransfer _ v = do
        return v

message_src :: AttrLabelProxy "src"
message_src = 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' message #seqnum
-- @
getMessageSeqnum :: MonadIO m => Message -> m Word32
getMessageSeqnum :: Message -> m Word32
getMessageSeqnum s :: Message
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
$ Message -> (Ptr Message -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO Word32) -> IO Word32)
-> (Ptr Message -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Message
ptr Ptr Message -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88) :: 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' message [ #seqnum 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageSeqnum :: MonadIO m => Message -> Word32 -> m ()
setMessageSeqnum :: Message -> Word32 -> m ()
setMessageSeqnum s :: Message
s val :: 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
$ Message -> (Ptr Message -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Message
s ((Ptr Message -> IO ()) -> IO ())
-> (Ptr Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Message
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Message
ptr Ptr Message -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data MessageSeqnumFieldInfo
instance AttrInfo MessageSeqnumFieldInfo where
    type AttrBaseTypeConstraint MessageSeqnumFieldInfo = (~) Message
    type AttrAllowedOps MessageSeqnumFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MessageSeqnumFieldInfo = (~) Word32
    type AttrTransferTypeConstraint MessageSeqnumFieldInfo = (~)Word32
    type AttrTransferType MessageSeqnumFieldInfo = Word32
    type AttrGetType MessageSeqnumFieldInfo = Word32
    type AttrLabel MessageSeqnumFieldInfo = "seqnum"
    type AttrOrigin MessageSeqnumFieldInfo = Message
    attrGet = getMessageSeqnum
    attrSet = setMessageSeqnum
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

message_seqnum :: AttrLabelProxy "seqnum"
message_seqnum = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Message
type instance O.AttributeList Message = MessageAttributeList
type MessageAttributeList = ('[ '("miniObject", MessageMiniObjectFieldInfo), '("type", MessageTypeFieldInfo), '("timestamp", MessageTimestampFieldInfo), '("src", MessageSrcFieldInfo), '("seqnum", MessageSeqnumFieldInfo)] :: [(Symbol, *)])
#endif

-- method Message::new_application
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 message. The message\n    will 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 = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_application" gst_message_new_application :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Create a new application-typed message. GStreamer will never create these
-- messages; they are a gift from us to you. Enjoy.
messageNewApplication ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Structure.Structure
    -- ^ /@structure@/: the structure for the message. The message
    --     will take ownership of the structure.
    -> m (Maybe Message)
    -- ^ __Returns:__ The new application message.
    -- 
    -- MT safe.
messageNewApplication :: Maybe a -> Structure -> m (Maybe Message)
messageNewApplication src :: Maybe a
src structure :: Structure
structure = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Message
result <- Ptr Object -> Ptr Structure -> IO (Ptr Message)
gst_message_new_application Ptr Object
maybeSrc Ptr Structure
structure'
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_async_done
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 "the desired running_time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_async_done" gst_message_new_async_done :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Word64 ->                               -- running_time : TBasicType TUInt64
    IO (Ptr Message)

-- | The message is posted when elements completed an ASYNC state change.
-- /@runningTime@/ contains the time of the desired running_time when this
-- elements goes to PLAYING. A value of 'GI.Gst.Constants.CLOCK_TIME_NONE' for /@runningTime@/
-- means that the element has no clock interaction and thus doesn\'t care about
-- the running_time of the pipeline.
messageNewAsyncDone ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Word64
    -- ^ /@runningTime@/: the desired running_time
    -> m Message
    -- ^ __Returns:__ The new async_done message.
    -- 
    -- MT safe.
messageNewAsyncDone :: Maybe a -> Word64 -> m Message
messageNewAsyncDone src :: Maybe a
src runningTime :: Word64
runningTime = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> Word64 -> IO (Ptr Message)
gst_message_new_async_done Ptr Object
maybeSrc Word64
runningTime
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewAsyncDone" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_async_start
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_async_start" gst_message_new_async_start :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Message)

-- | This message is posted by elements when they start an ASYNC state change.
messageNewAsyncStart ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> m Message
    -- ^ __Returns:__ The new async_start message.
    -- 
    -- MT safe.
messageNewAsyncStart :: Maybe a -> m Message
messageNewAsyncStart src :: Maybe a
src = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_message_new_async_start Ptr Object
maybeSrc
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewAsyncStart" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_buffering
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "percent"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The buffering percent"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_buffering" gst_message_new_buffering :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Int32 ->                                -- percent : TBasicType TInt
    IO (Ptr Message)

-- | Create a new buffering message. This message can be posted by an element that
-- needs to buffer data before it can continue processing. /@percent@/ should be a
-- value between 0 and 100. A value of 100 means that the buffering completed.
-- 
-- When /@percent@/ is \< 100 the application should PAUSE a PLAYING pipeline. When
-- /@percent@/ is 100, the application can set the pipeline (back) to PLAYING.
-- The application must be prepared to receive BUFFERING messages in the
-- PREROLLING state and may only set the pipeline to PLAYING after receiving a
-- message with /@percent@/ set to 100, which can happen after the pipeline
-- completed prerolling.
-- 
-- MT safe.
messageNewBuffering ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Int32
    -- ^ /@percent@/: The buffering percent
    -> m (Maybe Message)
    -- ^ __Returns:__ The new buffering message.
messageNewBuffering :: Maybe a -> Int32 -> m (Maybe Message)
messageNewBuffering src :: Maybe a
src percent :: Int32
percent = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> Int32 -> IO (Ptr Message)
gst_message_new_buffering Ptr Object
maybeSrc Int32
percent
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_clock_lost
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the clock that was lost"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_clock_lost" gst_message_new_clock_lost :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Clock.Clock ->                  -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO (Ptr Message)

-- | Create a clock lost message. This message is posted whenever the
-- clock is not valid anymore.
-- 
-- If this message is posted by the pipeline, the pipeline will
-- select a new clock again when it goes to PLAYING. It might therefore
-- be needed to set the pipeline to PAUSED and PLAYING again.
messageNewClockLost ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Clock.IsClock b) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> b
    -- ^ /@clock@/: the clock that was lost
    -> m Message
    -- ^ __Returns:__ The new clock lost message.
    -- 
    -- MT safe.
messageNewClockLost :: Maybe a -> b -> m Message
messageNewClockLost src :: Maybe a
src clock :: b
clock = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Clock
clock' <- b -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clock
    Ptr Message
result <- Ptr Object -> Ptr Clock -> IO (Ptr Message)
gst_message_new_clock_lost Ptr Object
maybeSrc Ptr Clock
clock'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewClockLost" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clock
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_clock_provide
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the clock it provides"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ready"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the sender can provide a clock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_clock_provide" gst_message_new_clock_provide :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Clock.Clock ->                  -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    CInt ->                                 -- ready : TBasicType TBoolean
    IO (Ptr Message)

-- | Create a clock provide message. This message is posted whenever an
-- element is ready to provide a clock or lost its ability to provide
-- a clock (maybe because it paused or became EOS).
-- 
-- This message is mainly used internally to manage the clock
-- selection.
messageNewClockProvide ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Clock.IsClock b) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> b
    -- ^ /@clock@/: the clock it provides
    -> Bool
    -- ^ /@ready@/: 'P.True' if the sender can provide a clock
    -> m Message
    -- ^ __Returns:__ the new provide clock message.
    -- 
    -- MT safe.
messageNewClockProvide :: Maybe a -> b -> Bool -> m Message
messageNewClockProvide src :: Maybe a
src clock :: b
clock ready :: Bool
ready = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Clock
clock' <- b -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clock
    let ready' :: CInt
ready' = (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
ready
    Ptr Message
result <- Ptr Object -> Ptr Clock -> CInt -> IO (Ptr Message)
gst_message_new_clock_provide Ptr Object
maybeSrc Ptr Clock
clock' CInt
ready'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewClockProvide" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clock
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_custom
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MessageType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstMessageType to distinguish messages"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the structure for the\n    message. The message will 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 = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_custom" gst_message_new_custom :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "MessageType"})
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Create a new custom-typed message. This can be used for anything not
-- handled by other message-specific functions to pass a message to the
-- app. The structure field can be 'P.Nothing'.
messageNewCustom ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    [Gst.Flags.MessageType]
    -- ^ /@type@/: The t'GI.Gst.Flags.MessageType' to distinguish messages
    -> Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@structure@/: the structure for the
    --     message. The message will take ownership of the structure.
    -> m (Maybe Message)
    -- ^ __Returns:__ The new message.
    -- 
    -- MT safe.
messageNewCustom :: [MessageType] -> Maybe a -> Maybe Structure -> m (Maybe Message)
messageNewCustom type_ :: [MessageType]
type_ src :: Maybe a
src structure :: Maybe Structure
structure = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CUInt
type_' = [MessageType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MessageType]
type_
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Structure
maybeStructure <- case Maybe Structure
structure of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jStructure :: Structure
jStructure -> do
            Ptr Structure
jStructure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jStructure
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jStructure'
    Ptr Message
result <- CUInt -> Ptr Object -> Ptr Structure -> IO (Ptr Message)
gst_message_new_custom CUInt
type_' Ptr Object
maybeSrc Ptr Structure
maybeStructure
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
structure Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_device_added
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstObject that created the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new #GstDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_device_added" gst_message_new_device_added :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Device.Device ->                -- device : TInterface (Name {namespace = "Gst", name = "Device"})
    IO (Ptr Message)

-- | Creates a new device-added message. The device-added message is produced by
-- t'GI.Gst.Objects.DeviceProvider.DeviceProvider' or a t'GI.Gst.Objects.DeviceMonitor.DeviceMonitor'. They announce the appearance
-- of monitored devices.
-- 
-- /Since: 1.4/
messageNewDeviceAdded ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Device.IsDevice b) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' that created the message
    -> b
    -- ^ /@device@/: The new t'GI.Gst.Objects.Device.Device'
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewDeviceAdded :: a -> b -> m Message
messageNewDeviceAdded src :: a
src device :: b
device = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    Ptr Message
result <- Ptr Object -> Ptr Device -> IO (Ptr Message)
gst_message_new_device_added Ptr Object
src' Ptr Device
device'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewDeviceAdded" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_device_changed
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstObject that created the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The newly created device representing @replaced_device\n        with its new configuration."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "changed_device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_device_changed" gst_message_new_device_changed :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Device.Device ->                -- device : TInterface (Name {namespace = "Gst", name = "Device"})
    Ptr Gst.Device.Device ->                -- changed_device : TInterface (Name {namespace = "Gst", name = "Device"})
    IO (Ptr Message)

-- | Creates a new device-changed message. The device-changed message is produced
-- by t'GI.Gst.Objects.DeviceProvider.DeviceProvider' or a t'GI.Gst.Objects.DeviceMonitor.DeviceMonitor'. They announce that a device
-- properties has changed and /@device@/ represent the new modified version of /@changedDevice@/.
-- 
-- /Since: 1.16/
messageNewDeviceChanged ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Device.IsDevice b, Gst.Device.IsDevice c) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' that created the message
    -> b
    -- ^ /@device@/: The newly created device representing /@replacedDevice@/
    --         with its new configuration.
    -> c
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewDeviceChanged :: a -> b -> c -> m Message
messageNewDeviceChanged src :: a
src device :: b
device changedDevice :: c
changedDevice = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    Ptr Device
changedDevice' <- c -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
changedDevice
    Ptr Message
result <- Ptr Object -> Ptr Device -> Ptr Device -> IO (Ptr Message)
gst_message_new_device_changed Ptr Object
src' Ptr Device
device' Ptr Device
changedDevice'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewDeviceChanged" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
changedDevice
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_device_removed
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstObject that created the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The removed #GstDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_device_removed" gst_message_new_device_removed :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Device.Device ->                -- device : TInterface (Name {namespace = "Gst", name = "Device"})
    IO (Ptr Message)

-- | Creates a new device-removed message. The device-removed message is produced
-- by t'GI.Gst.Objects.DeviceProvider.DeviceProvider' or a t'GI.Gst.Objects.DeviceMonitor.DeviceMonitor'. They announce the
-- disappearance of monitored devices.
-- 
-- /Since: 1.4/
messageNewDeviceRemoved ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Device.IsDevice b) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' that created the message
    -> b
    -- ^ /@device@/: The removed t'GI.Gst.Objects.Device.Device'
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewDeviceRemoved :: a -> b -> m Message
messageNewDeviceRemoved src :: a
src device :: b
device = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    Ptr Message
result <- Ptr Object -> Ptr Device -> IO (Ptr Message)
gst_message_new_device_removed Ptr Object
src' Ptr Device
device'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewDeviceRemoved" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_duration_changed
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_duration_changed" gst_message_new_duration_changed :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Message)

-- | Create a new duration changed message. This message is posted by elements
-- that know the duration of a stream when the duration changes. This message
-- is received by bins and is used to calculate the total duration of a
-- pipeline.
messageNewDurationChanged ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> m Message
    -- ^ __Returns:__ The new duration-changed message.
    -- 
    -- MT safe.
messageNewDurationChanged :: Maybe a -> m Message
messageNewDurationChanged src :: Maybe a
src = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_message_new_duration_changed Ptr Object
maybeSrc
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewDurationChanged" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_element
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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\n    message. The message will 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 = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_element" gst_message_new_element :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Structure.Structure ->          -- structure : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Create a new element-specific message. This is meant as a generic way of
-- allowing one-way communication from an element to an application, for example
-- \"the firewire cable was unplugged\". The format of the message should be
-- documented in the element\'s documentation. The structure field can be 'P.Nothing'.
messageNewElement ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Structure.Structure
    -- ^ /@structure@/: The structure for the
    --     message. The message will take ownership of the structure.
    -> m (Maybe Message)
    -- ^ __Returns:__ The new element message.
    -- 
    -- MT safe.
messageNewElement :: Maybe a -> Structure -> m (Maybe Message)
messageNewElement src :: Maybe a
src structure :: Structure
structure = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Structure
structure' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
structure
    Ptr Message
result <- Ptr Object -> Ptr Structure -> IO (Ptr Message)
gst_message_new_element Ptr Object
maybeSrc Ptr Structure
structure'
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
structure
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_eos
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_eos" gst_message_new_eos :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Message)

-- | Create a new eos message. This message is generated and posted in
-- the sink elements of a GstBin. The bin will only forward the EOS
-- message to the application if all sinks have posted an EOS message.
messageNewEos ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> m Message
    -- ^ __Returns:__ The new eos message.
    -- 
    -- MT safe.
messageNewEos :: Maybe a -> m Message
messageNewEos src :: Maybe a
src = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_message_new_eos Ptr Object
maybeSrc
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewEos" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_error
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GError for this message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A debugging string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_error" gst_message_new_error :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    IO (Ptr Message)

-- | Create a new error message. The message will copy /@error@/ and
-- /@debug@/. This message is posted by element when a fatal event
-- occurred. The pipeline will probably (partially) stop. The application
-- receiving this message should stop the pipeline.
messageNewError ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> GError
    -- ^ /@error@/: The GError for this message.
    -> T.Text
    -- ^ /@debug@/: A debugging string.
    -> m Message
    -- ^ __Returns:__ the new error message.
    -- 
    -- MT safe.
messageNewError :: Maybe a -> GError -> Text -> m Message
messageNewError src :: Maybe a
src error_ :: GError
error_ debug :: Text
debug = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    CString
debug' <- Text -> IO CString
textToCString Text
debug
    Ptr Message
result <- Ptr Object -> Ptr GError -> CString -> IO (Ptr Message)
gst_message_new_error Ptr Object
maybeSrc Ptr GError
error_' CString
debug'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewError" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_error_with_details
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GError for this message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A debugging string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "details"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A GstStructure with details"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_error_with_details" gst_message_new_error_with_details :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    Ptr Gst.Structure.Structure ->          -- details : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Create a new error message. The message will copy /@error@/ and
-- /@debug@/. This message is posted by element when a fatal event
-- occurred. The pipeline will probably (partially) stop. The application
-- receiving this message should stop the pipeline.
-- 
-- /Since: 1.10/
messageNewErrorWithDetails ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> GError
    -- ^ /@error@/: The GError for this message.
    -> T.Text
    -- ^ /@debug@/: A debugging string.
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@details@/: A GstStructure with details
    -> m (Maybe Message)
    -- ^ __Returns:__ the new error message.
messageNewErrorWithDetails :: Maybe a -> GError -> Text -> Maybe Structure -> m (Maybe Message)
messageNewErrorWithDetails src :: Maybe a
src error_ :: GError
error_ debug :: Text
debug details :: Maybe Structure
details = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    CString
debug' <- Text -> IO CString
textToCString Text
debug
    Ptr Structure
maybeDetails <- case Maybe Structure
details of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jDetails :: Structure
jDetails -> do
            Ptr Structure
jDetails' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jDetails
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jDetails'
    Ptr Message
result <- Ptr Object
-> Ptr GError -> CString -> Ptr Structure -> IO (Ptr Message)
gst_message_new_error_with_details Ptr Object
maybeSrc Ptr GError
error_' CString
debug' Ptr Structure
maybeDetails
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
details Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_have_context
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_have_context" gst_message_new_have_context :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Context.Context ->              -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO (Ptr Message)

-- | This message is posted when an element has a new local t'GI.Gst.Structs.Context.Context'.
-- 
-- /Since: 1.2/
messageNewHaveContext ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Context.Context
    -- ^ /@context@/: the context
    -> m Message
    -- ^ __Returns:__ The new have-context message.
    -- 
    -- MT safe.
messageNewHaveContext :: Maybe a -> Context -> m Message
messageNewHaveContext src :: Maybe a
src context :: Context
context = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Context
context
    Ptr Message
result <- Ptr Object -> Ptr Context -> IO (Ptr Message)
gst_message_new_have_context Ptr Object
maybeSrc Ptr Context
context'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewHaveContext" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_info
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GError for this message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A debugging string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_info" gst_message_new_info :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    IO (Ptr Message)

-- | Create a new info message. The message will make copies of /@error@/ and
-- /@debug@/.
messageNewInfo ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> GError
    -- ^ /@error@/: The GError for this message.
    -> T.Text
    -- ^ /@debug@/: A debugging string.
    -> m Message
    -- ^ __Returns:__ the new info message.
    -- 
    -- MT safe.
messageNewInfo :: Maybe a -> GError -> Text -> m Message
messageNewInfo src :: Maybe a
src error_ :: GError
error_ debug :: Text
debug = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    CString
debug' <- Text -> IO CString
textToCString Text
debug
    Ptr Message
result <- Ptr Object -> Ptr GError -> CString -> IO (Ptr Message)
gst_message_new_info Ptr Object
maybeSrc Ptr GError
error_' CString
debug'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewInfo" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_info_with_details
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GError for this message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A debugging string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "details"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A GstStructure with details"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_info_with_details" gst_message_new_info_with_details :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    Ptr Gst.Structure.Structure ->          -- details : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Create a new info message. The message will make copies of /@error@/ and
-- /@debug@/.
-- 
-- /Since: 1.10/
messageNewInfoWithDetails ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> GError
    -- ^ /@error@/: The GError for this message.
    -> T.Text
    -- ^ /@debug@/: A debugging string.
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@details@/: A GstStructure with details
    -> m (Maybe Message)
    -- ^ __Returns:__ the new warning message.
messageNewInfoWithDetails :: Maybe a -> GError -> Text -> Maybe Structure -> m (Maybe Message)
messageNewInfoWithDetails src :: Maybe a
src error_ :: GError
error_ debug :: Text
debug details :: Maybe Structure
details = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    CString
debug' <- Text -> IO CString
textToCString Text
debug
    Ptr Structure
maybeDetails <- case Maybe Structure
details of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jDetails :: Structure
jDetails -> do
            Ptr Structure
jDetails' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jDetails
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jDetails'
    Ptr Message
result <- Ptr Object
-> Ptr GError -> CString -> Ptr Structure -> IO (Ptr Message)
gst_message_new_info_with_details Ptr Object
maybeSrc Ptr GError
error_' CString
debug' Ptr Structure
maybeDetails
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
details Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_latency
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_latency" gst_message_new_latency :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Message)

-- | This message can be posted by elements when their latency requirements have
-- changed.
messageNewLatency ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> m Message
    -- ^ __Returns:__ The new latency message.
    -- 
    -- MT safe.
messageNewLatency :: Maybe a -> m Message
messageNewLatency src :: Maybe a
src = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_message_new_latency Ptr Object
maybeSrc
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewLatency" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_need_context
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The context type that is needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_need_context" gst_message_new_need_context :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- context_type : TBasicType TUTF8
    IO (Ptr Message)

-- | This message is posted when an element needs a specific t'GI.Gst.Structs.Context.Context'.
-- 
-- /Since: 1.2/
messageNewNeedContext ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> T.Text
    -- ^ /@contextType@/: The context type that is needed
    -> m Message
    -- ^ __Returns:__ The new need-context message.
    -- 
    -- MT safe.
messageNewNeedContext :: Maybe a -> Text -> m Message
messageNewNeedContext src :: Maybe a
src contextType :: Text
contextType = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    CString
contextType' <- Text -> IO CString
textToCString Text
contextType
    Ptr Message
result <- Ptr Object -> CString -> IO (Ptr Message)
gst_message_new_need_context Ptr Object
maybeSrc CString
contextType'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewNeedContext" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contextType'
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_new_clock
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new selected clock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_new_clock" gst_message_new_new_clock :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.Clock.Clock ->                  -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO (Ptr Message)

-- | Create a new clock message. This message is posted whenever the
-- pipeline selects a new clock for the pipeline.
messageNewNewClock ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Clock.IsClock b) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> b
    -- ^ /@clock@/: the new selected clock
    -> m Message
    -- ^ __Returns:__ The new new clock message.
    -- 
    -- MT safe.
messageNewNewClock :: Maybe a -> b -> m Message
messageNewNewClock src :: Maybe a
src clock :: b
clock = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Clock
clock' <- b -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
clock
    Ptr Message
result <- Ptr Object -> Ptr Clock -> IO (Ptr Message)
gst_message_new_new_clock Ptr Object
maybeSrc Ptr Clock
clock'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewNewClock" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
clock
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_progress
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ProgressType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstProgressType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "code"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a progress code" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "free, user visible text describing the progress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_progress" gst_message_new_progress :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "ProgressType"})
    CString ->                              -- code : TBasicType TUTF8
    CString ->                              -- text : TBasicType TUTF8
    IO (Ptr Message)

-- | Progress messages are posted by elements when they use an asynchronous task
-- to perform actions triggered by a state change.
-- 
-- /@code@/ contains a well defined string describing the action.
-- /@text@/ should contain a user visible string detailing the current action.
messageNewProgress ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.ProgressType
    -- ^ /@type@/: a t'GI.Gst.Enums.ProgressType'
    -> T.Text
    -- ^ /@code@/: a progress code
    -> T.Text
    -- ^ /@text@/: free, user visible text describing the progress
    -> m (Maybe Message)
    -- ^ __Returns:__ The new qos message.
messageNewProgress :: a -> ProgressType -> Text -> Text -> m (Maybe Message)
messageNewProgress src :: a
src type_ :: ProgressType
type_ code :: Text
code text :: Text
text = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ProgressType -> Int) -> ProgressType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgressType -> Int
forall a. Enum a => a -> Int
fromEnum) ProgressType
type_
    CString
code' <- Text -> IO CString
textToCString Text
code
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr Message
result <- Ptr Object -> CUInt -> CString -> CString -> IO (Ptr Message)
gst_message_new_progress Ptr Object
src' CUInt
type_' CString
code' CString
text'
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
code'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_property_notify
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GstObject whose property changed (may or may not be a #GstElement)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property that changed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "val"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new property value, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_property_notify" gst_message_new_property_notify :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- val : TInterface (Name {namespace = "GObject", name = "Value"})
    IO (Ptr Message)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
messageNewPropertyNotify ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' whose property changed (may or may not be a t'GI.Gst.Objects.Element.Element')
    -> T.Text
    -- ^ /@propertyName@/: name of the property that changed
    -> Maybe (GValue)
    -- ^ /@val@/: new property value, or 'P.Nothing'
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewPropertyNotify :: a -> Text -> Maybe GValue -> m Message
messageNewPropertyNotify src :: a
src propertyName :: Text
propertyName val :: Maybe GValue
val = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
maybeVal <- case Maybe GValue
val of
        Nothing -> Ptr GValue -> IO (Ptr GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
forall a. Ptr a
nullPtr
        Just jVal :: GValue
jVal -> do
            Ptr GValue
jVal' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed GValue
jVal
            Ptr GValue -> IO (Ptr GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
jVal'
    Ptr Message
result <- Ptr Object -> CString -> Ptr GValue -> IO (Ptr Message)
gst_message_new_property_notify Ptr Object
src' CString
propertyName' Ptr GValue
maybeVal
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewPropertyNotify" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Maybe GValue -> (GValue -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GValue
val GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_qos
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if the message was generated by a live element"
--                 , 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 "the running time of the buffer that generated the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the stream time of the buffer that generated the message"
--                 , 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 timestamps of the buffer that generated the message"
--                 , 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 buffer that generated the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_qos" gst_message_new_qos :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CInt ->                                 -- live : TBasicType TBoolean
    Word64 ->                               -- running_time : TBasicType TUInt64
    Word64 ->                               -- stream_time : TBasicType TUInt64
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Word64 ->                               -- duration : TBasicType TUInt64
    IO (Ptr Message)

-- | A QOS message is posted on the bus whenever an element decides to drop a
-- buffer because of QoS reasons or whenever it changes its processing strategy
-- because of QoS reasons (quality adjustments such as processing at lower
-- accuracy).
-- 
-- This message can be posted by an element that performs synchronisation against the
-- clock (live) or it could be dropped by an element that performs QoS because of QOS
-- events received from a downstream element (!live).
-- 
-- /@runningTime@/, /@streamTime@/, /@timestamp@/, /@duration@/ should be set to the
-- respective running-time, stream-time, timestamp and duration of the (dropped)
-- buffer that generated the QoS event. Values can be left to
-- GST_CLOCK_TIME_NONE when unknown.
messageNewQos ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: The object originating the message.
    -> Bool
    -- ^ /@live@/: if the message was generated by a live element
    -> Word64
    -- ^ /@runningTime@/: the running time of the buffer that generated the message
    -> Word64
    -- ^ /@streamTime@/: the stream time of the buffer that generated the message
    -> Word64
    -- ^ /@timestamp@/: the timestamps of the buffer that generated the message
    -> Word64
    -- ^ /@duration@/: the duration of the buffer that generated the message
    -> m Message
    -- ^ __Returns:__ The new qos message.
    -- 
    -- MT safe.
messageNewQos :: a -> Bool -> Word64 -> Word64 -> Word64 -> Word64 -> m Message
messageNewQos src :: a
src live :: Bool
live runningTime :: Word64
runningTime streamTime :: Word64
streamTime timestamp :: Word64
timestamp duration :: Word64
duration = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let live' :: CInt
live' = (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
live
    Ptr Message
result <- Ptr Object
-> CInt -> Word64 -> Word64 -> Word64 -> Word64 -> IO (Ptr Message)
gst_message_new_qos Ptr Object
src' CInt
live' Word64
runningTime Word64
streamTime Word64
timestamp Word64
duration
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewQos" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_redirect
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GstObject whose property changed (may or may not be a #GstElement)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location string for the new entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag_list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag list for the new entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "entry_struct"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "structure for the new entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_redirect" gst_message_new_redirect :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- location : TBasicType TUTF8
    Ptr Gst.TagList.TagList ->              -- tag_list : TInterface (Name {namespace = "Gst", name = "TagList"})
    Ptr Gst.Structure.Structure ->          -- entry_struct : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Creates a new redirect message and adds a new entry to it. Redirect messages
-- are posted when an element detects that the actual data has to be retrieved
-- from a different location. This is useful if such a redirection cannot be
-- handled inside a source element, for example when HTTP 302\/303 redirects
-- return a non-HTTP URL.
-- 
-- The redirect message can hold multiple entries. The first one is added
-- when the redirect message is created, with the given location, tag_list,
-- entry_struct arguments. Use 'GI.Gst.Structs.Message.messageAddRedirectEntry' to add more
-- entries.
-- 
-- Each entry has a location, a tag list, and a structure. All of these are
-- optional. The tag list and structure are useful for additional metadata,
-- such as bitrate statistics for the given location.
-- 
-- By default, message recipients should treat entries in the order they are
-- stored. The recipient should therefore try entry @/0/@ first, and if this
-- entry is not acceptable or working, try entry @/1/@ etc. Senders must make
-- sure that they add entries in this order. However, recipients are free to
-- ignore the order and pick an entry that is \"best\" for them. One example
-- would be a recipient that scans the entries for the one with the highest
-- bitrate tag.
-- 
-- The specified location string is copied. However, ownership over the tag
-- list and structure are transferred to the message.
-- 
-- /Since: 1.10/
messageNewRedirect ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' whose property changed (may or may not be a t'GI.Gst.Objects.Element.Element')
    -> T.Text
    -- ^ /@location@/: location string for the new entry
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tagList@/: tag list for the new entry
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@entryStruct@/: structure for the new entry
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewRedirect :: a -> Text -> Maybe TagList -> Maybe Structure -> m Message
messageNewRedirect src :: a
src location :: Text
location tagList :: Maybe TagList
tagList entryStruct :: Maybe Structure
entryStruct = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    CString
location' <- Text -> IO CString
textToCString Text
location
    Ptr TagList
maybeTagList <- case Maybe TagList
tagList of
        Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just jTagList :: TagList
jTagList -> do
            Ptr TagList
jTagList' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TagList
jTagList
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTagList'
    Ptr Structure
maybeEntryStruct <- case Maybe Structure
entryStruct of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jEntryStruct :: Structure
jEntryStruct -> do
            Ptr Structure
jEntryStruct' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jEntryStruct
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jEntryStruct'
    Ptr Message
result <- Ptr Object
-> CString -> Ptr TagList -> Ptr Structure -> IO (Ptr Message)
gst_message_new_redirect Ptr Object
src' CString
location' Ptr TagList
maybeTagList Ptr Structure
maybeEntryStruct
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewRedirect" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tagList TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
entryStruct Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
location'
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_request_state
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new requested state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_request_state" gst_message_new_request_state :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- state : TInterface (Name {namespace = "Gst", name = "State"})
    IO (Ptr Message)

-- | This message can be posted by elements when they want to have their state
-- changed. A typical use case would be an audio server that wants to pause the
-- pipeline because a higher priority stream is being played.
messageNewRequestState ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.State
    -- ^ /@state@/: The new requested state
    -> m Message
    -- ^ __Returns:__ the new request state message.
    -- 
    -- MT safe.
messageNewRequestState :: Maybe a -> State -> m Message
messageNewRequestState src :: Maybe a
src state :: State
state = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (State -> Int) -> State -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
forall a. Enum a => a -> Int
fromEnum) State
state
    Ptr Message
result <- Ptr Object -> CUInt -> IO (Ptr Message)
gst_message_new_request_state Ptr Object
maybeSrc CUInt
state'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewRequestState" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_reset_time
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 "the requested running-time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_reset_time" gst_message_new_reset_time :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Word64 ->                               -- running_time : TBasicType TUInt64
    IO (Ptr Message)

-- | This message is posted when the pipeline running-time should be reset to
-- /@runningTime@/, like after a flushing seek.
messageNewResetTime ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Word64
    -- ^ /@runningTime@/: the requested running-time
    -> m Message
    -- ^ __Returns:__ The new reset_time message.
    -- 
    -- MT safe.
messageNewResetTime :: Maybe a -> Word64 -> m Message
messageNewResetTime src :: Maybe a
src runningTime :: Word64
runningTime = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> Word64 -> IO (Ptr Message)
gst_message_new_reset_time Ptr Object
maybeSrc Word64
runningTime
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewResetTime" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_segment_done
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 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 = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_segment_done" gst_message_new_segment_done :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- position : TBasicType TInt64
    IO (Ptr Message)

-- | Create a new segment done message. This message is posted by elements that
-- finish playback of a segment as a result of a segment seek. This message
-- is received by the application after all elements that posted a segment_start
-- have posted the segment_done.
messageNewSegmentDone ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.Format
    -- ^ /@format@/: The format of the position being done
    -> Int64
    -- ^ /@position@/: The position of the segment being done
    -> m Message
    -- ^ __Returns:__ the new segment done message.
    -- 
    -- MT safe.
messageNewSegmentDone :: Maybe a -> Format -> Int64 -> m Message
messageNewSegmentDone src :: Maybe a
src format :: Format
format position :: Int64
position = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    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 Message
result <- Ptr Object -> CUInt -> Int64 -> IO (Ptr Message)
gst_message_new_segment_done Ptr Object
maybeSrc CUInt
format' Int64
position
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewSegmentDone" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_segment_start
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 position being played"
--                 , 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 played"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_segment_start" gst_message_new_segment_start :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- position : TBasicType TInt64
    IO (Ptr Message)

-- | Create a new segment message. This message is posted by elements that
-- start playback of a segment as a result of a segment seek. This message
-- is not received by the application but is used for maintenance reasons in
-- container elements.
messageNewSegmentStart ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.Format
    -- ^ /@format@/: The format of the position being played
    -> Int64
    -- ^ /@position@/: The position of the segment being played
    -> m Message
    -- ^ __Returns:__ the new segment start message.
    -- 
    -- MT safe.
messageNewSegmentStart :: Maybe a -> Format -> Int64 -> m Message
messageNewSegmentStart src :: Maybe a
src format :: Format
format position :: Int64
position = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    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 Message
result <- Ptr Object -> CUInt -> Int64 -> IO (Ptr Message)
gst_message_new_segment_start Ptr Object
maybeSrc CUInt
format' Int64
position
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewSegmentStart" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_state_changed
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "oldstate"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the previous state" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "newstate"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new (current) state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pending"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pending (target) state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_state_changed" gst_message_new_state_changed :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- oldstate : TInterface (Name {namespace = "Gst", name = "State"})
    CUInt ->                                -- newstate : TInterface (Name {namespace = "Gst", name = "State"})
    CUInt ->                                -- pending : TInterface (Name {namespace = "Gst", name = "State"})
    IO (Ptr Message)

-- | Create a state change message. This message is posted whenever an element
-- changed its state.
messageNewStateChanged ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.State
    -- ^ /@oldstate@/: the previous state
    -> Gst.Enums.State
    -- ^ /@newstate@/: the new (current) state
    -> Gst.Enums.State
    -- ^ /@pending@/: the pending (target) state
    -> m Message
    -- ^ __Returns:__ the new state change message.
    -- 
    -- MT safe.
messageNewStateChanged :: Maybe a -> State -> State -> State -> m Message
messageNewStateChanged src :: Maybe a
src oldstate :: State
oldstate newstate :: State
newstate pending :: State
pending = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    let oldstate' :: CUInt
oldstate' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (State -> Int) -> State -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
forall a. Enum a => a -> Int
fromEnum) State
oldstate
    let newstate' :: CUInt
newstate' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (State -> Int) -> State -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
forall a. Enum a => a -> Int
fromEnum) State
newstate
    let pending' :: CUInt
pending' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (State -> Int) -> State -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int
forall a. Enum a => a -> Int
fromEnum) State
pending
    Ptr Message
result <- Ptr Object -> CUInt -> CUInt -> CUInt -> IO (Ptr Message)
gst_message_new_state_changed Ptr Object
maybeSrc CUInt
oldstate' CUInt
newstate' CUInt
pending'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStateChanged" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_state_dirty
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_state_dirty" gst_message_new_state_dirty :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Message)

-- | Create a state dirty message. This message is posted whenever an element
-- changed its state asynchronously and is used internally to update the
-- states of container objects.
messageNewStateDirty ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message
    -> m Message
    -- ^ __Returns:__ the new state dirty message.
    -- 
    -- MT safe.
messageNewStateDirty :: Maybe a -> m Message
messageNewStateDirty src :: Maybe a
src = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_message_new_state_dirty Ptr Object
maybeSrc
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStateDirty" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_step_done
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , 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 @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 stepped data"
--                 , 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 rate of the stepped amount"
--                 , 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 "is this an flushing step"
--                 , 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 "is this an intermediate step"
--                 , 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 data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "eos"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the step caused EOS"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_step_done" gst_message_new_step_done :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- amount : TBasicType TUInt64
    CDouble ->                              -- rate : TBasicType TDouble
    CInt ->                                 -- flush : TBasicType TBoolean
    CInt ->                                 -- intermediate : TBasicType TBoolean
    Word64 ->                               -- duration : TBasicType TUInt64
    CInt ->                                 -- eos : TBasicType TBoolean
    IO (Ptr Message)

-- | This message is posted by elements when they complete a part, when /@intermediate@/ set
-- to 'P.True', or a complete step operation.
-- 
-- /@duration@/ will contain the amount of time (in GST_FORMAT_TIME) of the stepped
-- /@amount@/ of media in format /@format@/.
messageNewStepDone ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of /@amount@/
    -> Word64
    -- ^ /@amount@/: the amount of stepped data
    -> Double
    -- ^ /@rate@/: the rate of the stepped amount
    -> Bool
    -- ^ /@flush@/: is this an flushing step
    -> Bool
    -- ^ /@intermediate@/: is this an intermediate step
    -> Word64
    -- ^ /@duration@/: the duration of the data
    -> Bool
    -- ^ /@eos@/: the step caused EOS
    -> m Message
    -- ^ __Returns:__ the new step_done message.
    -- 
    -- MT safe.
messageNewStepDone :: a
-> Format
-> Word64
-> Double
-> Bool
-> Bool
-> Word64
-> Bool
-> m Message
messageNewStepDone src :: a
src format :: Format
format amount :: Word64
amount rate :: Double
rate flush :: Bool
flush intermediate :: Bool
intermediate duration :: Word64
duration eos :: Bool
eos = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    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
    let eos' :: CInt
eos' = (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
eos
    Ptr Message
result <- Ptr Object
-> CUInt
-> Word64
-> CDouble
-> CInt
-> CInt
-> Word64
-> CInt
-> IO (Ptr Message)
gst_message_new_step_done Ptr Object
src' CUInt
format' Word64
amount CDouble
rate' CInt
flush' CInt
intermediate' Word64
duration CInt
eos'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStepDone" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_step_start
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if the step is active or queued"
--                 , 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 @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 stepped data"
--                 , 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 rate of the stepped amount"
--                 , 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 "is this an flushing step"
--                 , 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 "is this an intermediate step"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_step_start" gst_message_new_step_start :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CInt ->                                 -- active : TBasicType TBoolean
    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 Message)

-- | This message is posted by elements when they accept or activate a new step
-- event for /@amount@/ in /@format@/.
-- 
-- /@active@/ is set to 'P.False' when the element accepted the new step event and has
-- queued it for execution in the streaming threads.
-- 
-- /@active@/ is set to 'P.True' when the element has activated the step operation and
-- is now ready to start executing the step in the streaming thread. After this
-- message is emitted, the application can queue a new step operation in the
-- element.
messageNewStepStart ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: The object originating the message.
    -> Bool
    -- ^ /@active@/: if the step is active or queued
    -> Gst.Enums.Format
    -- ^ /@format@/: the format of /@amount@/
    -> Word64
    -- ^ /@amount@/: the amount of stepped data
    -> Double
    -- ^ /@rate@/: the rate of the stepped amount
    -> Bool
    -- ^ /@flush@/: is this an flushing step
    -> Bool
    -- ^ /@intermediate@/: is this an intermediate step
    -> m Message
    -- ^ __Returns:__ The new step_start message.
    -- 
    -- MT safe.
messageNewStepStart :: a
-> Bool -> Format -> Word64 -> Double -> Bool -> Bool -> m Message
messageNewStepStart src :: a
src active :: Bool
active format :: Format
format amount :: Word64
amount rate :: Double
rate flush :: Bool
flush intermediate :: Bool
intermediate = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let active' :: CInt
active' = (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
active
    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 Message
result <- Ptr Object
-> CInt
-> CUInt
-> Word64
-> CDouble
-> CInt
-> CInt
-> IO (Ptr Message)
gst_message_new_step_start Ptr Object
src' CInt
active' CUInt
format' Word64
amount CDouble
rate' CInt
flush' CInt
intermediate'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStepStart" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_stream_collection
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstObject that created the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamCollection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstStreamCollection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_stream_collection" gst_message_new_stream_collection :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.StreamCollection.StreamCollection -> -- collection : TInterface (Name {namespace = "Gst", name = "StreamCollection"})
    IO (Ptr Message)

-- | Creates a new stream-collection message. The message is used to announce new
-- t'GI.Gst.Objects.StreamCollection.StreamCollection'
-- 
-- /Since: 1.10/
messageNewStreamCollection ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.StreamCollection.IsStreamCollection b) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' that created the message
    -> b
    -- ^ /@collection@/: The t'GI.Gst.Objects.StreamCollection.StreamCollection'
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewStreamCollection :: a -> b -> m Message
messageNewStreamCollection src :: a
src collection :: b
collection = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr StreamCollection
collection' <- b -> IO (Ptr StreamCollection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
collection
    Ptr Message
result <- Ptr Object -> Ptr StreamCollection -> IO (Ptr Message)
gst_message_new_stream_collection Ptr Object
src' Ptr StreamCollection
collection'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStreamCollection" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
collection
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_stream_start
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_stream_start" gst_message_new_stream_start :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    IO (Ptr Message)

-- | Create a new stream_start message. This message is generated and posted in
-- the sink elements of a GstBin. The bin will only forward the STREAM_START
-- message to the application if all sinks have posted an STREAM_START message.
messageNewStreamStart ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> m Message
    -- ^ __Returns:__ The new stream_start message.
    -- 
    -- MT safe.
messageNewStreamStart :: Maybe a -> m Message
messageNewStreamStart src :: Maybe a
src = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr Message
result <- Ptr Object -> IO (Ptr Message)
gst_message_new_stream_start Ptr Object
maybeSrc
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStreamStart" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_stream_status
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamStatusType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The stream status type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "owner"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the owner element of @src."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_stream_status" gst_message_new_stream_status :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "StreamStatusType"})
    Ptr Gst.Element.Element ->              -- owner : TInterface (Name {namespace = "Gst", name = "Element"})
    IO (Ptr Message)

-- | Create a new stream status message. This message is posted when a streaming
-- thread is created\/destroyed or when the state changed.
messageNewStreamStatus ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Element.IsElement b) =>
    a
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.StreamStatusType
    -- ^ /@type@/: The stream status type.
    -> b
    -- ^ /@owner@/: the owner element of /@src@/.
    -> m Message
    -- ^ __Returns:__ the new stream status message.
    -- 
    -- MT safe.
messageNewStreamStatus :: a -> StreamStatusType -> b -> m Message
messageNewStreamStatus src :: a
src type_ :: StreamStatusType
type_ owner :: b
owner = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StreamStatusType -> Int) -> StreamStatusType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamStatusType -> Int
forall a. Enum a => a -> Int
fromEnum) StreamStatusType
type_
    Ptr Element
owner' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
owner
    Ptr Message
result <- Ptr Object -> CUInt -> Ptr Element -> IO (Ptr Message)
gst_message_new_stream_status Ptr Object
src' CUInt
type_' Ptr Element
owner'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStreamStatus" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
owner
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_streams_selected
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstObject that created the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamCollection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstStreamCollection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_streams_selected" gst_message_new_streams_selected :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.StreamCollection.StreamCollection -> -- collection : TInterface (Name {namespace = "Gst", name = "StreamCollection"})
    IO (Ptr Message)

-- | Creates a new steams-selected message. The message is used to announce
-- that an array of streams has been selected. This is generally in response
-- to a @/GST_EVENT_SELECT_STREAMS/@ event, or when an element (such as decodebin3)
-- makes an initial selection of streams.
-- 
-- The message also contains the t'GI.Gst.Objects.StreamCollection.StreamCollection' to which the various streams
-- belong to.
-- 
-- Users of 'GI.Gst.Structs.Message.messageNewStreamsSelected' can add the selected streams with
-- 'GI.Gst.Structs.Message.messageStreamsSelectedAdd'.
-- 
-- /Since: 1.10/
messageNewStreamsSelected ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.StreamCollection.IsStreamCollection b) =>
    a
    -- ^ /@src@/: The t'GI.Gst.Objects.Object.Object' that created the message
    -> b
    -- ^ /@collection@/: The t'GI.Gst.Objects.StreamCollection.StreamCollection'
    -> m Message
    -- ^ __Returns:__ a newly allocated t'GI.Gst.Structs.Message.Message'
messageNewStreamsSelected :: a -> b -> m Message
messageNewStreamsSelected src :: a
src collection :: b
collection = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    Ptr StreamCollection
collection' <- b -> IO (Ptr StreamCollection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
collection
    Ptr Message
result <- Ptr Object -> Ptr StreamCollection -> IO (Ptr Message)
gst_message_new_streams_selected Ptr Object
src' Ptr StreamCollection
collection'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStreamsSelected" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
collection
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_structure_change
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "StructureChangeType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The change type." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "owner"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The owner element of @src."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "busy"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the structure change is busy."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_structure_change" gst_message_new_structure_change :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "StructureChangeType"})
    Ptr Gst.Element.Element ->              -- owner : TInterface (Name {namespace = "Gst", name = "Element"})
    CInt ->                                 -- busy : TBasicType TBoolean
    IO (Ptr Message)

-- | Create a new structure change message. This message is posted when the
-- structure of a pipeline is in the process of being changed, for example
-- when pads are linked or unlinked.
-- 
-- /@src@/ should be the sinkpad that unlinked or linked.
messageNewStructureChange ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a, Gst.Element.IsElement b) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.Enums.StructureChangeType
    -- ^ /@type@/: The change type.
    -> b
    -- ^ /@owner@/: The owner element of /@src@/.
    -> Bool
    -- ^ /@busy@/: Whether the structure change is busy.
    -> m Message
    -- ^ __Returns:__ the new structure change message.
    -- 
    -- MT safe.
messageNewStructureChange :: Maybe a -> StructureChangeType -> b -> Bool -> m Message
messageNewStructureChange src :: Maybe a
src type_ :: StructureChangeType
type_ owner :: b
owner busy :: Bool
busy = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StructureChangeType -> Int) -> StructureChangeType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureChangeType -> Int
forall a. Enum a => a -> Int
fromEnum) StructureChangeType
type_
    Ptr Element
owner' <- b -> IO (Ptr Element)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
owner
    let busy' :: CInt
busy' = (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
busy
    Ptr Message
result <- Ptr Object -> CUInt -> Ptr Element -> CInt -> IO (Ptr Message)
gst_message_new_structure_change Ptr Object
maybeSrc CUInt
type_' Ptr Element
owner' CInt
busy'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewStructureChange" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
owner
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_tag
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag_list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the tag list for the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_tag" gst_message_new_tag :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.TagList.TagList ->              -- tag_list : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO (Ptr Message)

-- | Create a new tag message. The message will take ownership of the tag list.
-- The message is posted by elements that discovered a new taglist.
messageNewTag ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> Gst.TagList.TagList
    -- ^ /@tagList@/: the tag list for the message.
    -> m Message
    -- ^ __Returns:__ the new tag message.
    -- 
    -- MT safe.
messageNewTag :: Maybe a -> TagList -> m Message
messageNewTag src :: Maybe a
src tagList :: TagList
tagList = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr TagList
tagList' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TagList
tagList
    Ptr Message
result <- Ptr Object -> Ptr TagList -> IO (Ptr Message)
gst_message_new_tag Ptr Object
maybeSrc Ptr TagList
tagList'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewTag" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TagList
tagList
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_toc
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "toc"
--           , argType = TInterface Name { namespace = "Gst" , name = "Toc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstToc structure for the message."
--                 , 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 = "Message" })
-- throws : False
-- Skip return : False

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

-- | Create a new TOC message. The message is posted by elements
-- that discovered or updated a TOC.
messageNewToc ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    a
    -- ^ /@src@/: the object originating the message.
    -> Gst.Toc.Toc
    -- ^ /@toc@/: t'GI.Gst.Structs.Toc.Toc' structure for the message.
    -> Bool
    -- ^ /@updated@/: whether TOC was updated or not.
    -> m Message
    -- ^ __Returns:__ a new TOC message.
    -- 
    -- MT safe.
messageNewToc :: a -> Toc -> Bool -> m Message
messageNewToc src :: a
src toc :: Toc
toc updated :: Bool
updated = 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 Object
src' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
src
    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 Message
result <- Ptr Object -> Ptr Toc -> CInt -> IO (Ptr Message)
gst_message_new_toc Ptr Object
src' Ptr Toc
toc' CInt
updated'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewToc" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
src
    Toc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Toc
toc
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_warning
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GError for this message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A debugging string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_warning" gst_message_new_warning :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    IO (Ptr Message)

-- | Create a new warning message. The message will make copies of /@error@/ and
-- /@debug@/.
messageNewWarning ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> GError
    -- ^ /@error@/: The GError for this message.
    -> T.Text
    -- ^ /@debug@/: A debugging string.
    -> m Message
    -- ^ __Returns:__ the new warning message.
    -- 
    -- MT safe.
messageNewWarning :: Maybe a -> GError -> Text -> m Message
messageNewWarning src :: Maybe a
src error_ :: GError
error_ debug :: Text
debug = 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 Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    CString
debug' <- Text -> IO CString
textToCString Text
debug
    Ptr Message
result <- Ptr Object -> Ptr GError -> CString -> IO (Ptr Message)
gst_message_new_warning Ptr Object
maybeSrc Ptr GError
error_' CString
debug'
    Text -> Ptr Message -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageNewWarning" Ptr Message
result
    Message
result' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::new_warning_with_details
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "src"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object originating the message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The GError for this message."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A debugging string."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "details"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A GstStructure with details"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Message" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_new_warning_with_details" gst_message_new_warning_with_details :: 
    Ptr Gst.Object.Object ->                -- src : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    Ptr Gst.Structure.Structure ->          -- details : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Message)

-- | Create a new warning message. The message will make copies of /@error@/ and
-- /@debug@/.
-- 
-- /Since: 1.10/
messageNewWarningWithDetails ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Object.IsObject a) =>
    Maybe (a)
    -- ^ /@src@/: The object originating the message.
    -> GError
    -- ^ /@error@/: The GError for this message.
    -> T.Text
    -- ^ /@debug@/: A debugging string.
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@details@/: A GstStructure with details
    -> m (Maybe Message)
    -- ^ __Returns:__ the new warning message.
messageNewWarningWithDetails :: Maybe a -> GError -> Text -> Maybe Structure -> m (Maybe Message)
messageNewWarningWithDetails src :: Maybe a
src error_ :: GError
error_ debug :: Text
debug details :: Maybe Structure
details = IO (Maybe Message) -> m (Maybe Message)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Message) -> m (Maybe Message))
-> IO (Maybe Message) -> m (Maybe Message)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeSrc <- case Maybe a
src of
        Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just jSrc :: a
jSrc -> do
            Ptr Object
jSrc' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSrc
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSrc'
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    CString
debug' <- Text -> IO CString
textToCString Text
debug
    Ptr Structure
maybeDetails <- case Maybe Structure
details of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jDetails :: Structure
jDetails -> do
            Ptr Structure
jDetails' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jDetails
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jDetails'
    Ptr Message
result <- Ptr Object
-> Ptr GError -> CString -> Ptr Structure -> IO (Ptr Message)
gst_message_new_warning_with_details Ptr Object
maybeSrc Ptr GError
error_' CString
debug' Ptr Structure
maybeDetails
    Maybe Message
maybeResult <- Ptr Message -> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Message
result ((Ptr Message -> IO Message) -> IO (Maybe Message))
-> (Ptr Message -> IO Message) -> IO (Maybe Message)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Message
result' -> do
        Message
result'' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Message -> Message
Message) Ptr Message
result'
        Message -> IO Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
result''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
src a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
details Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Maybe Message -> IO (Maybe Message)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Message
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Message::add_redirect_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMessage of type %GST_MESSAGE_REDIRECT"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location string for the new entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag_list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "tag list for the new entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "entry_struct"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "structure for the new entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_add_redirect_entry" gst_message_add_redirect_entry :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    CString ->                              -- location : TBasicType TUTF8
    Ptr Gst.TagList.TagList ->              -- tag_list : TInterface (Name {namespace = "Gst", name = "TagList"})
    Ptr Gst.Structure.Structure ->          -- entry_struct : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Creates and appends a new entry.
-- 
-- The specified location string is copied. However, ownership over the tag
-- list and structure are transferred to the message.
-- 
-- /Since: 1.10/
messageAddRedirectEntry ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeRedirect'
    -> T.Text
    -- ^ /@location@/: location string for the new entry
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tagList@/: tag list for the new entry
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@entryStruct@/: structure for the new entry
    -> m ()
messageAddRedirectEntry :: Message -> Text -> Maybe TagList -> Maybe Structure -> m ()
messageAddRedirectEntry message :: Message
message location :: Text
location tagList :: Maybe TagList
tagList entryStruct :: Maybe Structure
entryStruct = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    CString
location' <- Text -> IO CString
textToCString Text
location
    Ptr TagList
maybeTagList <- case Maybe TagList
tagList of
        Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just jTagList :: TagList
jTagList -> do
            Ptr TagList
jTagList' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed TagList
jTagList
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTagList'
    Ptr Structure
maybeEntryStruct <- case Maybe Structure
entryStruct of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jEntryStruct :: Structure
jEntryStruct -> do
            Ptr Structure
jEntryStruct' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jEntryStruct
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jEntryStruct'
    Ptr Message -> CString -> Ptr TagList -> Ptr Structure -> IO ()
gst_message_add_redirect_entry Ptr Message
message' CString
location' Ptr TagList
maybeTagList Ptr Structure
maybeEntryStruct
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tagList TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
entryStruct Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
location'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageAddRedirectEntryMethodInfo
instance (signature ~ (T.Text -> Maybe (Gst.TagList.TagList) -> Maybe (Gst.Structure.Structure) -> m ()), MonadIO m) => O.MethodInfo MessageAddRedirectEntryMethodInfo Message signature where
    overloadedMethod = messageAddRedirectEntry

#endif

-- method Message::get_num_redirect_entries
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMessage of type %GST_MESSAGE_REDIRECT"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_get_num_redirect_entries" gst_message_get_num_redirect_entries :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO Word64

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
messageGetNumRedirectEntries ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeRedirect'
    -> m Word64
    -- ^ __Returns:__ the number of entries stored in the message
messageGetNumRedirectEntries :: Message -> m Word64
messageGetNumRedirectEntries message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Word64
result <- Ptr Message -> IO Word64
gst_message_get_num_redirect_entries Ptr Message
message'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data MessageGetNumRedirectEntriesMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.MethodInfo MessageGetNumRedirectEntriesMethodInfo Message signature where
    overloadedMethod = messageGetNumRedirectEntries

#endif

-- method Message::get_seqnum
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstMessage." , 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_message_get_seqnum" gst_message_get_seqnum :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO Word32

-- | Retrieve the sequence number of a message.
-- 
-- Messages have ever-incrementing sequence numbers, which may also be set
-- explicitly via 'GI.Gst.Structs.Message.messageSetSeqnum'. Sequence numbers are typically used
-- to indicate that a message corresponds to some other set of messages or
-- events, for example a SEGMENT_DONE message 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.
messageGetSeqnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A t'GI.Gst.Structs.Message.Message'.
    -> m Word32
    -- ^ __Returns:__ The message\'s sequence number.
    -- 
    -- MT safe.
messageGetSeqnum :: Message -> m Word32
messageGetSeqnum message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Word32
result <- Ptr Message -> IO Word32
gst_message_get_seqnum Ptr Message
message'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data MessageGetSeqnumMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo MessageGetSeqnumMethodInfo Message signature where
    overloadedMethod = messageGetSeqnum

#endif

-- method Message::get_stream_status_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STREAM_STATUS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_get_stream_status_object" gst_message_get_stream_status_object :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO (Ptr GValue)

-- | Extracts the object managing the streaming thread from /@message@/.
messageGetStreamStatusObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STREAM_STATUS.
    -> m (Maybe GValue)
    -- ^ __Returns:__ a GValue containing the object that manages the
    -- streaming thread. This object is usually of type GstTask but other types can
    -- be added in the future. The object remains valid as long as /@message@/ is
    -- valid.
messageGetStreamStatusObject :: Message -> m (Maybe GValue)
messageGetStreamStatusObject message :: Message
message = IO (Maybe GValue) -> m (Maybe GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr GValue
result <- Ptr Message -> IO (Ptr GValue)
gst_message_get_stream_status_object Ptr Message
message'
    Maybe GValue
maybeResult <- Ptr GValue -> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GValue
result ((Ptr GValue -> IO GValue) -> IO (Maybe GValue))
-> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr GValue
result' -> do
        GValue
result'' <- ((ManagedPtr GValue -> GValue) -> Ptr GValue -> IO GValue
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GValue -> GValue
GValue) Ptr GValue
result'
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Maybe GValue -> IO (Maybe GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data MessageGetStreamStatusObjectMethodInfo
instance (signature ~ (m (Maybe GValue)), MonadIO m) => O.MethodInfo MessageGetStreamStatusObjectMethodInfo Message signature where
    overloadedMethod = messageGetStreamStatusObject

#endif

-- method Message::get_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstMessage." , 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_message_get_structure" gst_message_get_structure :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO (Ptr Gst.Structure.Structure)

-- | Access the structure of the message.
messageGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: The t'GI.Gst.Structs.Message.Message'.
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ The structure of the message. The
    -- structure is still owned by the message, which means that you should not
    -- free it and that the pointer becomes invalid when you free the message.
    -- 
    -- MT safe.
messageGetStructure :: Message -> m (Maybe Structure)
messageGetStructure message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Structure
result <- Ptr Message -> IO (Ptr Structure)
gst_message_get_structure Ptr Message
message'
    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
$ \result' :: Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject 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''
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data MessageGetStructureMethodInfo
instance (signature ~ (m (Maybe Gst.Structure.Structure)), MonadIO m) => O.MethodInfo MessageGetStructureMethodInfo Message signature where
    overloadedMethod = messageGetStructure

#endif

-- method Message::has_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstMessage." , 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_message_has_name" gst_message_has_name :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks if /@message@/ has the given /@name@/. This function is usually used to
-- check the name of a custom message.
messageHasName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: The t'GI.Gst.Structs.Message.Message'.
    -> T.Text
    -- ^ /@name@/: name to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@name@/ matches the name of the message structure.
messageHasName :: Message -> Text -> m Bool
messageHasName message :: Message
message name :: 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Message -> CString -> IO CInt
gst_message_has_name Ptr Message
message' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageHasNameMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo MessageHasNameMethodInfo Message signature where
    overloadedMethod = messageHasName

#endif

-- method Message::parse_async_done
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_ASYNC_DONE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Result location for the running_time 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_message_parse_async_done" gst_message_parse_async_done :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Word64 ->                           -- running_time : TBasicType TUInt64
    IO ()

-- | Extract the running_time from the async_done message.
-- 
-- MT safe.
messageParseAsyncDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_ASYNC_DONE.
    -> m (Word64)
messageParseAsyncDone :: Message -> m Word64
messageParseAsyncDone message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Word64
runningTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Message -> Ptr Word64 -> IO ()
gst_message_parse_async_done Ptr Message
message' Ptr Word64
runningTime
    Word64
runningTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
runningTime
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
runningTime
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
runningTime'

#if defined(ENABLE_OVERLOADING)
data MessageParseAsyncDoneMethodInfo
instance (signature ~ (m (Word64)), MonadIO m) => O.MethodInfo MessageParseAsyncDoneMethodInfo Message signature where
    overloadedMethod = messageParseAsyncDone

#endif

-- method Message::parse_buffering
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "percent"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for the percent."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_buffering" gst_message_parse_buffering :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Int32 ->                            -- percent : TBasicType TInt
    IO ()

-- | Extracts the buffering percent from the GstMessage. see also
-- 'GI.Gst.Structs.Message.messageNewBuffering'.
-- 
-- MT safe.
messageParseBuffering ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_BUFFERING.
    -> m (Int32)
messageParseBuffering :: Message -> m Int32
messageParseBuffering message :: Message
message = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Int32
percent <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Message -> Ptr Int32 -> IO ()
gst_message_parse_buffering Ptr Message
message' Ptr Int32
percent
    Int32
percent' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
percent
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
percent
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
percent'

#if defined(ENABLE_OVERLOADING)
data MessageParseBufferingMethodInfo
instance (signature ~ (m (Int32)), MonadIO m) => O.MethodInfo MessageParseBufferingMethodInfo Message signature where
    overloadedMethod = messageParseBuffering

#endif

-- method Message::parse_buffering_stats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferingMode" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffering mode, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "avg_in"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average input rate, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "avg_out"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average output rate, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "buffering_left"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "amount of buffering time left in\n    milliseconds, 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_message_parse_buffering_stats" gst_message_parse_buffering_stats :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- mode : TInterface (Name {namespace = "Gst", name = "BufferingMode"})
    Ptr Int32 ->                            -- avg_in : TBasicType TInt
    Ptr Int32 ->                            -- avg_out : TBasicType TInt
    Ptr Int64 ->                            -- buffering_left : TBasicType TInt64
    IO ()

-- | Extracts the buffering stats values from /@message@/.
messageParseBufferingStats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_BUFFERING.
    -> m ((Gst.Enums.BufferingMode, Int32, Int32, Int64))
messageParseBufferingStats :: Message -> m (BufferingMode, Int32, Int32, Int64)
messageParseBufferingStats message :: Message
message = IO (BufferingMode, Int32, Int32, Int64)
-> m (BufferingMode, Int32, Int32, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (BufferingMode, Int32, Int32, Int64)
 -> m (BufferingMode, Int32, Int32, Int64))
-> IO (BufferingMode, Int32, Int32, Int64)
-> m (BufferingMode, Int32, Int32, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
mode <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Int32
avgIn <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
avgOut <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int64
bufferingLeft <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr Message
-> Ptr CUInt -> Ptr Int32 -> Ptr Int32 -> Ptr Int64 -> IO ()
gst_message_parse_buffering_stats Ptr Message
message' Ptr CUInt
mode Ptr Int32
avgIn Ptr Int32
avgOut Ptr Int64
bufferingLeft
    CUInt
mode' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
mode
    let mode'' :: BufferingMode
mode'' = (Int -> BufferingMode
forall a. Enum a => Int -> a
toEnum (Int -> BufferingMode) -> (CUInt -> Int) -> CUInt -> BufferingMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
mode'
    Int32
avgIn' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
avgIn
    Int32
avgOut' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
avgOut
    Int64
bufferingLeft' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
bufferingLeft
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
mode
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
avgIn
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
avgOut
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
bufferingLeft
    (BufferingMode, Int32, Int32, Int64)
-> IO (BufferingMode, Int32, Int32, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferingMode
mode'', Int32
avgIn', Int32
avgOut', Int64
bufferingLeft')

#if defined(ENABLE_OVERLOADING)
data MessageParseBufferingStatsMethodInfo
instance (signature ~ (m ((Gst.Enums.BufferingMode, Int32, Int32, Int64))), MonadIO m) => O.MethodInfo MessageParseBufferingStatsMethodInfo Message signature where
    overloadedMethod = messageParseBufferingStats

#endif

-- method Message::parse_clock_lost
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_CLOCK_LOST."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to hold the lost clock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_clock_lost" gst_message_parse_clock_lost :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Clock.Clock) ->            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO ()

-- | Extracts the lost clock from the GstMessage.
-- The clock object returned remains valid until the message is freed.
-- 
-- MT safe.
messageParseClockLost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_CLOCK_LOST.
    -> m (Gst.Clock.Clock)
messageParseClockLost :: Message -> m Clock
messageParseClockLost message :: Message
message = IO Clock -> m Clock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Clock -> m Clock) -> IO Clock -> m Clock
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Clock)
clock <- IO (Ptr (Ptr Clock))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Clock.Clock))
    Ptr Message -> Ptr (Ptr Clock) -> IO ()
gst_message_parse_clock_lost Ptr Message
message' Ptr (Ptr Clock)
clock
    Ptr Clock
clock' <- Ptr (Ptr Clock) -> IO (Ptr Clock)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Clock)
clock
    Clock
clock'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
clock'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Clock) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Clock)
clock
    Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
clock''

#if defined(ENABLE_OVERLOADING)
data MessageParseClockLostMethodInfo
instance (signature ~ (m (Gst.Clock.Clock)), MonadIO m) => O.MethodInfo MessageParseClockLostMethodInfo Message signature where
    overloadedMethod = messageParseClockLost

#endif

-- method Message::parse_clock_provide
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_CLOCK_PROVIDE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to  hold a clock\n    object, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ready"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to hold the ready flag, 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_message_parse_clock_provide" gst_message_parse_clock_provide :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Clock.Clock) ->            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Ptr CInt ->                             -- ready : TBasicType TBoolean
    IO ()

-- | Extracts the clock and ready flag from the GstMessage.
-- The clock object returned remains valid until the message is freed.
-- 
-- MT safe.
messageParseClockProvide ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_CLOCK_PROVIDE.
    -> m ((Gst.Clock.Clock, Bool))
messageParseClockProvide :: Message -> m (Clock, Bool)
messageParseClockProvide message :: Message
message = IO (Clock, Bool) -> m (Clock, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Clock, Bool) -> m (Clock, Bool))
-> IO (Clock, Bool) -> m (Clock, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Clock)
clock <- IO (Ptr (Ptr Clock))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Clock.Clock))
    Ptr CInt
ready <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Message -> Ptr (Ptr Clock) -> Ptr CInt -> IO ()
gst_message_parse_clock_provide Ptr Message
message' Ptr (Ptr Clock)
clock Ptr CInt
ready
    Ptr Clock
clock' <- Ptr (Ptr Clock) -> IO (Ptr Clock)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Clock)
clock
    Clock
clock'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
clock'
    CInt
ready' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ready
    let ready'' :: Bool
ready'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
ready'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Clock) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Clock)
clock
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
ready
    (Clock, Bool) -> IO (Clock, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Clock
clock'', Bool
ready'')

#if defined(ENABLE_OVERLOADING)
data MessageParseClockProvideMethodInfo
instance (signature ~ (m ((Gst.Clock.Clock, Bool))), MonadIO m) => O.MethodInfo MessageParseClockProvideMethodInfo Message signature where
    overloadedMethod = messageParseClockProvide

#endif

-- method Message::parse_context_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GST_MESSAGE_NEED_CONTEXT type message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the context type, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_context_type" gst_message_parse_context_type :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CString ->                          -- context_type : TBasicType TUTF8
    IO CInt

-- | Parse a context type from an existing GST_MESSAGE_NEED_CONTEXT message.
-- 
-- /Since: 1.2/
messageParseContextType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a GST_MESSAGE_NEED_CONTEXT type message
    -> m ((Bool, T.Text))
    -- ^ __Returns:__ a t'P.Bool' indicating if the parsing succeeded.
messageParseContextType :: Message -> m (Bool, Text)
messageParseContextType message :: Message
message = IO (Bool, Text) -> m (Bool, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text) -> m (Bool, Text))
-> IO (Bool, Text) -> m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CString
contextType <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    CInt
result <- Ptr Message -> Ptr CString -> IO CInt
gst_message_parse_context_type Ptr Message
message' Ptr CString
contextType
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CString
contextType' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
contextType
    Text
contextType'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
contextType'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
contextType
    (Bool, Text) -> IO (Bool, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
contextType'')

#if defined(ENABLE_OVERLOADING)
data MessageParseContextTypeMethodInfo
instance (signature ~ (m ((Bool, T.Text))), MonadIO m) => O.MethodInfo MessageParseContextTypeMethodInfo Message signature where
    overloadedMethod = messageParseContextType

#endif

-- method Message::parse_device_added
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_DEVICE_ADDED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A location where to store a\n pointer to the new #GstDevice, 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_message_parse_device_added" gst_message_parse_device_added :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Device.Device) ->          -- device : TInterface (Name {namespace = "Gst", name = "Device"})
    IO ()

-- | Parses a device-added message. The device-added message is produced by
-- t'GI.Gst.Objects.DeviceProvider.DeviceProvider' or a t'GI.Gst.Objects.DeviceMonitor.DeviceMonitor'. It announces the appearance
-- of monitored devices.
-- 
-- /Since: 1.4/
messageParseDeviceAdded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeDeviceAdded'
    -> m (Gst.Device.Device)
messageParseDeviceAdded :: Message -> m Device
messageParseDeviceAdded message :: Message
message = IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Device)
device <- IO (Ptr (Ptr Device))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Device.Device))
    Ptr Message -> Ptr (Ptr Device) -> IO ()
gst_message_parse_device_added Ptr Message
message' Ptr (Ptr Device)
device
    Ptr Device
device' <- Ptr (Ptr Device) -> IO (Ptr Device)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Device)
device
    Device
device'' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Device -> Device
Gst.Device.Device) Ptr Device
device'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Device) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Device)
device
    Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
device''

#if defined(ENABLE_OVERLOADING)
data MessageParseDeviceAddedMethodInfo
instance (signature ~ (m (Gst.Device.Device)), MonadIO m) => O.MethodInfo MessageParseDeviceAddedMethodInfo Message signature where
    overloadedMethod = messageParseDeviceAdded

#endif

-- method Message::parse_device_changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_DEVICE_CHANGED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A location where to store a\n pointer to the updated version of the #GstDevice, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "changed_device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A location where to store a\n pointer to the old version of the #GstDevice, 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_message_parse_device_changed" gst_message_parse_device_changed :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Device.Device) ->          -- device : TInterface (Name {namespace = "Gst", name = "Device"})
    Ptr (Ptr Gst.Device.Device) ->          -- changed_device : TInterface (Name {namespace = "Gst", name = "Device"})
    IO ()

-- | Parses a device-changed message. The device-changed message is produced by
-- t'GI.Gst.Objects.DeviceProvider.DeviceProvider' or a t'GI.Gst.Objects.DeviceMonitor.DeviceMonitor'. It announces the
-- disappearance of monitored devices. * It announce that a device properties has
-- changed and /@device@/ represents the new modified version of /@changedDevice@/.
-- 
-- /Since: 1.16/
messageParseDeviceChanged ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeDeviceChanged'
    -> m ((Gst.Device.Device, Gst.Device.Device))
messageParseDeviceChanged :: Message -> m (Device, Device)
messageParseDeviceChanged message :: Message
message = IO (Device, Device) -> m (Device, Device)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Device, Device) -> m (Device, Device))
-> IO (Device, Device) -> m (Device, Device)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Device)
device <- IO (Ptr (Ptr Device))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Device.Device))
    Ptr (Ptr Device)
changedDevice <- IO (Ptr (Ptr Device))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Device.Device))
    Ptr Message -> Ptr (Ptr Device) -> Ptr (Ptr Device) -> IO ()
gst_message_parse_device_changed Ptr Message
message' Ptr (Ptr Device)
device Ptr (Ptr Device)
changedDevice
    Ptr Device
device' <- Ptr (Ptr Device) -> IO (Ptr Device)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Device)
device
    Device
device'' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Device -> Device
Gst.Device.Device) Ptr Device
device'
    Ptr Device
changedDevice' <- Ptr (Ptr Device) -> IO (Ptr Device)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Device)
changedDevice
    Device
changedDevice'' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Device -> Device
Gst.Device.Device) Ptr Device
changedDevice'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Device) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Device)
device
    Ptr (Ptr Device) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Device)
changedDevice
    (Device, Device) -> IO (Device, Device)
forall (m :: * -> *) a. Monad m => a -> m a
return (Device
device'', Device
changedDevice'')

#if defined(ENABLE_OVERLOADING)
data MessageParseDeviceChangedMethodInfo
instance (signature ~ (m ((Gst.Device.Device, Gst.Device.Device))), MonadIO m) => O.MethodInfo MessageParseDeviceChangedMethodInfo Message signature where
    overloadedMethod = messageParseDeviceChanged

#endif

-- method Message::parse_device_removed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_DEVICE_REMOVED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gst" , name = "Device" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A location where to store a\n pointer to the removed #GstDevice, 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_message_parse_device_removed" gst_message_parse_device_removed :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Device.Device) ->          -- device : TInterface (Name {namespace = "Gst", name = "Device"})
    IO ()

-- | Parses a device-removed message. The device-removed message is produced by
-- t'GI.Gst.Objects.DeviceProvider.DeviceProvider' or a t'GI.Gst.Objects.DeviceMonitor.DeviceMonitor'. It announces the
-- disappearance of monitored devices.
-- 
-- /Since: 1.4/
messageParseDeviceRemoved ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeDeviceRemoved'
    -> m (Gst.Device.Device)
messageParseDeviceRemoved :: Message -> m Device
messageParseDeviceRemoved message :: Message
message = IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Device)
device <- IO (Ptr (Ptr Device))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Device.Device))
    Ptr Message -> Ptr (Ptr Device) -> IO ()
gst_message_parse_device_removed Ptr Message
message' Ptr (Ptr Device)
device
    Ptr Device
device' <- Ptr (Ptr Device) -> IO (Ptr Device)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Device)
device
    Device
device'' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Device -> Device
Gst.Device.Device) Ptr Device
device'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Device) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Device)
device
    Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
device''

#if defined(ENABLE_OVERLOADING)
data MessageParseDeviceRemovedMethodInfo
instance (signature ~ (m (Gst.Device.Device)), MonadIO m) => O.MethodInfo MessageParseDeviceRemovedMethodInfo Message signature where
    overloadedMethod = messageParseDeviceRemoved

#endif

-- method Message::parse_error
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_ERROR."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gerror"
--           , argType = TError
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the GError"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the debug message,\n    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_message_parse_error" gst_message_parse_error :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr GError) ->                     -- gerror : TError
    Ptr CString ->                          -- debug : TBasicType TUTF8
    IO ()

-- | Extracts the GError and debug string from the GstMessage. The values returned
-- in the output arguments are copies; the caller must free them when done.
-- 
-- Typical usage of this function might be:
-- 
-- === /C code/
-- >
-- >  ...
-- >  switch (GST_MESSAGE_TYPE (msg)) {
-- >    case GST_MESSAGE_ERROR: {
-- >      GError *err = NULL;
-- >      gchar *dbg_info = NULL;
-- >
-- >      gst_message_parse_error (msg, &amp;err, &amp;dbg_info);
-- >      g_printerr ("ERROR from element %s: %s\n",
-- >          GST_OBJECT_NAME (msg->src), err->message);
-- >      g_printerr ("Debugging info: %s\n", (dbg_info) ? dbg_info : "none");
-- >      g_error_free (err);
-- >      g_free (dbg_info);
-- >      break;
-- >    }
-- >    ...
-- >  }
-- >  ...
-- 
-- 
-- MT safe.
messageParseError ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_ERROR.
    -> m ((GError, T.Text))
messageParseError :: Message -> m (GError, Text)
messageParseError message :: Message
message = IO (GError, Text) -> m (GError, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GError, Text) -> m (GError, Text))
-> IO (GError, Text) -> m (GError, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr GError)
gerror <- IO (Ptr (Ptr GError))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GError))
    Ptr CString
debug <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Message -> Ptr (Ptr GError) -> Ptr CString -> IO ()
gst_message_parse_error Ptr Message
message' Ptr (Ptr GError)
gerror Ptr CString
debug
    Ptr GError
gerror' <- Ptr (Ptr GError) -> IO (Ptr GError)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
gerror
    GError
gerror'' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GError -> GError
GError) Ptr GError
gerror'
    CString
debug' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
debug
    Text
debug'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
debug'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr GError) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GError)
gerror
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
debug
    (GError, Text) -> IO (GError, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (GError
gerror'', Text
debug'')

#if defined(ENABLE_OVERLOADING)
data MessageParseErrorMethodInfo
instance (signature ~ (m ((GError, T.Text))), MonadIO m) => O.MethodInfo MessageParseErrorMethodInfo Message signature where
    overloadedMethod = messageParseError

#endif

-- method Message::parse_error_details
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The message object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the returned details"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Returns the optional details structure, may be NULL if none.
-- The returned structure must not be freed.
-- 
-- /Since: 1.10/
messageParseErrorDetails ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: The message object
    -> m (Gst.Structure.Structure)
messageParseErrorDetails :: Message -> m Structure
messageParseErrorDetails message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Structure)
structure <- IO (Ptr (Ptr Structure))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Structure.Structure))
    Ptr Message -> Ptr (Ptr Structure) -> IO ()
gst_message_parse_error_details Ptr Message
message' Ptr (Ptr Structure)
structure
    Ptr Structure
structure' <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Structure)
structure
    Structure
structure'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
structure'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Structure) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Structure)
structure
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
structure''

#if defined(ENABLE_OVERLOADING)
data MessageParseErrorDetailsMethodInfo
instance (signature ~ (m (Gst.Structure.Structure)), MonadIO m) => O.MethodInfo MessageParseErrorDetailsMethodInfo Message signature where
    overloadedMethod = messageParseErrorDetails

#endif

-- method Message::parse_group_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STREAM_START."
--                 , 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 "Result location for the group id or\n     %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_group_id" gst_message_parse_group_id :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Word32 ->                           -- group_id : TBasicType TUInt
    IO CInt

-- | Extract the group from the STREAM_START message.
-- 
-- /Since: 1.2/
messageParseGroupId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STREAM_START.
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the message had a group id set, 'P.False' otherwise
    -- 
    -- MT safe.
messageParseGroupId :: Message -> m (Bool, Word32)
messageParseGroupId message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Word32
groupId <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Message -> Ptr Word32 -> IO CInt
gst_message_parse_group_id Ptr Message
message' Ptr Word32
groupId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
groupId' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
groupId
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseGroupIdMethodInfo
instance (signature ~ (m ((Bool, Word32))), MonadIO m) => O.MethodInfo MessageParseGroupIdMethodInfo Message signature where
    overloadedMethod = messageParseGroupId

#endif

-- method Message::parse_have_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_HAVE_CONTEXT."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Result location for the\n     context 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_message_parse_have_context" gst_message_parse_have_context :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Context.Context) ->        -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO ()

-- | Extract the context from the HAVE_CONTEXT message.
-- 
-- MT safe.
-- 
-- /Since: 1.2/
messageParseHaveContext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_HAVE_CONTEXT.
    -> m (Gst.Context.Context)
messageParseHaveContext :: Message -> m Context
messageParseHaveContext message :: Message
message = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Context)
context <- IO (Ptr (Ptr Context))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Context.Context))
    Ptr Message -> Ptr (Ptr Context) -> IO ()
gst_message_parse_have_context Ptr Message
message' Ptr (Ptr Context)
context
    Ptr Context
context' <- Ptr (Ptr Context) -> IO (Ptr Context)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Context)
context
    Context
context'' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Context -> Context
Gst.Context.Context) Ptr Context
context'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Context) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Context)
context
    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
context''

#if defined(ENABLE_OVERLOADING)
data MessageParseHaveContextMethodInfo
instance (signature ~ (m (Gst.Context.Context)), MonadIO m) => O.MethodInfo MessageParseHaveContextMethodInfo Message signature where
    overloadedMethod = messageParseHaveContext

#endif

-- method Message::parse_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_INFO."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gerror"
--           , argType = TError
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the GError"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the debug message,\n    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_message_parse_info" gst_message_parse_info :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr GError) ->                     -- gerror : TError
    Ptr CString ->                          -- debug : TBasicType TUTF8
    IO ()

-- | Extracts the GError and debug string from the GstMessage. The values returned
-- in the output arguments are copies; the caller must free them when done.
-- 
-- MT safe.
messageParseInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_INFO.
    -> m ((GError, T.Text))
messageParseInfo :: Message -> m (GError, Text)
messageParseInfo message :: Message
message = IO (GError, Text) -> m (GError, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GError, Text) -> m (GError, Text))
-> IO (GError, Text) -> m (GError, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr GError)
gerror <- IO (Ptr (Ptr GError))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GError))
    Ptr CString
debug <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Message -> Ptr (Ptr GError) -> Ptr CString -> IO ()
gst_message_parse_info Ptr Message
message' Ptr (Ptr GError)
gerror Ptr CString
debug
    Ptr GError
gerror' <- Ptr (Ptr GError) -> IO (Ptr GError)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
gerror
    GError
gerror'' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GError -> GError
GError) Ptr GError
gerror'
    CString
debug' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
debug
    Text
debug'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
debug'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr GError) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GError)
gerror
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
debug
    (GError, Text) -> IO (GError, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (GError
gerror'', Text
debug'')

#if defined(ENABLE_OVERLOADING)
data MessageParseInfoMethodInfo
instance (signature ~ (m ((GError, T.Text))), MonadIO m) => O.MethodInfo MessageParseInfoMethodInfo Message signature where
    overloadedMethod = messageParseInfo

#endif

-- method Message::parse_info_details
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The message object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the returned details structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Returns the optional details structure, may be NULL if none
-- The returned structure must not be freed.
-- 
-- /Since: 1.10/
messageParseInfoDetails ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: The message object
    -> m (Gst.Structure.Structure)
messageParseInfoDetails :: Message -> m Structure
messageParseInfoDetails message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Structure)
structure <- IO (Ptr (Ptr Structure))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Structure.Structure))
    Ptr Message -> Ptr (Ptr Structure) -> IO ()
gst_message_parse_info_details Ptr Message
message' Ptr (Ptr Structure)
structure
    Ptr Structure
structure' <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Structure)
structure
    Structure
structure'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
structure'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Structure) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Structure)
structure
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
structure''

#if defined(ENABLE_OVERLOADING)
data MessageParseInfoDetailsMethodInfo
instance (signature ~ (m (Gst.Structure.Structure)), MonadIO m) => O.MethodInfo MessageParseInfoDetailsMethodInfo Message signature where
    overloadedMethod = messageParseInfoDetails

#endif

-- method Message::parse_new_clock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_NEW_CLOCK."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to hold the selected\n    new clock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_new_clock" gst_message_parse_new_clock :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Clock.Clock) ->            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO ()

-- | Extracts the new clock from the GstMessage.
-- The clock object returned remains valid until the message is freed.
-- 
-- MT safe.
messageParseNewClock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_NEW_CLOCK.
    -> m (Gst.Clock.Clock)
messageParseNewClock :: Message -> m Clock
messageParseNewClock message :: Message
message = IO Clock -> m Clock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Clock -> m Clock) -> IO Clock -> m Clock
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Clock)
clock <- IO (Ptr (Ptr Clock))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Clock.Clock))
    Ptr Message -> Ptr (Ptr Clock) -> IO ()
gst_message_parse_new_clock Ptr Message
message' Ptr (Ptr Clock)
clock
    Ptr Clock
clock' <- Ptr (Ptr Clock) -> IO (Ptr Clock)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Clock)
clock
    Clock
clock'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
clock'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Clock) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Clock)
clock
    Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
clock''

#if defined(ENABLE_OVERLOADING)
data MessageParseNewClockMethodInfo
instance (signature ~ (m (Gst.Clock.Clock)), MonadIO m) => O.MethodInfo MessageParseNewClockMethodInfo Message signature where
    overloadedMethod = messageParseNewClock

#endif

-- method Message::parse_progress
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_PROGRESS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ProgressType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "code"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the code"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_progress" gst_message_parse_progress :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- type : TInterface (Name {namespace = "Gst", name = "ProgressType"})
    Ptr CString ->                          -- code : TBasicType TUTF8
    Ptr CString ->                          -- text : TBasicType TUTF8
    IO ()

-- | Parses the progress /@type@/, /@code@/ and /@text@/.
messageParseProgress ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_PROGRESS.
    -> m ((Gst.Enums.ProgressType, T.Text, T.Text))
messageParseProgress :: Message -> m (ProgressType, Text, Text)
messageParseProgress message :: Message
message = IO (ProgressType, Text, Text) -> m (ProgressType, Text, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ProgressType, Text, Text) -> m (ProgressType, Text, Text))
-> IO (ProgressType, Text, Text) -> m (ProgressType, Text, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
type_ <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CString
code <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr CString
text <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Message -> Ptr CUInt -> Ptr CString -> Ptr CString -> IO ()
gst_message_parse_progress Ptr Message
message' Ptr CUInt
type_ Ptr CString
code Ptr CString
text
    CUInt
type_' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
type_
    let type_'' :: ProgressType
type_'' = (Int -> ProgressType
forall a. Enum a => Int -> a
toEnum (Int -> ProgressType) -> (CUInt -> Int) -> CUInt -> ProgressType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
type_'
    CString
code' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
code
    Text
code'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
code'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
code'
    CString
text' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
text
    Text
text'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
type_
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
code
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
text
    (ProgressType, Text, Text) -> IO (ProgressType, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgressType
type_'', Text
code'', Text
text'')

#if defined(ENABLE_OVERLOADING)
data MessageParseProgressMethodInfo
instance (signature ~ (m ((Gst.Enums.ProgressType, T.Text, T.Text))), MonadIO m) => O.MethodInfo MessageParseProgressMethodInfo Message signature where
    overloadedMethod = messageParseProgress

#endif

-- method Message::parse_property_notify
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_PROPERTY_NOTIFY"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location where to store a\n    pointer to the object whose property got changed, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for\n    the name of the property that got changed, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_value"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Value" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for\n    the new value of the property that got changed, or %NULL. This will\n    only be set if the property notify watch was told to include the value\n    when it was set up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_property_notify" gst_message_parse_property_notify :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Object.Object) ->          -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr CString ->                          -- property_name : TBasicType TUTF8
    Ptr (Ptr GValue) ->                     -- property_value : TInterface (Name {namespace = "GObject", name = "Value"})
    IO ()

-- | Parses a property-notify message. These will be posted on the bus only
-- when set up with 'GI.Gst.Objects.Element.elementAddPropertyNotifyWatch' or
-- 'GI.Gst.Objects.Element.elementAddPropertyDeepNotifyWatch'.
-- 
-- /Since: 1.10/
messageParsePropertyNotify ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypePropertyNotify'
    -> m ((Gst.Object.Object, T.Text, GValue))
messageParsePropertyNotify :: Message -> m (Object, Text, GValue)
messageParsePropertyNotify message :: Message
message = IO (Object, Text, GValue) -> m (Object, Text, GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Object, Text, GValue) -> m (Object, Text, GValue))
-> IO (Object, Text, GValue) -> m (Object, Text, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Object)
object <- IO (Ptr (Ptr Object))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Object.Object))
    Ptr CString
propertyName <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr (Ptr GValue)
propertyValue <- IO (Ptr (Ptr GValue))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GValue))
    Ptr Message
-> Ptr (Ptr Object) -> Ptr CString -> Ptr (Ptr GValue) -> IO ()
gst_message_parse_property_notify Ptr Message
message' Ptr (Ptr Object)
object Ptr CString
propertyName Ptr (Ptr GValue)
propertyValue
    Ptr Object
object' <- Ptr (Ptr Object) -> IO (Ptr Object)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Object)
object
    Object
object'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Gst.Object.Object) Ptr Object
object'
    CString
propertyName' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
propertyName
    Text
propertyName'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
propertyName'
    Ptr GValue
propertyValue' <- Ptr (Ptr GValue) -> IO (Ptr GValue)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GValue)
propertyValue
    GValue
propertyValue'' <- ((ManagedPtr GValue -> GValue) -> Ptr GValue -> IO GValue
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GValue -> GValue
GValue) Ptr GValue
propertyValue'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Object) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Object)
object
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
propertyName
    Ptr (Ptr GValue) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GValue)
propertyValue
    (Object, Text, GValue) -> IO (Object, Text, GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Object
object'', Text
propertyName'', GValue
propertyValue'')

#if defined(ENABLE_OVERLOADING)
data MessageParsePropertyNotifyMethodInfo
instance (signature ~ (m ((Gst.Object.Object, T.Text, GValue))), MonadIO m) => O.MethodInfo MessageParsePropertyNotifyMethodInfo Message signature where
    overloadedMethod = messageParsePropertyNotify

#endif

-- method Message::parse_qos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_QOS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if the message was generated by a live element"
--                 , 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
--                       "the running time of the buffer that\n    generated the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "stream_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the stream time of the buffer that\n    generated the message"
--                 , 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 "the timestamps of the buffer that\n    generated the message"
--                 , 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 "the duration of the buffer that\n    generated the message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_qos" gst_message_parse_qos :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CInt ->                             -- live : TBasicType TBoolean
    Ptr Word64 ->                           -- running_time : TBasicType TUInt64
    Ptr Word64 ->                           -- stream_time : TBasicType TUInt64
    Ptr Word64 ->                           -- timestamp : TBasicType TUInt64
    Ptr Word64 ->                           -- duration : TBasicType TUInt64
    IO ()

-- | Extract the timestamps and live status from the QoS message.
-- 
-- The returned values give the running_time, stream_time, timestamp and
-- duration of the dropped buffer. Values of GST_CLOCK_TIME_NONE mean unknown
-- values.
-- 
-- MT safe.
messageParseQos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_QOS.
    -> m ((Bool, Word64, Word64, Word64, Word64))
messageParseQos :: Message -> m (Bool, Word64, Word64, Word64, Word64)
messageParseQos message :: Message
message = IO (Bool, Word64, Word64, Word64, Word64)
-> m (Bool, Word64, Word64, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word64, Word64, Word64, Word64)
 -> m (Bool, Word64, Word64, Word64, Word64))
-> IO (Bool, Word64, Word64, Word64, Word64)
-> m (Bool, Word64, Word64, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CInt
live <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Word64
runningTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
streamTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    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 Message
-> Ptr CInt
-> Ptr Word64
-> Ptr Word64
-> Ptr Word64
-> Ptr Word64
-> IO ()
gst_message_parse_qos Ptr Message
message' Ptr CInt
live Ptr Word64
runningTime Ptr Word64
streamTime Ptr Word64
timestamp Ptr Word64
duration
    CInt
live' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
live
    let live'' :: Bool
live'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
live'
    Word64
runningTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
runningTime
    Word64
streamTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
streamTime
    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
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
live
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
runningTime
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
streamTime
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
timestamp
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
duration
    (Bool, Word64, Word64, Word64, Word64)
-> IO (Bool, Word64, Word64, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
live'', Word64
runningTime', Word64
streamTime', Word64
timestamp', Word64
duration')

#if defined(ENABLE_OVERLOADING)
data MessageParseQosMethodInfo
instance (signature ~ (m ((Bool, Word64, Word64, Word64, Word64))), MonadIO m) => O.MethodInfo MessageParseQosMethodInfo Message signature where
    overloadedMethod = messageParseQos

#endif

-- method Message::parse_qos_stats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_QOS."
--                 , 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
--                       "Units of the 'processed' and 'dropped' fields.\n    Video sinks and video filters will use GST_FORMAT_BUFFERS (frames).\n    Audio sinks and audio filters will likely use GST_FORMAT_DEFAULT\n    (samples)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "processed"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Total number of units correctly processed\n    since the last state change to READY or a flushing operation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dropped"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Total number of units dropped since the last\n    state change to READY or a flushing operation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_qos_stats" gst_message_parse_qos_stats :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Word64 ->                           -- processed : TBasicType TUInt64
    Ptr Word64 ->                           -- dropped : TBasicType TUInt64
    IO ()

-- | Extract the QoS stats representing the history of the current continuous
-- pipeline playback period.
-- 
-- When /@format@/ is /@gSTFORMATUNDEFINED@/ both /@dropped@/ and /@processed@/ are
-- invalid. Values of -1 for either /@processed@/ or /@dropped@/ mean unknown values.
-- 
-- MT safe.
messageParseQosStats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_QOS.
    -> m ((Gst.Enums.Format, Word64, Word64))
messageParseQosStats :: Message -> m (Format, Word64, Word64)
messageParseQosStats message :: Message
message = IO (Format, Word64, Word64) -> m (Format, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Word64, Word64) -> m (Format, Word64, Word64))
-> IO (Format, Word64, Word64) -> m (Format, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
format <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Word64
processed <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
dropped <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Message -> Ptr CUInt -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_message_parse_qos_stats Ptr Message
message' Ptr CUInt
format Ptr Word64
processed Ptr Word64
dropped
    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
processed' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
processed
    Word64
dropped' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
dropped
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
format
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
processed
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
dropped
    (Format, Word64, Word64) -> IO (Format, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Word64
processed', Word64
dropped')

#if defined(ENABLE_OVERLOADING)
data MessageParseQosStatsMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Word64, Word64))), MonadIO m) => O.MethodInfo MessageParseQosStatsMethodInfo Message signature where
    overloadedMethod = messageParseQosStats

#endif

-- method Message::parse_qos_values
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_QOS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "jitter"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The difference of the running-time against\n    the deadline."
--                 , 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
--                       "Long term prediction of the ideal rate\n    relative to normal rate to get optimal quality."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "quality"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element dependent integer value that\n    specifies the current quality level of the element. The default\n    maximum quality is 1000000."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_qos_values" gst_message_parse_qos_values :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Int64 ->                            -- jitter : TBasicType TInt64
    Ptr CDouble ->                          -- proportion : TBasicType TDouble
    Ptr Int32 ->                            -- quality : TBasicType TInt
    IO ()

-- | Extract the QoS values that have been calculated\/analysed from the QoS data
-- 
-- MT safe.
messageParseQosValues ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_QOS.
    -> m ((Int64, Double, Int32))
messageParseQosValues :: Message -> m (Int64, Double, Int32)
messageParseQosValues message :: Message
message = IO (Int64, Double, Int32) -> m (Int64, Double, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int64, Double, Int32) -> m (Int64, Double, Int32))
-> IO (Int64, Double, Int32) -> m (Int64, Double, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Int64
jitter <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    Ptr CDouble
proportion <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Int32
quality <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Message -> Ptr Int64 -> Ptr CDouble -> Ptr Int32 -> IO ()
gst_message_parse_qos_values Ptr Message
message' Ptr Int64
jitter Ptr CDouble
proportion Ptr Int32
quality
    Int64
jitter' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
jitter
    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'
    Int32
quality' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
quality
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
jitter
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
proportion
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
quality
    (Int64, Double, Int32) -> IO (Int64, Double, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
jitter', Double
proportion'', Int32
quality')

#if defined(ENABLE_OVERLOADING)
data MessageParseQosValuesMethodInfo
instance (signature ~ (m ((Int64, Double, Int32))), MonadIO m) => O.MethodInfo MessageParseQosValuesMethodInfo Message signature where
    overloadedMethod = messageParseQosValues

#endif

-- method Message::parse_redirect_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMessage of type %GST_MESSAGE_REDIRECT"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "entry_index"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of the entry to parse"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "location"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for\n    the pointer to the entry's location string, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag_list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for\n    the pointer to the entry's tag list, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "entry_struct"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location\n    for the pointer to the entry's structure, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_redirect_entry" gst_message_parse_redirect_entry :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Word64 ->                               -- entry_index : TBasicType TUInt64
    Ptr CString ->                          -- location : TBasicType TUTF8
    Ptr (Ptr Gst.TagList.TagList) ->        -- tag_list : TInterface (Name {namespace = "Gst", name = "TagList"})
    Ptr (Ptr Gst.Structure.Structure) ->    -- entry_struct : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Parses the location and\/or structure from the entry with the given index.
-- The index must be between 0 and 'GI.Gst.Structs.Message.messageGetNumRedirectEntries' - 1.
-- Returned pointers are valid for as long as this message exists.
-- 
-- /Since: 1.10/
messageParseRedirectEntry ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeRedirect'
    -> Word64
    -- ^ /@entryIndex@/: index of the entry to parse
    -> m ((T.Text, Gst.TagList.TagList, Gst.Structure.Structure))
messageParseRedirectEntry :: Message -> Word64 -> m (Text, TagList, Structure)
messageParseRedirectEntry message :: Message
message entryIndex :: Word64
entryIndex = IO (Text, TagList, Structure) -> m (Text, TagList, Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, TagList, Structure) -> m (Text, TagList, Structure))
-> IO (Text, TagList, Structure) -> m (Text, TagList, Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CString
location <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr (Ptr TagList)
tagList <- IO (Ptr (Ptr TagList))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.TagList.TagList))
    Ptr (Ptr Structure)
entryStruct <- IO (Ptr (Ptr Structure))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Structure.Structure))
    Ptr Message
-> Word64
-> Ptr CString
-> Ptr (Ptr TagList)
-> Ptr (Ptr Structure)
-> IO ()
gst_message_parse_redirect_entry Ptr Message
message' Word64
entryIndex Ptr CString
location Ptr (Ptr TagList)
tagList Ptr (Ptr Structure)
entryStruct
    CString
location' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
location
    Text
location'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
location'
    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, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
tagList'
    Ptr Structure
entryStruct' <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Structure)
entryStruct
    Structure
entryStruct'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
entryStruct'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
location
    Ptr (Ptr TagList) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr TagList)
tagList
    Ptr (Ptr Structure) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Structure)
entryStruct
    (Text, TagList, Structure) -> IO (Text, TagList, Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
location'', TagList
tagList'', Structure
entryStruct'')

#if defined(ENABLE_OVERLOADING)
data MessageParseRedirectEntryMethodInfo
instance (signature ~ (Word64 -> m ((T.Text, Gst.TagList.TagList, Gst.Structure.Structure))), MonadIO m) => O.MethodInfo MessageParseRedirectEntryMethodInfo Message signature where
    overloadedMethod = messageParseRedirectEntry

#endif

-- method Message::parse_request_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_REQUEST_STATE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Result location for the requested state 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_message_parse_request_state" gst_message_parse_request_state :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- state : TInterface (Name {namespace = "Gst", name = "State"})
    IO ()

-- | Extract the requested state from the request_state message.
-- 
-- MT safe.
messageParseRequestState ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_REQUEST_STATE.
    -> m (Gst.Enums.State)
messageParseRequestState :: Message -> m State
messageParseRequestState message :: Message
message = IO State -> m State
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
state <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Message -> Ptr CUInt -> IO ()
gst_message_parse_request_state Ptr Message
message' Ptr CUInt
state
    CUInt
state' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
state
    let state'' :: State
state'' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
state'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
state
    State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
state''

#if defined(ENABLE_OVERLOADING)
data MessageParseRequestStateMethodInfo
instance (signature ~ (m (Gst.Enums.State)), MonadIO m) => O.MethodInfo MessageParseRequestStateMethodInfo Message signature where
    overloadedMethod = messageParseRequestState

#endif

-- method Message::parse_reset_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_RESET_TIME."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "running_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Result location for the running_time or\n     %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_message_parse_reset_time" gst_message_parse_reset_time :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Word64 ->                           -- running_time : TBasicType TUInt64
    IO ()

-- | Extract the running-time from the RESET_TIME message.
-- 
-- MT safe.
messageParseResetTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_RESET_TIME.
    -> m (Word64)
messageParseResetTime :: Message -> m Word64
messageParseResetTime message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Word64
runningTime <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Message -> Ptr Word64 -> IO ()
gst_message_parse_reset_time Ptr Message
message' Ptr Word64
runningTime
    Word64
runningTime' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
runningTime
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
runningTime
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
runningTime'

#if defined(ENABLE_OVERLOADING)
data MessageParseResetTimeMethodInfo
instance (signature ~ (m (Word64)), MonadIO m) => O.MethodInfo MessageParseResetTimeMethodInfo Message signature where
    overloadedMethod = messageParseResetTime

#endif

-- method Message::parse_segment_done
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_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_message_parse_segment_done" gst_message_parse_segment_done :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    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.
-- 
-- MT safe.
messageParseSegmentDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_SEGMENT_DONE.
    -> m ((Gst.Enums.Format, Int64))
messageParseSegmentDone :: Message -> m (Format, Int64)
messageParseSegmentDone message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    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 Message -> Ptr CUInt -> Ptr Int64 -> IO ()
gst_message_parse_segment_done Ptr Message
message' 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
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseSegmentDoneMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64))), MonadIO m) => O.MethodInfo MessageParseSegmentDoneMethodInfo Message signature where
    overloadedMethod = messageParseSegmentDone

#endif

-- method Message::parse_segment_start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_SEGMENT_START."
--                 , 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_message_parse_segment_start" gst_message_parse_segment_start :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Ptr Int64 ->                            -- position : TBasicType TInt64
    IO ()

-- | Extracts the position and format from the segment start message.
-- 
-- MT safe.
messageParseSegmentStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_SEGMENT_START.
    -> m ((Gst.Enums.Format, Int64))
messageParseSegmentStart :: Message -> m (Format, Int64)
messageParseSegmentStart message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    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 Message -> Ptr CUInt -> Ptr Int64 -> IO ()
gst_message_parse_segment_start Ptr Message
message' 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
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseSegmentStartMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Int64))), MonadIO m) => O.MethodInfo MessageParseSegmentStartMethodInfo Message signature where
    overloadedMethod = messageParseSegmentStart

#endif

-- method Message::parse_state_changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a valid #GstMessage of type GST_MESSAGE_STATE_CHANGED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "oldstate"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the previous state, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "newstate"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new (current) state, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "pending"
--           , argType = TInterface Name { namespace = "Gst" , name = "State" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pending (target) state, 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_message_parse_state_changed" gst_message_parse_state_changed :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- oldstate : TInterface (Name {namespace = "Gst", name = "State"})
    Ptr CUInt ->                            -- newstate : TInterface (Name {namespace = "Gst", name = "State"})
    Ptr CUInt ->                            -- pending : TInterface (Name {namespace = "Gst", name = "State"})
    IO ()

-- | Extracts the old and new states from the GstMessage.
-- 
-- Typical usage of this function might be:
-- 
-- === /C code/
-- >
-- >  ...
-- >  switch (GST_MESSAGE_TYPE (msg)) {
-- >    case GST_MESSAGE_STATE_CHANGED: {
-- >      GstState old_state, new_state;
-- >
-- >      gst_message_parse_state_changed (msg, &amp;old_state, &amp;new_state, NULL);
-- >      g_print ("Element %s changed state from %s to %s.\n",
-- >          GST_OBJECT_NAME (msg->src),
-- >          gst_element_state_get_name (old_state),
-- >          gst_element_state_get_name (new_state));
-- >      break;
-- >    }
-- >    ...
-- >  }
-- >  ...
-- 
-- 
-- MT safe.
messageParseStateChanged ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STATE_CHANGED
    -> m ((Gst.Enums.State, Gst.Enums.State, Gst.Enums.State))
messageParseStateChanged :: Message -> m (State, State, State)
messageParseStateChanged message :: Message
message = IO (State, State, State) -> m (State, State, State)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (State, State, State) -> m (State, State, State))
-> IO (State, State, State) -> m (State, State, State)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
oldstate <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
newstate <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
pending <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr Message -> Ptr CUInt -> Ptr CUInt -> Ptr CUInt -> IO ()
gst_message_parse_state_changed Ptr Message
message' Ptr CUInt
oldstate Ptr CUInt
newstate Ptr CUInt
pending
    CUInt
oldstate' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
oldstate
    let oldstate'' :: State
oldstate'' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
oldstate'
    CUInt
newstate' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
newstate
    let newstate'' :: State
newstate'' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
newstate'
    CUInt
pending' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pending
    let pending'' :: State
pending'' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
pending'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
oldstate
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
newstate
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
pending
    (State, State, State) -> IO (State, State, State)
forall (m :: * -> *) a. Monad m => a -> m a
return (State
oldstate'', State
newstate'', State
pending'')

#if defined(ENABLE_OVERLOADING)
data MessageParseStateChangedMethodInfo
instance (signature ~ (m ((Gst.Enums.State, Gst.Enums.State, Gst.Enums.State))), MonadIO m) => O.MethodInfo MessageParseStateChangedMethodInfo Message signature where
    overloadedMethod = messageParseStateChanged

#endif

-- method Message::parse_step_done
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STEP_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"
--                 , 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 "result location for the amount"
--                 , 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 "result location for the rate"
--                 , 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 "result location for the flush flag"
--                 , 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 "result location for the intermediate flag"
--                 , 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 "result location for the duration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "eos"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result location for the EOS 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_message_parse_step_done" gst_message_parse_step_done :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    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
    Ptr Word64 ->                           -- duration : TBasicType TUInt64
    Ptr CInt ->                             -- eos : TBasicType TBoolean
    IO ()

-- | Extract the values the step_done message.
-- 
-- MT safe.
messageParseStepDone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STEP_DONE.
    -> m ((Gst.Enums.Format, Word64, Double, Bool, Bool, Word64, Bool))
messageParseStepDone :: Message -> m (Format, Word64, Double, Bool, Bool, Word64, Bool)
messageParseStepDone message :: Message
message = IO (Format, Word64, Double, Bool, Bool, Word64, Bool)
-> m (Format, Word64, Double, Bool, Bool, Word64, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Format, Word64, Double, Bool, Bool, Word64, Bool)
 -> m (Format, Word64, Double, Bool, Bool, Word64, Bool))
-> IO (Format, Word64, Double, Bool, Bool, Word64, Bool)
-> m (Format, Word64, Double, Bool, Bool, Word64, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    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 Word64
duration <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CInt
eos <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Message
-> Ptr CUInt
-> Ptr Word64
-> Ptr CDouble
-> Ptr CInt
-> Ptr CInt
-> Ptr Word64
-> Ptr CInt
-> IO ()
gst_message_parse_step_done Ptr Message
message' Ptr CUInt
format Ptr Word64
amount Ptr CDouble
rate Ptr CInt
flush Ptr CInt
intermediate Ptr Word64
duration Ptr CInt
eos
    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
/= 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
/= 0) CInt
intermediate'
    Word64
duration' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
duration
    CInt
eos' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
eos
    let eos'' :: Bool
eos'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
eos'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
duration
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
eos
    (Format, Word64, Double, Bool, Bool, Word64, Bool)
-> IO (Format, Word64, Double, Bool, Bool, Word64, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format
format'', Word64
amount', Double
rate'', Bool
flush'', Bool
intermediate'', Word64
duration', Bool
eos'')

#if defined(ENABLE_OVERLOADING)
data MessageParseStepDoneMethodInfo
instance (signature ~ (m ((Gst.Enums.Format, Word64, Double, Bool, Bool, Word64, Bool))), MonadIO m) => O.MethodInfo MessageParseStepDoneMethodInfo Message signature where
    overloadedMethod = messageParseStepDone

#endif

-- method Message::parse_step_start
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STEP_DONE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "result location for the active flag"
--                 , 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 format"
--                 , 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 "result location for the amount"
--                 , 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 "result location for the rate"
--                 , 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 "result location for the flush flag"
--                 , 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 "result location for the intermediate 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_message_parse_step_start" gst_message_parse_step_start :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CInt ->                             -- active : TBasicType TBoolean
    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 ()

-- | Extract the values from step_start message.
-- 
-- MT safe.
messageParseStepStart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STEP_DONE.
    -> m ((Bool, Gst.Enums.Format, Word64, Double, Bool, Bool))
messageParseStepStart :: Message -> m (Bool, Format, Word64, Double, Bool, Bool)
messageParseStepStart message :: Message
message = IO (Bool, Format, Word64, Double, Bool, Bool)
-> m (Bool, Format, Word64, Double, Bool, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Format, Word64, Double, Bool, Bool)
 -> m (Bool, Format, Word64, Double, Bool, Bool))
-> IO (Bool, Format, Word64, Double, Bool, Bool)
-> m (Bool, Format, Word64, Double, Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CInt
active <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    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 Message
-> Ptr CInt
-> Ptr CUInt
-> Ptr Word64
-> Ptr CDouble
-> Ptr CInt
-> Ptr CInt
-> IO ()
gst_message_parse_step_start Ptr Message
message' Ptr CInt
active Ptr CUInt
format Ptr Word64
amount Ptr CDouble
rate Ptr CInt
flush Ptr CInt
intermediate
    CInt
active' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
active
    let active'' :: Bool
active'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
active'
    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
/= 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
/= 0) CInt
intermediate'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
active
    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
    (Bool, Format, Word64, Double, Bool, Bool)
-> IO (Bool, Format, Word64, Double, Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
active'', Format
format'', Word64
amount', Double
rate'', Bool
flush'', Bool
intermediate'')

#if defined(ENABLE_OVERLOADING)
data MessageParseStepStartMethodInfo
instance (signature ~ (m ((Bool, Gst.Enums.Format, Word64, Double, Bool, Bool))), MonadIO m) => O.MethodInfo MessageParseStepStartMethodInfo Message signature where
    overloadedMethod = messageParseStepStart

#endif

-- method Message::parse_stream_collection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_STREAM_COLLECTION"
--                 , 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
--                       "A location where to store a\n pointer to the #GstStreamCollection, 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_message_parse_stream_collection" gst_message_parse_stream_collection :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.StreamCollection.StreamCollection) -> -- collection : TInterface (Name {namespace = "Gst", name = "StreamCollection"})
    IO ()

-- | Parses a stream-collection message.
-- 
-- /Since: 1.10/
messageParseStreamCollection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeStreamCollection'
    -> m (Gst.StreamCollection.StreamCollection)
messageParseStreamCollection :: Message -> m StreamCollection
messageParseStreamCollection message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr StreamCollection)
collection <- IO (Ptr (Ptr StreamCollection))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.StreamCollection.StreamCollection))
    Ptr Message -> Ptr (Ptr StreamCollection) -> IO ()
gst_message_parse_stream_collection Ptr Message
message' 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'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseStreamCollectionMethodInfo
instance (signature ~ (m (Gst.StreamCollection.StreamCollection)), MonadIO m) => O.MethodInfo MessageParseStreamCollectionMethodInfo Message signature where
    overloadedMethod = messageParseStreamCollection

#endif

-- method Message::parse_stream_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STREAM_STATUS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamStatusType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to hold the status type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "owner"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The owner element of the message source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_stream_status" gst_message_parse_stream_status :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- type : TInterface (Name {namespace = "Gst", name = "StreamStatusType"})
    Ptr (Ptr Gst.Element.Element) ->        -- owner : TInterface (Name {namespace = "Gst", name = "Element"})
    IO ()

-- | Extracts the stream status type and owner the GstMessage. The returned
-- owner remains valid for as long as the reference to /@message@/ is valid and
-- should thus not be unreffed.
-- 
-- MT safe.
messageParseStreamStatus ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STREAM_STATUS.
    -> m ((Gst.Enums.StreamStatusType, Gst.Element.Element))
messageParseStreamStatus :: Message -> m (StreamStatusType, Element)
messageParseStreamStatus message :: Message
message = IO (StreamStatusType, Element) -> m (StreamStatusType, Element)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (StreamStatusType, Element) -> m (StreamStatusType, Element))
-> IO (StreamStatusType, Element) -> m (StreamStatusType, Element)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
type_ <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr (Ptr Element)
owner <- IO (Ptr (Ptr Element))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Element.Element))
    Ptr Message -> Ptr CUInt -> Ptr (Ptr Element) -> IO ()
gst_message_parse_stream_status Ptr Message
message' Ptr CUInt
type_ Ptr (Ptr Element)
owner
    CUInt
type_' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
type_
    let type_'' :: StreamStatusType
type_'' = (Int -> StreamStatusType
forall a. Enum a => Int -> a
toEnum (Int -> StreamStatusType)
-> (CUInt -> Int) -> CUInt -> StreamStatusType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
type_'
    Ptr Element
owner' <- Ptr (Ptr Element) -> IO (Ptr Element)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Element)
owner
    Element
owner'' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
owner'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
type_
    Ptr (Ptr Element) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Element)
owner
    (StreamStatusType, Element) -> IO (StreamStatusType, Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamStatusType
type_'', Element
owner'')

#if defined(ENABLE_OVERLOADING)
data MessageParseStreamStatusMethodInfo
instance (signature ~ (m ((Gst.Enums.StreamStatusType, Gst.Element.Element))), MonadIO m) => O.MethodInfo MessageParseStreamStatusMethodInfo Message signature where
    overloadedMethod = messageParseStreamStatus

#endif

-- method Message::parse_streams_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_STREAMS_SELECTED"
--                 , 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
--                       "A location where to store a\n pointer to the #GstStreamCollection, 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_message_parse_streams_selected" gst_message_parse_streams_selected :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.StreamCollection.StreamCollection) -> -- collection : TInterface (Name {namespace = "Gst", name = "StreamCollection"})
    IO ()

-- | Parses a streams-selected message.
-- 
-- /Since: 1.10/
messageParseStreamsSelected ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeStreamsSelected'
    -> m (Gst.StreamCollection.StreamCollection)
messageParseStreamsSelected :: Message -> m StreamCollection
messageParseStreamsSelected message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr StreamCollection)
collection <- IO (Ptr (Ptr StreamCollection))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.StreamCollection.StreamCollection))
    Ptr Message -> Ptr (Ptr StreamCollection) -> IO ()
gst_message_parse_streams_selected Ptr Message
message' 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'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseStreamsSelectedMethodInfo
instance (signature ~ (m (Gst.StreamCollection.StreamCollection)), MonadIO m) => O.MethodInfo MessageParseStreamsSelectedMethodInfo Message signature where
    overloadedMethod = messageParseStreamsSelected

#endif

-- method Message::parse_structure_change
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STRUCTURE_CHANGE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "StructureChangeType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to hold the change type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "owner"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Element" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The owner element of the\n    message source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "busy"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to hold whether the change is in\n    progress or has been completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_structure_change" gst_message_parse_structure_change :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr CUInt ->                            -- type : TInterface (Name {namespace = "Gst", name = "StructureChangeType"})
    Ptr (Ptr Gst.Element.Element) ->        -- owner : TInterface (Name {namespace = "Gst", name = "Element"})
    Ptr CInt ->                             -- busy : TBasicType TBoolean
    IO ()

-- | Extracts the change type and completion status from the GstMessage.
-- 
-- MT safe.
messageParseStructureChange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STRUCTURE_CHANGE.
    -> m ((Gst.Enums.StructureChangeType, Gst.Element.Element, Bool))
messageParseStructureChange :: Message -> m (StructureChangeType, Element, Bool)
messageParseStructureChange message :: Message
message = IO (StructureChangeType, Element, Bool)
-> m (StructureChangeType, Element, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (StructureChangeType, Element, Bool)
 -> m (StructureChangeType, Element, Bool))
-> IO (StructureChangeType, Element, Bool)
-> m (StructureChangeType, Element, Bool)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr CUInt
type_ <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr (Ptr Element)
owner <- IO (Ptr (Ptr Element))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Element.Element))
    Ptr CInt
busy <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Message -> Ptr CUInt -> Ptr (Ptr Element) -> Ptr CInt -> IO ()
gst_message_parse_structure_change Ptr Message
message' Ptr CUInt
type_ Ptr (Ptr Element)
owner Ptr CInt
busy
    CUInt
type_' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
type_
    let type_'' :: StructureChangeType
type_'' = (Int -> StructureChangeType
forall a. Enum a => Int -> a
toEnum (Int -> StructureChangeType)
-> (CUInt -> Int) -> CUInt -> StructureChangeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
type_'
    Ptr Element
owner' <- Ptr (Ptr Element) -> IO (Ptr Element)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Element)
owner
    Element
owner'' <- ((ManagedPtr Element -> Element) -> Ptr Element -> IO Element
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Element -> Element
Gst.Element.Element) Ptr Element
owner'
    CInt
busy' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
busy
    let busy'' :: Bool
busy'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
busy'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
type_
    Ptr (Ptr Element) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Element)
owner
    Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
busy
    (StructureChangeType, Element, Bool)
-> IO (StructureChangeType, Element, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (StructureChangeType
type_'', Element
owner'', Bool
busy'')

#if defined(ENABLE_OVERLOADING)
data MessageParseStructureChangeMethodInfo
instance (signature ~ (m ((Gst.Enums.StructureChangeType, Gst.Element.Element, Bool))), MonadIO m) => O.MethodInfo MessageParseStructureChangeMethodInfo Message signature where
    overloadedMethod = messageParseStructureChange

#endif

-- method Message::parse_tag
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_TAG."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag_list"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the tag-list."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_parse_tag" gst_message_parse_tag :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.TagList.TagList) ->        -- tag_list : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO ()

-- | Extracts the tag list from the GstMessage. The tag list returned in the
-- output argument is a copy; the caller must free it when done.
-- 
-- Typical usage of this function might be:
-- 
-- === /C code/
-- >
-- >  ...
-- >  switch (GST_MESSAGE_TYPE (msg)) {
-- >    case GST_MESSAGE_TAG: {
-- >      GstTagList *tags = NULL;
-- >
-- >      gst_message_parse_tag (msg, &amp;tags);
-- >      g_print ("Got tags from element %s\n", GST_OBJECT_NAME (msg->src));
-- >      handle_tags (tags);
-- >      gst_tag_list_unref (tags);
-- >      break;
-- >    }
-- >    ...
-- >  }
-- >  ...
-- 
-- 
-- MT safe.
messageParseTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_TAG.
    -> m (Gst.TagList.TagList)
messageParseTag :: Message -> m TagList
messageParseTag message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr TagList)
tagList <- IO (Ptr (Ptr TagList))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.TagList.TagList))
    Ptr Message -> Ptr (Ptr TagList) -> IO ()
gst_message_parse_tag Ptr Message
message' 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, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
tagList'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseTagMethodInfo
instance (signature ~ (m (Gst.TagList.TagList)), MonadIO m) => O.MethodInfo MessageParseTagMethodInfo Message signature where
    overloadedMethod = messageParseTag

#endif

-- method Message::parse_toc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid #GstMessage of type GST_MESSAGE_TOC."
--                 , 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 "return location for the TOC."
--                 , 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 "return location for the 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_message_parse_toc" gst_message_parse_toc :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr Gst.Toc.Toc) ->                -- toc : TInterface (Name {namespace = "Gst", name = "Toc"})
    Ptr CInt ->                             -- updated : TBasicType TBoolean
    IO ()

-- | Extract the TOC from the t'GI.Gst.Structs.Message.Message'. The TOC returned in the
-- output argument is a copy; the caller must free it with
-- @/gst_toc_unref()/@ when done.
-- 
-- MT safe.
messageParseToc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_TOC.
    -> m ((Gst.Toc.Toc, Bool))
messageParseToc :: Message -> m (Toc, Bool)
messageParseToc message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Toc)
toc <- IO (Ptr (Ptr Toc))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Toc.Toc))
    Ptr CInt
updated <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Message -> Ptr (Ptr Toc) -> Ptr CInt -> IO ()
gst_message_parse_toc Ptr Message
message' 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, BoxedObject 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
/= 0) CInt
updated'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageParseTocMethodInfo
instance (signature ~ (m ((Gst.Toc.Toc, Bool))), MonadIO m) => O.MethodInfo MessageParseTocMethodInfo Message signature where
    overloadedMethod = messageParseToc

#endif

-- method Message::parse_warning
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_WARNING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "gerror"
--           , argType = TError
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the GError"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location for the debug message,\n    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_message_parse_warning" gst_message_parse_warning :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr (Ptr GError) ->                     -- gerror : TError
    Ptr CString ->                          -- debug : TBasicType TUTF8
    IO ()

-- | Extracts the GError and debug string from the GstMessage. The values returned
-- in the output arguments are copies; the caller must free them when done.
-- 
-- MT safe.
messageParseWarning ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_WARNING.
    -> m ((GError, T.Text))
messageParseWarning :: Message -> m (GError, Text)
messageParseWarning message :: Message
message = IO (GError, Text) -> m (GError, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GError, Text) -> m (GError, Text))
-> IO (GError, Text) -> m (GError, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr GError)
gerror <- IO (Ptr (Ptr GError))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GError))
    Ptr CString
debug <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Message -> Ptr (Ptr GError) -> Ptr CString -> IO ()
gst_message_parse_warning Ptr Message
message' Ptr (Ptr GError)
gerror Ptr CString
debug
    Ptr GError
gerror' <- Ptr (Ptr GError) -> IO (Ptr GError)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GError)
gerror
    GError
gerror'' <- ((ManagedPtr GError -> GError) -> Ptr GError -> IO GError
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GError -> GError
GError) Ptr GError
gerror'
    CString
debug' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
debug
    Text
debug'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
debug'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
debug'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr GError) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GError)
gerror
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
debug
    (GError, Text) -> IO (GError, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (GError
gerror'', Text
debug'')

#if defined(ENABLE_OVERLOADING)
data MessageParseWarningMethodInfo
instance (signature ~ (m ((GError, T.Text))), MonadIO m) => O.MethodInfo MessageParseWarningMethodInfo Message signature where
    overloadedMethod = messageParseWarning

#endif

-- method Message::parse_warning_details
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The message object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "structure"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the returned details structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Returns the optional details structure, may be NULL if none
-- The returned structure must not be freed.
-- 
-- /Since: 1.10/
messageParseWarningDetails ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: The message object
    -> m (Gst.Structure.Structure)
messageParseWarningDetails :: Message -> m Structure
messageParseWarningDetails message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr (Ptr Structure)
structure <- IO (Ptr (Ptr Structure))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gst.Structure.Structure))
    Ptr Message -> Ptr (Ptr Structure) -> IO ()
gst_message_parse_warning_details Ptr Message
message' Ptr (Ptr Structure)
structure
    Ptr Structure
structure' <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Structure)
structure
    Structure
structure'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
structure'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Ptr (Ptr Structure) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Structure)
structure
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
structure''

#if defined(ENABLE_OVERLOADING)
data MessageParseWarningDetailsMethodInfo
instance (signature ~ (m (Gst.Structure.Structure)), MonadIO m) => O.MethodInfo MessageParseWarningDetailsMethodInfo Message signature where
    overloadedMethod = messageParseWarningDetails

#endif

-- method Message::set_buffering_stats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_BUFFERING."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "BufferingMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffering mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "avg_in"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average input rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "avg_out"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the average output rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffering_left"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "amount of buffering time left in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_set_buffering_stats" gst_message_set_buffering_stats :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gst", name = "BufferingMode"})
    Int32 ->                                -- avg_in : TBasicType TInt
    Int32 ->                                -- avg_out : TBasicType TInt
    Int64 ->                                -- buffering_left : TBasicType TInt64
    IO ()

-- | Configures the buffering stats values in /@message@/.
messageSetBufferingStats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_BUFFERING.
    -> Gst.Enums.BufferingMode
    -- ^ /@mode@/: a buffering mode
    -> Int32
    -- ^ /@avgIn@/: the average input rate
    -> Int32
    -- ^ /@avgOut@/: the average output rate
    -> Int64
    -- ^ /@bufferingLeft@/: amount of buffering time left in milliseconds
    -> m ()
messageSetBufferingStats :: Message -> BufferingMode -> Int32 -> Int32 -> Int64 -> m ()
messageSetBufferingStats message :: Message
message mode :: BufferingMode
mode avgIn :: Int32
avgIn avgOut :: Int32
avgOut bufferingLeft :: Int64
bufferingLeft = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BufferingMode -> Int) -> BufferingMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferingMode -> Int
forall a. Enum a => a -> Int
fromEnum) BufferingMode
mode
    Ptr Message -> CUInt -> Int32 -> Int32 -> Int64 -> IO ()
gst_message_set_buffering_stats Ptr Message
message' CUInt
mode' Int32
avgIn Int32
avgOut Int64
bufferingLeft
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetBufferingStatsMethodInfo
instance (signature ~ (Gst.Enums.BufferingMode -> Int32 -> Int32 -> Int64 -> m ()), MonadIO m) => O.MethodInfo MessageSetBufferingStatsMethodInfo Message signature where
    overloadedMethod = messageSetBufferingStats

#endif

-- method Message::set_group_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the group id on the stream-start message.
-- 
-- 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.
-- 
-- MT safe.
-- 
-- /Since: 1.2/
messageSetGroupId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: the message
    -> Word32
    -- ^ /@groupId@/: the group id
    -> m ()
messageSetGroupId :: Message -> Word32 -> m ()
messageSetGroupId message :: Message
message groupId :: 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Message -> Word32 -> IO ()
gst_message_set_group_id Ptr Message
message' Word32
groupId
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetGroupIdMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo MessageSetGroupIdMethodInfo Message signature where
    overloadedMethod = messageSetGroupId

#endif

-- method Message::set_qos_stats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_QOS."
--                 , 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
--                       "Units of the 'processed' and 'dropped' fields. Video sinks and video\nfilters will use GST_FORMAT_BUFFERS (frames). Audio sinks and audio filters\nwill likely use GST_FORMAT_DEFAULT (samples)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "processed"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Total number of units correctly processed since the last state\nchange to READY or a flushing operation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dropped"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Total number of units dropped since the last state change to READY\nor a flushing operation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_set_qos_stats" gst_message_set_qos_stats :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    CUInt ->                                -- format : TInterface (Name {namespace = "Gst", name = "Format"})
    Word64 ->                               -- processed : TBasicType TUInt64
    Word64 ->                               -- dropped : TBasicType TUInt64
    IO ()

-- | Set the QoS stats representing the history of the current continuous pipeline
-- playback period.
-- 
-- When /@format@/ is /@gSTFORMATUNDEFINED@/ both /@dropped@/ and /@processed@/ are
-- invalid. Values of -1 for either /@processed@/ or /@dropped@/ mean unknown values.
-- 
-- MT safe.
messageSetQosStats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_QOS.
    -> Gst.Enums.Format
    -- ^ /@format@/: Units of the \'processed\' and \'dropped\' fields. Video sinks and video
    -- filters will use GST_FORMAT_BUFFERS (frames). Audio sinks and audio filters
    -- will likely use GST_FORMAT_DEFAULT (samples).
    -> Word64
    -- ^ /@processed@/: Total number of units correctly processed since the last state
    -- change to READY or a flushing operation.
    -> Word64
    -- ^ /@dropped@/: Total number of units dropped since the last state change to READY
    -- or a flushing operation.
    -> m ()
messageSetQosStats :: Message -> Format -> Word64 -> Word64 -> m ()
messageSetQosStats message :: Message
message format :: Format
format processed :: Word64
processed dropped :: Word64
dropped = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    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 Message -> CUInt -> Word64 -> Word64 -> IO ()
gst_message_set_qos_stats Ptr Message
message' CUInt
format' Word64
processed Word64
dropped
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetQosStatsMethodInfo
instance (signature ~ (Gst.Enums.Format -> Word64 -> Word64 -> m ()), MonadIO m) => O.MethodInfo MessageSetQosStatsMethodInfo Message signature where
    overloadedMethod = messageSetQosStats

#endif

-- method Message::set_qos_values
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstMessage of type GST_MESSAGE_QOS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "jitter"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The difference of the running-time against the deadline."
--                 , 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
--                       "Long term prediction of the ideal rate relative to normal rate\nto get optimal quality."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "quality"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An element dependent integer value that specifies the current\nquality level of the element. The default maximum quality is 1000000."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_set_qos_values" gst_message_set_qos_values :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Int64 ->                                -- jitter : TBasicType TInt64
    CDouble ->                              -- proportion : TBasicType TDouble
    Int32 ->                                -- quality : TBasicType TInt
    IO ()

-- | Set the QoS values that have been calculated\/analysed from the QoS data
-- 
-- MT safe.
messageSetQosValues ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_QOS.
    -> Int64
    -- ^ /@jitter@/: The difference of the running-time against the deadline.
    -> Double
    -- ^ /@proportion@/: Long term prediction of the ideal rate relative to normal rate
    -- to get optimal quality.
    -> Int32
    -- ^ /@quality@/: An element dependent integer value that specifies the current
    -- quality level of the element. The default maximum quality is 1000000.
    -> m ()
messageSetQosValues :: Message -> Int64 -> Double -> Int32 -> m ()
messageSetQosValues message :: Message
message jitter :: Int64
jitter proportion :: Double
proportion quality :: Int32
quality = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    let proportion' :: CDouble
proportion' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
proportion
    Ptr Message -> Int64 -> CDouble -> Int32 -> IO ()
gst_message_set_qos_values Ptr Message
message' Int64
jitter CDouble
proportion' Int32
quality
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetQosValuesMethodInfo
instance (signature ~ (Int64 -> Double -> Int32 -> m ()), MonadIO m) => O.MethodInfo MessageSetQosValuesMethodInfo Message signature where
    overloadedMethod = messageSetQosValues

#endif

-- method Message::set_seqnum
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstMessage." , 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_message_set_seqnum" gst_message_set_seqnum :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Word32 ->                               -- seqnum : TBasicType TUInt32
    IO ()

-- | Set the sequence number of a message.
-- 
-- This function might be called by the creator of a message to indicate that
-- the message relates to other messages or events. See 'GI.Gst.Structs.Message.messageGetSeqnum'
-- for more information.
-- 
-- MT safe.
messageSetSeqnum ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A t'GI.Gst.Structs.Message.Message'.
    -> Word32
    -- ^ /@seqnum@/: A sequence number.
    -> m ()
messageSetSeqnum :: Message -> Word32 -> m ()
messageSetSeqnum message :: Message
message seqnum :: 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Message -> Word32 -> IO ()
gst_message_set_seqnum Ptr Message
message' Word32
seqnum
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetSeqnumMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.MethodInfo MessageSetSeqnumMethodInfo Message signature where
    overloadedMethod = messageSetSeqnum

#endif

-- method Message::set_stream_status_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A valid #GstMessage of type GST_MESSAGE_STREAM_STATUS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object controlling the streaming"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_set_stream_status_object" gst_message_set_stream_status_object :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr GValue ->                           -- object : TInterface (Name {namespace = "GObject", name = "Value"})
    IO ()

-- | Configures the object handling the streaming thread. This is usually a
-- GstTask object but other objects might be added in the future.
messageSetStreamStatusObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: A valid t'GI.Gst.Structs.Message.Message' of type GST_MESSAGE_STREAM_STATUS.
    -> GValue
    -- ^ /@object@/: the object controlling the streaming
    -> m ()
messageSetStreamStatusObject :: Message -> GValue -> m ()
messageSetStreamStatusObject message :: Message
message object :: GValue
object = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr GValue
object' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
object
    Ptr Message -> Ptr GValue -> IO ()
gst_message_set_stream_status_object Ptr Message
message' Ptr GValue
object'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageSetStreamStatusObjectMethodInfo
instance (signature ~ (GValue -> m ()), MonadIO m) => O.MethodInfo MessageSetStreamStatusObjectMethodInfo Message signature where
    overloadedMethod = messageSetStreamStatusObject

#endif

-- method Message::streams_selected_add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_STREAMS_SELECTED"
--                 , 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 "a #GstStream to add to @message"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_streams_selected_add" gst_message_streams_selected_add :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Ptr Gst.Stream.Stream ->                -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    IO ()

-- | Adds the /@stream@/ to the /@message@/.
-- 
-- /Since: 1.10/
messageStreamsSelectedAdd ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Stream.IsStream a) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeStreamsSelected'
    -> a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream' to add to /@message@/
    -> m ()
messageStreamsSelectedAdd :: Message -> a -> m ()
messageStreamsSelectedAdd message :: Message
message stream :: 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Message -> Ptr Stream -> IO ()
gst_message_streams_selected_add Ptr Message
message' Ptr Stream
stream'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    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 MessageStreamsSelectedAddMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Gst.Stream.IsStream a) => O.MethodInfo MessageStreamsSelectedAddMethodInfo Message signature where
    overloadedMethod = messageStreamsSelectedAdd

#endif

-- method Message::streams_selected_get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_STREAMS_SELECTED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_streams_selected_get_size" gst_message_streams_selected_get_size :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO Word32

-- | Returns the number of streams contained in the /@message@/.
-- 
-- /Since: 1.10/
messageStreamsSelectedGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeStreamsSelected'
    -> m Word32
    -- ^ __Returns:__ The number of streams contained within.
messageStreamsSelectedGetSize :: Message -> m Word32
messageStreamsSelectedGetSize message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Word32
result <- Ptr Message -> IO Word32
gst_message_streams_selected_get_size Ptr Message
message'
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data MessageStreamsSelectedGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo MessageStreamsSelectedGetSizeMethodInfo Message signature where
    overloadedMethod = messageStreamsSelectedGetSize

#endif

-- method Message::streams_selected_get_stream
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstMessage of type %GST_MESSAGE_STREAMS_SELECTED"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Index of the stream to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Stream" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_message_streams_selected_get_stream" gst_message_streams_selected_get_stream :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Gst.Stream.Stream)

-- | Retrieves the t'GI.Gst.Objects.Stream.Stream' with index /@index@/ from the /@message@/.
-- 
-- /Since: 1.10/
messageStreamsSelectedGetStream ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: a t'GI.Gst.Structs.Message.Message' of type 'GI.Gst.Flags.MessageTypeStreamsSelected'
    -> Word32
    -- ^ /@idx@/: Index of the stream to retrieve
    -> m (Maybe Gst.Stream.Stream)
    -- ^ __Returns:__ A t'GI.Gst.Objects.Stream.Stream'
messageStreamsSelectedGetStream :: Message -> Word32 -> m (Maybe Stream)
messageStreamsSelectedGetStream message :: Message
message idx :: Word32
idx = IO (Maybe Stream) -> m (Maybe Stream)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Stream) -> m (Maybe Stream))
-> IO (Maybe Stream) -> m (Maybe Stream)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Stream
result <- Ptr Message -> Word32 -> IO (Ptr Stream)
gst_message_streams_selected_get_stream Ptr Message
message' Word32
idx
    Maybe Stream
maybeResult <- Ptr Stream -> (Ptr Stream -> IO Stream) -> IO (Maybe Stream)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Stream
result ((Ptr Stream -> IO Stream) -> IO (Maybe Stream))
-> (Ptr Stream -> IO Stream) -> IO (Maybe Stream)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Stream
result' -> do
        Stream
result'' <- ((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
result'
        Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
result''
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Maybe Stream -> IO (Maybe Stream)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
maybeResult

#if defined(ENABLE_OVERLOADING)
data MessageStreamsSelectedGetStreamMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gst.Stream.Stream)), MonadIO m) => O.MethodInfo MessageStreamsSelectedGetStreamMethodInfo Message signature where
    overloadedMethod = messageStreamsSelectedGetStream

#endif

-- method Message::writable_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstMessage." , 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_message_writable_structure" gst_message_writable_structure :: 
    Ptr Message ->                          -- message : TInterface (Name {namespace = "Gst", name = "Message"})
    IO (Ptr Gst.Structure.Structure)

-- | Get a writable version of the structure.
-- 
-- /Since: 1.14/
messageWritableStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Message
    -- ^ /@message@/: The t'GI.Gst.Structs.Message.Message'.
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ The structure of the message. The structure
    -- is still owned by the message, which means that you should not free
    -- it and that the pointer becomes invalid when you free the message.
    -- This function checks if /@message@/ is writable and will never return
    -- 'P.Nothing'.
    -- 
    -- MT safe.
messageWritableStructure :: Message -> m Structure
messageWritableStructure message :: Message
message = 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 Message
message' <- Message -> IO (Ptr Message)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Message
message
    Ptr Structure
result <- Ptr Message -> IO (Ptr Structure)
gst_message_writable_structure Ptr Message
message'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "messageWritableStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Message -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Message
message
    Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data MessageWritableStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.MethodInfo MessageWritableStructureMethodInfo Message signature where
    overloadedMethod = messageWritableStructure

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMessageMethod (t :: Symbol) (o :: *) :: * where
    ResolveMessageMethod "addRedirectEntry" o = MessageAddRedirectEntryMethodInfo
    ResolveMessageMethod "hasName" o = MessageHasNameMethodInfo
    ResolveMessageMethod "parseAsyncDone" o = MessageParseAsyncDoneMethodInfo
    ResolveMessageMethod "parseBuffering" o = MessageParseBufferingMethodInfo
    ResolveMessageMethod "parseBufferingStats" o = MessageParseBufferingStatsMethodInfo
    ResolveMessageMethod "parseClockLost" o = MessageParseClockLostMethodInfo
    ResolveMessageMethod "parseClockProvide" o = MessageParseClockProvideMethodInfo
    ResolveMessageMethod "parseContextType" o = MessageParseContextTypeMethodInfo
    ResolveMessageMethod "parseDeviceAdded" o = MessageParseDeviceAddedMethodInfo
    ResolveMessageMethod "parseDeviceChanged" o = MessageParseDeviceChangedMethodInfo
    ResolveMessageMethod "parseDeviceRemoved" o = MessageParseDeviceRemovedMethodInfo
    ResolveMessageMethod "parseError" o = MessageParseErrorMethodInfo
    ResolveMessageMethod "parseErrorDetails" o = MessageParseErrorDetailsMethodInfo
    ResolveMessageMethod "parseGroupId" o = MessageParseGroupIdMethodInfo
    ResolveMessageMethod "parseHaveContext" o = MessageParseHaveContextMethodInfo
    ResolveMessageMethod "parseInfo" o = MessageParseInfoMethodInfo
    ResolveMessageMethod "parseInfoDetails" o = MessageParseInfoDetailsMethodInfo
    ResolveMessageMethod "parseNewClock" o = MessageParseNewClockMethodInfo
    ResolveMessageMethod "parseProgress" o = MessageParseProgressMethodInfo
    ResolveMessageMethod "parsePropertyNotify" o = MessageParsePropertyNotifyMethodInfo
    ResolveMessageMethod "parseQos" o = MessageParseQosMethodInfo
    ResolveMessageMethod "parseQosStats" o = MessageParseQosStatsMethodInfo
    ResolveMessageMethod "parseQosValues" o = MessageParseQosValuesMethodInfo
    ResolveMessageMethod "parseRedirectEntry" o = MessageParseRedirectEntryMethodInfo
    ResolveMessageMethod "parseRequestState" o = MessageParseRequestStateMethodInfo
    ResolveMessageMethod "parseResetTime" o = MessageParseResetTimeMethodInfo
    ResolveMessageMethod "parseSegmentDone" o = MessageParseSegmentDoneMethodInfo
    ResolveMessageMethod "parseSegmentStart" o = MessageParseSegmentStartMethodInfo
    ResolveMessageMethod "parseStateChanged" o = MessageParseStateChangedMethodInfo
    ResolveMessageMethod "parseStepDone" o = MessageParseStepDoneMethodInfo
    ResolveMessageMethod "parseStepStart" o = MessageParseStepStartMethodInfo
    ResolveMessageMethod "parseStreamCollection" o = MessageParseStreamCollectionMethodInfo
    ResolveMessageMethod "parseStreamStatus" o = MessageParseStreamStatusMethodInfo
    ResolveMessageMethod "parseStreamsSelected" o = MessageParseStreamsSelectedMethodInfo
    ResolveMessageMethod "parseStructureChange" o = MessageParseStructureChangeMethodInfo
    ResolveMessageMethod "parseTag" o = MessageParseTagMethodInfo
    ResolveMessageMethod "parseToc" o = MessageParseTocMethodInfo
    ResolveMessageMethod "parseWarning" o = MessageParseWarningMethodInfo
    ResolveMessageMethod "parseWarningDetails" o = MessageParseWarningDetailsMethodInfo
    ResolveMessageMethod "streamsSelectedAdd" o = MessageStreamsSelectedAddMethodInfo
    ResolveMessageMethod "streamsSelectedGetSize" o = MessageStreamsSelectedGetSizeMethodInfo
    ResolveMessageMethod "streamsSelectedGetStream" o = MessageStreamsSelectedGetStreamMethodInfo
    ResolveMessageMethod "writableStructure" o = MessageWritableStructureMethodInfo
    ResolveMessageMethod "getNumRedirectEntries" o = MessageGetNumRedirectEntriesMethodInfo
    ResolveMessageMethod "getSeqnum" o = MessageGetSeqnumMethodInfo
    ResolveMessageMethod "getStreamStatusObject" o = MessageGetStreamStatusObjectMethodInfo
    ResolveMessageMethod "getStructure" o = MessageGetStructureMethodInfo
    ResolveMessageMethod "setBufferingStats" o = MessageSetBufferingStatsMethodInfo
    ResolveMessageMethod "setGroupId" o = MessageSetGroupIdMethodInfo
    ResolveMessageMethod "setQosStats" o = MessageSetQosStatsMethodInfo
    ResolveMessageMethod "setQosValues" o = MessageSetQosValuesMethodInfo
    ResolveMessageMethod "setSeqnum" o = MessageSetSeqnumMethodInfo
    ResolveMessageMethod "setStreamStatusObject" o = MessageSetStreamStatusObjectMethodInfo
    ResolveMessageMethod l o = O.MethodResolutionFailed l o

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

#endif