{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A high-level object representing a single stream. It might be backed, or
-- not, by an actual flow of data in a pipeline (t'GI.Gst.Objects.Pad.Pad').
-- 
-- A t'GI.Gst.Objects.Stream.Stream' does not care about data changes (such as decoding, encoding,
-- parsing,...) as long as the underlying data flow corresponds to the same
-- high-level flow (ex: a certain audio track).
-- 
-- A t'GI.Gst.Objects.Stream.Stream' contains all the information pertinent to a stream, such as
-- stream-id, tags, caps, type, ...
-- 
-- Elements can subclass a t'GI.Gst.Objects.Stream.Stream' for internal usage (to contain information
-- pertinent to streams of data).
-- 
-- /Since: 1.10/

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

module GI.Gst.Objects.Stream
    ( 

-- * Exported types
    Stream(..)                              ,
    IsStream                                ,
    toStream                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveStreamMethod                     ,
#endif


-- ** getCaps #method:getCaps#

#if defined(ENABLE_OVERLOADING)
    StreamGetCapsMethodInfo                 ,
#endif
    streamGetCaps                           ,


-- ** getStreamFlags #method:getStreamFlags#

#if defined(ENABLE_OVERLOADING)
    StreamGetStreamFlagsMethodInfo          ,
#endif
    streamGetStreamFlags                    ,


-- ** getStreamId #method:getStreamId#

#if defined(ENABLE_OVERLOADING)
    StreamGetStreamIdMethodInfo             ,
#endif
    streamGetStreamId                       ,


-- ** getStreamType #method:getStreamType#

#if defined(ENABLE_OVERLOADING)
    StreamGetStreamTypeMethodInfo           ,
#endif
    streamGetStreamType                     ,


-- ** getTags #method:getTags#

#if defined(ENABLE_OVERLOADING)
    StreamGetTagsMethodInfo                 ,
#endif
    streamGetTags                           ,


-- ** new #method:new#

    streamNew                               ,


-- ** setCaps #method:setCaps#

#if defined(ENABLE_OVERLOADING)
    StreamSetCapsMethodInfo                 ,
#endif
    streamSetCaps                           ,


-- ** setStreamFlags #method:setStreamFlags#

#if defined(ENABLE_OVERLOADING)
    StreamSetStreamFlagsMethodInfo          ,
#endif
    streamSetStreamFlags                    ,


-- ** setStreamType #method:setStreamType#

#if defined(ENABLE_OVERLOADING)
    StreamSetStreamTypeMethodInfo           ,
#endif
    streamSetStreamType                     ,


-- ** setTags #method:setTags#

#if defined(ENABLE_OVERLOADING)
    StreamSetTagsMethodInfo                 ,
#endif
    streamSetTags                           ,




 -- * Properties
-- ** caps #attr:caps#
-- | The t'GI.Gst.Structs.Caps.Caps' of the t'GI.Gst.Objects.Stream.Stream'.

#if defined(ENABLE_OVERLOADING)
    StreamCapsPropertyInfo                  ,
#endif
    clearStreamCaps                         ,
    constructStreamCaps                     ,
    getStreamCaps                           ,
    setStreamCaps                           ,
#if defined(ENABLE_OVERLOADING)
    streamCaps                              ,
#endif


-- ** streamFlags #attr:streamFlags#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    StreamStreamFlagsPropertyInfo           ,
#endif
    constructStreamStreamFlags              ,
    getStreamStreamFlags                    ,
    setStreamStreamFlags                    ,
#if defined(ENABLE_OVERLOADING)
    streamStreamFlags                       ,
#endif


-- ** streamId #attr:streamId#
-- | The unique identifier of the t'GI.Gst.Objects.Stream.Stream'. Can only be set at construction
-- time.

#if defined(ENABLE_OVERLOADING)
    StreamStreamIdPropertyInfo              ,
#endif
    constructStreamStreamId                 ,
    getStreamStreamId                       ,
#if defined(ENABLE_OVERLOADING)
    streamStreamId                          ,
#endif


-- ** streamType #attr:streamType#
-- | The t'GI.Gst.Flags.StreamType' of the t'GI.Gst.Objects.Stream.Stream'. Can only be set at construction time.

#if defined(ENABLE_OVERLOADING)
    StreamStreamTypePropertyInfo            ,
#endif
    constructStreamStreamType               ,
    getStreamStreamType                     ,
    setStreamStreamType                     ,
#if defined(ENABLE_OVERLOADING)
    streamStreamType                        ,
#endif


-- ** tags #attr:tags#
-- | The t'GI.Gst.Structs.TagList.TagList' of the t'GI.Gst.Objects.Stream.Stream'.

#if defined(ENABLE_OVERLOADING)
    StreamTagsPropertyInfo                  ,
#endif
    clearStreamTags                         ,
    constructStreamTags                     ,
    getStreamTags                           ,
    setStreamTags                           ,
#if defined(ENABLE_OVERLOADING)
    streamTags                              ,
#endif




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.TagList as Gst.TagList

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

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

foreign import ccall "gst_stream_get_type"
    c_gst_stream_get_type :: IO B.Types.GType

instance B.Types.TypedObject Stream where
    glibType :: IO GType
glibType = IO GType
c_gst_stream_get_type

instance B.Types.GObject Stream

-- | Convert 'Stream' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Stream where
    toGValue :: Stream -> IO GValue
toGValue Stream
o = do
        GType
gtype <- IO GType
c_gst_stream_get_type
        Stream -> (Ptr Stream -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Stream
o (GType -> (GValue -> Ptr Stream -> IO ()) -> Ptr Stream -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Stream -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Stream
fromGValue GValue
gv = do
        Ptr Stream
ptr <- GValue -> IO (Ptr Stream)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Stream)
        (ManagedPtr Stream -> Stream) -> Ptr Stream -> IO Stream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Stream -> Stream
Stream Ptr Stream
ptr
        
    

-- | Type class for types which can be safely cast to `Stream`, for instance with `toStream`.
class (SP.GObject o, O.IsDescendantOf Stream o) => IsStream o
instance (SP.GObject o, O.IsDescendantOf Stream o) => IsStream o

instance O.HasParentTypes Stream
type instance O.ParentTypes Stream = '[Gst.Object.Object, GObject.Object.Object]

-- | Cast to `Stream`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toStream :: (MonadIO m, IsStream o) => o -> m Stream
toStream :: o -> m Stream
toStream = IO Stream -> m Stream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stream -> m Stream) -> (o -> IO Stream) -> o -> m Stream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Stream -> Stream) -> o -> IO Stream
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Stream -> Stream
Stream

#if defined(ENABLE_OVERLOADING)
type family ResolveStreamMethod (t :: Symbol) (o :: *) :: * where
    ResolveStreamMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveStreamMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStreamMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStreamMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveStreamMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStreamMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStreamMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStreamMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveStreamMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveStreamMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveStreamMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveStreamMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStreamMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStreamMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStreamMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveStreamMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStreamMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveStreamMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStreamMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStreamMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStreamMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveStreamMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveStreamMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStreamMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveStreamMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveStreamMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStreamMethod "getCaps" o = StreamGetCapsMethodInfo
    ResolveStreamMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveStreamMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveStreamMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStreamMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveStreamMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveStreamMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveStreamMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveStreamMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStreamMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStreamMethod "getStreamFlags" o = StreamGetStreamFlagsMethodInfo
    ResolveStreamMethod "getStreamId" o = StreamGetStreamIdMethodInfo
    ResolveStreamMethod "getStreamType" o = StreamGetStreamTypeMethodInfo
    ResolveStreamMethod "getTags" o = StreamGetTagsMethodInfo
    ResolveStreamMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveStreamMethod "setCaps" o = StreamSetCapsMethodInfo
    ResolveStreamMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveStreamMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveStreamMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveStreamMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStreamMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStreamMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveStreamMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveStreamMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStreamMethod "setStreamFlags" o = StreamSetStreamFlagsMethodInfo
    ResolveStreamMethod "setStreamType" o = StreamSetStreamTypeMethodInfo
    ResolveStreamMethod "setTags" o = StreamSetTagsMethodInfo
    ResolveStreamMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "caps"
   -- Type: TInterface (Name {namespace = "Gst", name = "Caps"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@caps@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stream #caps
-- @
getStreamCaps :: (MonadIO m, IsStream o) => o -> m (Maybe Gst.Caps.Caps)
getStreamCaps :: o -> m (Maybe Caps)
getStreamCaps o
obj = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Caps -> Caps) -> IO (Maybe Caps)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"caps" ManagedPtr Caps -> Caps
Gst.Caps.Caps

-- | Set the value of the “@caps@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stream [ #caps 'Data.GI.Base.Attributes.:=' value ]
-- @
setStreamCaps :: (MonadIO m, IsStream o) => o -> Gst.Caps.Caps -> m ()
setStreamCaps :: o -> Caps -> m ()
setStreamCaps o
obj Caps
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Caps -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"caps" (Caps -> Maybe Caps
forall a. a -> Maybe a
Just Caps
val)

-- | Construct a `GValueConstruct` with valid value for the “@caps@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamCaps :: (IsStream o, MIO.MonadIO m) => Gst.Caps.Caps -> m (GValueConstruct o)
constructStreamCaps :: Caps -> m (GValueConstruct o)
constructStreamCaps Caps
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Caps -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"caps" (Caps -> Maybe Caps
forall a. a -> Maybe a
P.Just Caps
val)

-- | Set the value of the “@caps@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #caps
-- @
clearStreamCaps :: (MonadIO m, IsStream o) => o -> m ()
clearStreamCaps :: o -> m ()
clearStreamCaps o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Caps -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"caps" (Maybe Caps
forall a. Maybe a
Nothing :: Maybe Gst.Caps.Caps)

#if defined(ENABLE_OVERLOADING)
data StreamCapsPropertyInfo
instance AttrInfo StreamCapsPropertyInfo where
    type AttrAllowedOps StreamCapsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StreamCapsPropertyInfo = IsStream
    type AttrSetTypeConstraint StreamCapsPropertyInfo = (~) Gst.Caps.Caps
    type AttrTransferTypeConstraint StreamCapsPropertyInfo = (~) Gst.Caps.Caps
    type AttrTransferType StreamCapsPropertyInfo = Gst.Caps.Caps
    type AttrGetType StreamCapsPropertyInfo = (Maybe Gst.Caps.Caps)
    type AttrLabel StreamCapsPropertyInfo = "caps"
    type AttrOrigin StreamCapsPropertyInfo = Stream
    attrGet = getStreamCaps
    attrSet = setStreamCaps
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamCaps
    attrClear = clearStreamCaps
#endif

-- VVV Prop "stream-flags"
   -- Type: TInterface (Name {namespace = "Gst", name = "StreamFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@stream-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stream #streamFlags
-- @
getStreamStreamFlags :: (MonadIO m, IsStream o) => o -> m [Gst.Flags.StreamFlags]
getStreamStreamFlags :: o -> m [StreamFlags]
getStreamStreamFlags o
obj = IO [StreamFlags] -> m [StreamFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StreamFlags] -> m [StreamFlags])
-> IO [StreamFlags] -> m [StreamFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [StreamFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"stream-flags"

-- | Set the value of the “@stream-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stream [ #streamFlags 'Data.GI.Base.Attributes.:=' value ]
-- @
setStreamStreamFlags :: (MonadIO m, IsStream o) => o -> [Gst.Flags.StreamFlags] -> m ()
setStreamStreamFlags :: o -> [StreamFlags] -> m ()
setStreamStreamFlags o
obj [StreamFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [StreamFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"stream-flags" [StreamFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@stream-flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamStreamFlags :: (IsStream o, MIO.MonadIO m) => [Gst.Flags.StreamFlags] -> m (GValueConstruct o)
constructStreamStreamFlags :: [StreamFlags] -> m (GValueConstruct o)
constructStreamStreamFlags [StreamFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [StreamFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"stream-flags" [StreamFlags]
val

#if defined(ENABLE_OVERLOADING)
data StreamStreamFlagsPropertyInfo
instance AttrInfo StreamStreamFlagsPropertyInfo where
    type AttrAllowedOps StreamStreamFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StreamStreamFlagsPropertyInfo = IsStream
    type AttrSetTypeConstraint StreamStreamFlagsPropertyInfo = (~) [Gst.Flags.StreamFlags]
    type AttrTransferTypeConstraint StreamStreamFlagsPropertyInfo = (~) [Gst.Flags.StreamFlags]
    type AttrTransferType StreamStreamFlagsPropertyInfo = [Gst.Flags.StreamFlags]
    type AttrGetType StreamStreamFlagsPropertyInfo = [Gst.Flags.StreamFlags]
    type AttrLabel StreamStreamFlagsPropertyInfo = "stream-flags"
    type AttrOrigin StreamStreamFlagsPropertyInfo = Stream
    attrGet = getStreamStreamFlags
    attrSet = setStreamStreamFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamStreamFlags
    attrClear = undefined
#endif

-- VVV Prop "stream-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@stream-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stream #streamId
-- @
getStreamStreamId :: (MonadIO m, IsStream o) => o -> m (Maybe T.Text)
getStreamStreamId :: o -> m (Maybe Text)
getStreamStreamId o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"stream-id"

-- | Construct a `GValueConstruct` with valid value for the “@stream-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamStreamId :: (IsStream o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStreamStreamId :: Text -> m (GValueConstruct o)
constructStreamStreamId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"stream-id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StreamStreamIdPropertyInfo
instance AttrInfo StreamStreamIdPropertyInfo where
    type AttrAllowedOps StreamStreamIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StreamStreamIdPropertyInfo = IsStream
    type AttrSetTypeConstraint StreamStreamIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StreamStreamIdPropertyInfo = (~) T.Text
    type AttrTransferType StreamStreamIdPropertyInfo = T.Text
    type AttrGetType StreamStreamIdPropertyInfo = (Maybe T.Text)
    type AttrLabel StreamStreamIdPropertyInfo = "stream-id"
    type AttrOrigin StreamStreamIdPropertyInfo = Stream
    attrGet = getStreamStreamId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamStreamId
    attrClear = undefined
#endif

-- VVV Prop "stream-type"
   -- Type: TInterface (Name {namespace = "Gst", name = "StreamType"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@stream-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stream #streamType
-- @
getStreamStreamType :: (MonadIO m, IsStream o) => o -> m [Gst.Flags.StreamType]
getStreamStreamType :: o -> m [StreamType]
getStreamStreamType o
obj = IO [StreamType] -> m [StreamType]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StreamType] -> m [StreamType])
-> IO [StreamType] -> m [StreamType]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [StreamType]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"stream-type"

-- | Set the value of the “@stream-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stream [ #streamType 'Data.GI.Base.Attributes.:=' value ]
-- @
setStreamStreamType :: (MonadIO m, IsStream o) => o -> [Gst.Flags.StreamType] -> m ()
setStreamStreamType :: o -> [StreamType] -> m ()
setStreamStreamType o
obj [StreamType]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [StreamType] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"stream-type" [StreamType]
val

-- | Construct a `GValueConstruct` with valid value for the “@stream-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamStreamType :: (IsStream o, MIO.MonadIO m) => [Gst.Flags.StreamType] -> m (GValueConstruct o)
constructStreamStreamType :: [StreamType] -> m (GValueConstruct o)
constructStreamStreamType [StreamType]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [StreamType] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"stream-type" [StreamType]
val

#if defined(ENABLE_OVERLOADING)
data StreamStreamTypePropertyInfo
instance AttrInfo StreamStreamTypePropertyInfo where
    type AttrAllowedOps StreamStreamTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StreamStreamTypePropertyInfo = IsStream
    type AttrSetTypeConstraint StreamStreamTypePropertyInfo = (~) [Gst.Flags.StreamType]
    type AttrTransferTypeConstraint StreamStreamTypePropertyInfo = (~) [Gst.Flags.StreamType]
    type AttrTransferType StreamStreamTypePropertyInfo = [Gst.Flags.StreamType]
    type AttrGetType StreamStreamTypePropertyInfo = [Gst.Flags.StreamType]
    type AttrLabel StreamStreamTypePropertyInfo = "stream-type"
    type AttrOrigin StreamStreamTypePropertyInfo = Stream
    attrGet = getStreamStreamType
    attrSet = setStreamStreamType
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamStreamType
    attrClear = undefined
#endif

-- VVV Prop "tags"
   -- Type: TInterface (Name {namespace = "Gst", name = "TagList"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@tags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stream #tags
-- @
getStreamTags :: (MonadIO m, IsStream o) => o -> m (Maybe Gst.TagList.TagList)
getStreamTags :: o -> m (Maybe TagList)
getStreamTags o
obj = IO (Maybe TagList) -> m (Maybe TagList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TagList) -> m (Maybe TagList))
-> IO (Maybe TagList) -> m (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr TagList -> TagList) -> IO (Maybe TagList)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"tags" ManagedPtr TagList -> TagList
Gst.TagList.TagList

-- | Set the value of the “@tags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stream [ #tags 'Data.GI.Base.Attributes.:=' value ]
-- @
setStreamTags :: (MonadIO m, IsStream o) => o -> Gst.TagList.TagList -> m ()
setStreamTags :: o -> TagList -> m ()
setStreamTags o
obj TagList
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe TagList -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"tags" (TagList -> Maybe TagList
forall a. a -> Maybe a
Just TagList
val)

-- | Construct a `GValueConstruct` with valid value for the “@tags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStreamTags :: (IsStream o, MIO.MonadIO m) => Gst.TagList.TagList -> m (GValueConstruct o)
constructStreamTags :: TagList -> m (GValueConstruct o)
constructStreamTags TagList
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe TagList -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"tags" (TagList -> Maybe TagList
forall a. a -> Maybe a
P.Just TagList
val)

-- | Set the value of the “@tags@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #tags
-- @
clearStreamTags :: (MonadIO m, IsStream o) => o -> m ()
clearStreamTags :: o -> m ()
clearStreamTags o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe TagList -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"tags" (Maybe TagList
forall a. Maybe a
Nothing :: Maybe Gst.TagList.TagList)

#if defined(ENABLE_OVERLOADING)
data StreamTagsPropertyInfo
instance AttrInfo StreamTagsPropertyInfo where
    type AttrAllowedOps StreamTagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StreamTagsPropertyInfo = IsStream
    type AttrSetTypeConstraint StreamTagsPropertyInfo = (~) Gst.TagList.TagList
    type AttrTransferTypeConstraint StreamTagsPropertyInfo = (~) Gst.TagList.TagList
    type AttrTransferType StreamTagsPropertyInfo = Gst.TagList.TagList
    type AttrGetType StreamTagsPropertyInfo = (Maybe Gst.TagList.TagList)
    type AttrLabel StreamTagsPropertyInfo = "tags"
    type AttrOrigin StreamTagsPropertyInfo = Stream
    attrGet = getStreamTags
    attrSet = setStreamTags
    attrTransfer _ v = do
        return v
    attrConstruct = constructStreamTags
    attrClear = clearStreamTags
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Stream
type instance O.AttributeList Stream = StreamAttributeList
type StreamAttributeList = ('[ '("caps", StreamCapsPropertyInfo), '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("streamFlags", StreamStreamFlagsPropertyInfo), '("streamId", StreamStreamIdPropertyInfo), '("streamType", StreamStreamTypePropertyInfo), '("tags", StreamTagsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
streamCaps :: AttrLabelProxy "caps"
streamCaps = AttrLabelProxy

streamStreamFlags :: AttrLabelProxy "streamFlags"
streamStreamFlags = AttrLabelProxy

streamStreamId :: AttrLabelProxy "streamId"
streamStreamId = AttrLabelProxy

streamStreamType :: AttrLabelProxy "streamType"
streamStreamType = AttrLabelProxy

streamTags :: AttrLabelProxy "tags"
streamTags = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Stream = StreamSignalList
type StreamSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Stream::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "stream_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the id for the new stream. If %NULL,\na new one will be automatically generated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstCaps of the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStreamType of the stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstStreamFlags of the stream"
--                 , 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_stream_new" gst_stream_new :: 
    CString ->                              -- stream_id : TBasicType TUTF8
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gst", name = "StreamType"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "StreamFlags"})
    IO (Ptr Stream)

-- | Create a new t'GI.Gst.Objects.Stream.Stream' for the given /@streamId@/, /@caps@/, /@type@/
-- and /@flags@/
-- 
-- /Since: 1.10/
streamNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@streamId@/: the id for the new stream. If 'P.Nothing',
    -- a new one will be automatically generated
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: the t'GI.Gst.Structs.Caps.Caps' of the stream
    -> [Gst.Flags.StreamType]
    -- ^ /@type@/: the t'GI.Gst.Flags.StreamType' of the stream
    -> [Gst.Flags.StreamFlags]
    -- ^ /@flags@/: the t'GI.Gst.Flags.StreamFlags' of the stream
    -> m Stream
    -- ^ __Returns:__ The new t'GI.Gst.Objects.Stream.Stream'
streamNew :: Maybe Text
-> Maybe Caps -> [StreamType] -> [StreamFlags] -> m Stream
streamNew Maybe Text
streamId Maybe Caps
caps [StreamType]
type_ [StreamFlags]
flags = IO Stream -> m Stream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stream -> m Stream) -> IO Stream -> m Stream
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeStreamId <- case Maybe Text
streamId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jStreamId -> do
            Ptr CChar
jStreamId' <- Text -> IO (Ptr CChar)
textToCString Text
jStreamId
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jStreamId'
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    let type_' :: CUInt
type_' = [StreamType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StreamType]
type_
    let flags' :: CUInt
flags' = [StreamFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StreamFlags]
flags
    Ptr Stream
result <- Ptr CChar -> Ptr Caps -> CUInt -> CUInt -> IO (Ptr Stream)
gst_stream_new Ptr CChar
maybeStreamId Ptr Caps
maybeCaps CUInt
type_' CUInt
flags'
    Text -> Ptr Stream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"streamNew" Ptr Stream
result
    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
Stream) Ptr Stream
result
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeStreamId
    Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Retrieve the caps for /@stream@/, if any
-- 
-- /Since: 1.10/
streamGetCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> m (Maybe Gst.Caps.Caps)
    -- ^ __Returns:__ The t'GI.Gst.Structs.Caps.Caps' for /@stream@/
streamGetCaps :: a -> m (Maybe Caps)
streamGetCaps a
stream = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Caps
result <- Ptr Stream -> IO (Ptr Caps)
gst_stream_get_caps Ptr Stream
stream'
    Maybe Caps
maybeResult <- Ptr Caps -> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Caps
result ((Ptr Caps -> IO Caps) -> IO (Maybe Caps))
-> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ \Ptr Caps
result' -> do
        Caps
result'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result'
        Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe Caps -> IO (Maybe Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Caps
maybeResult

#if defined(ENABLE_OVERLOADING)
data StreamGetCapsMethodInfo
instance (signature ~ (m (Maybe Gst.Caps.Caps)), MonadIO m, IsStream a) => O.MethodInfo StreamGetCapsMethodInfo a signature where
    overloadedMethod = streamGetCaps

#endif

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

foreign import ccall "gst_stream_get_stream_flags" gst_stream_get_stream_flags :: 
    Ptr Stream ->                           -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    IO CUInt

-- | Retrieve the current stream flags for /@stream@/
-- 
-- /Since: 1.10/
streamGetStreamFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> m [Gst.Flags.StreamFlags]
    -- ^ __Returns:__ The t'GI.Gst.Flags.StreamFlags' for /@stream@/
streamGetStreamFlags :: a -> m [StreamFlags]
streamGetStreamFlags a
stream = IO [StreamFlags] -> m [StreamFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StreamFlags] -> m [StreamFlags])
-> IO [StreamFlags] -> m [StreamFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CUInt
result <- Ptr Stream -> IO CUInt
gst_stream_get_stream_flags Ptr Stream
stream'
    let result' :: [StreamFlags]
result' = CUInt -> [StreamFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    [StreamFlags] -> IO [StreamFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [StreamFlags]
result'

#if defined(ENABLE_OVERLOADING)
data StreamGetStreamFlagsMethodInfo
instance (signature ~ (m [Gst.Flags.StreamFlags]), MonadIO m, IsStream a) => O.MethodInfo StreamGetStreamFlagsMethodInfo a signature where
    overloadedMethod = streamGetStreamFlags

#endif

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

foreign import ccall "gst_stream_get_stream_id" gst_stream_get_stream_id :: 
    Ptr Stream ->                           -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    IO CString

-- | Returns the stream ID of /@stream@/.
-- 
-- /Since: 1.10/
streamGetStreamId ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the stream ID of /@stream@/. Only valid
    -- during the lifetime of /@stream@/.
streamGetStreamId :: a -> m (Maybe Text)
streamGetStreamId a
stream = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr CChar
result <- Ptr Stream -> IO (Ptr CChar)
gst_stream_get_stream_id Ptr Stream
stream'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StreamGetStreamIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStream a) => O.MethodInfo StreamGetStreamIdMethodInfo a signature where
    overloadedMethod = streamGetStreamId

#endif

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

foreign import ccall "gst_stream_get_stream_type" gst_stream_get_stream_type :: 
    Ptr Stream ->                           -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    IO CUInt

-- | Retrieve the stream type for /@stream@/
-- 
-- /Since: 1.10/
streamGetStreamType ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> m [Gst.Flags.StreamType]
    -- ^ __Returns:__ The t'GI.Gst.Flags.StreamType' for /@stream@/
streamGetStreamType :: a -> m [StreamType]
streamGetStreamType a
stream = IO [StreamType] -> m [StreamType]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StreamType] -> m [StreamType])
-> IO [StreamType] -> m [StreamType]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    CUInt
result <- Ptr Stream -> IO CUInt
gst_stream_get_stream_type Ptr Stream
stream'
    let result' :: [StreamType]
result' = CUInt -> [StreamType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    [StreamType] -> IO [StreamType]
forall (m :: * -> *) a. Monad m => a -> m a
return [StreamType]
result'

#if defined(ENABLE_OVERLOADING)
data StreamGetStreamTypeMethodInfo
instance (signature ~ (m [Gst.Flags.StreamType]), MonadIO m, IsStream a) => O.MethodInfo StreamGetStreamTypeMethodInfo a signature where
    overloadedMethod = streamGetStreamType

#endif

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

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

-- | Retrieve the tags for /@stream@/, if any
-- 
-- /Since: 1.10/
streamGetTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> m (Maybe Gst.TagList.TagList)
    -- ^ __Returns:__ The t'GI.Gst.Structs.TagList.TagList' for /@stream@/
streamGetTags :: a -> m (Maybe TagList)
streamGetTags a
stream = IO (Maybe TagList) -> m (Maybe TagList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TagList) -> m (Maybe TagList))
-> IO (Maybe TagList) -> m (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr TagList
result <- Ptr Stream -> IO (Ptr TagList)
gst_stream_get_tags Ptr Stream
stream'
    Maybe TagList
maybeResult <- Ptr TagList -> (Ptr TagList -> IO TagList) -> IO (Maybe TagList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TagList
result ((Ptr TagList -> IO TagList) -> IO (Maybe TagList))
-> (Ptr TagList -> IO TagList) -> IO (Maybe TagList)
forall a b. (a -> b) -> a -> b
$ \Ptr TagList
result' -> do
        TagList
result'' <- ((ManagedPtr TagList -> TagList) -> Ptr TagList -> IO TagList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
result'
        TagList -> IO TagList
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe TagList -> IO (Maybe TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TagList
maybeResult

#if defined(ENABLE_OVERLOADING)
data StreamGetTagsMethodInfo
instance (signature ~ (m (Maybe Gst.TagList.TagList)), MonadIO m, IsStream a) => O.MethodInfo StreamGetTagsMethodInfo a signature where
    overloadedMethod = streamGetTags

#endif

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

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

-- | Set the caps for the t'GI.Gst.Objects.Stream.Stream'
-- 
-- /Since: 1.10/
streamSetCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m ()
streamSetCaps :: a -> Maybe Caps -> m ()
streamSetCaps a
stream Maybe Caps
caps = 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 Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Maybe Caps
Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Stream -> Ptr Caps -> IO ()
gst_stream_set_caps Ptr Stream
stream' Ptr Caps
maybeCaps
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StreamSetCapsMethodInfo
instance (signature ~ (Maybe (Gst.Caps.Caps) -> m ()), MonadIO m, IsStream a) => O.MethodInfo StreamSetCapsMethodInfo a signature where
    overloadedMethod = streamSetCaps

#endif

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

foreign import ccall "gst_stream_set_stream_flags" gst_stream_set_stream_flags :: 
    Ptr Stream ->                           -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "StreamFlags"})
    IO ()

-- | Set the /@flags@/ for the /@stream@/.
-- 
-- /Since: 1.10/
streamSetStreamFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> [Gst.Flags.StreamFlags]
    -- ^ /@flags@/: the flags to set on /@stream@/
    -> m ()
streamSetStreamFlags :: a -> [StreamFlags] -> m ()
streamSetStreamFlags a
stream [StreamFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    let flags' :: CUInt
flags' = [StreamFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StreamFlags]
flags
    Ptr Stream -> CUInt -> IO ()
gst_stream_set_stream_flags Ptr Stream
stream' CUInt
flags'
    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 StreamSetStreamFlagsMethodInfo
instance (signature ~ ([Gst.Flags.StreamFlags] -> m ()), MonadIO m, IsStream a) => O.MethodInfo StreamSetStreamFlagsMethodInfo a signature where
    overloadedMethod = streamSetStreamFlags

#endif

-- method Stream::set_stream_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType = TInterface Name { namespace = "Gst" , name = "Stream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream_type"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "StreamType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type to set on @stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_stream_set_stream_type" gst_stream_set_stream_type :: 
    Ptr Stream ->                           -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    CUInt ->                                -- stream_type : TInterface (Name {namespace = "Gst", name = "StreamType"})
    IO ()

-- | Set the stream type of /@stream@/
-- 
-- /Since: 1.10/
streamSetStreamType ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> [Gst.Flags.StreamType]
    -- ^ /@streamType@/: the type to set on /@stream@/
    -> m ()
streamSetStreamType :: a -> [StreamType] -> m ()
streamSetStreamType a
stream [StreamType]
streamType = 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 Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    let streamType' :: CUInt
streamType' = [StreamType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [StreamType]
streamType
    Ptr Stream -> CUInt -> IO ()
gst_stream_set_stream_type Ptr Stream
stream' CUInt
streamType'
    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 StreamSetStreamTypeMethodInfo
instance (signature ~ ([Gst.Flags.StreamType] -> m ()), MonadIO m, IsStream a) => O.MethodInfo StreamSetStreamTypeMethodInfo a signature where
    overloadedMethod = streamSetStreamType

#endif

-- method Stream::set_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "stream"
--           , argType = TInterface Name { namespace = "Gst" , name = "Stream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TagList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstTagList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_stream_set_tags" gst_stream_set_tags :: 
    Ptr Stream ->                           -- stream : TInterface (Name {namespace = "Gst", name = "Stream"})
    Ptr Gst.TagList.TagList ->              -- tags : TInterface (Name {namespace = "Gst", name = "TagList"})
    IO ()

-- | Set the tags for the t'GI.Gst.Objects.Stream.Stream'
-- 
-- /Since: 1.10/
streamSetTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsStream a) =>
    a
    -- ^ /@stream@/: a t'GI.Gst.Objects.Stream.Stream'
    -> Maybe (Gst.TagList.TagList)
    -- ^ /@tags@/: a t'GI.Gst.Structs.TagList.TagList'
    -> m ()
streamSetTags :: a -> Maybe TagList -> m ()
streamSetTags a
stream Maybe TagList
tags = 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 Stream
stream' <- a -> IO (Ptr Stream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr TagList
maybeTags <- case Maybe TagList
tags of
        Maybe TagList
Nothing -> Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
forall a. Ptr a
nullPtr
        Just TagList
jTags -> do
            Ptr TagList
jTags' <- TagList -> IO (Ptr TagList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TagList
jTags
            Ptr TagList -> IO (Ptr TagList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TagList
jTags'
    Ptr Stream -> Ptr TagList -> IO ()
gst_stream_set_tags Ptr Stream
stream' Ptr TagList
maybeTags
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
    Maybe TagList -> (TagList -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe TagList
tags TagList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StreamSetTagsMethodInfo
instance (signature ~ (Maybe (Gst.TagList.TagList) -> m ()), MonadIO m, IsStream a) => O.MethodInfo StreamSetTagsMethodInfo a signature where
    overloadedMethod = streamSetTags

#endif