{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Base structure for information concerning a media stream. Depending on the
-- stream type, one can find more media-specific information in
-- t'GI.GstPbutils.Objects.DiscovererAudioInfo.DiscovererAudioInfo', t'GI.GstPbutils.Objects.DiscovererVideoInfo.DiscovererVideoInfo', and
-- t'GI.GstPbutils.Objects.DiscovererContainerInfo.DiscovererContainerInfo'.
-- 
-- The t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo' represents the topology of the stream. Siblings
-- can be iterated over with 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetNext' and
-- 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetPrevious'. Children (sub-streams) of a
-- stream can be accessed using the t'GI.GstPbutils.Objects.DiscovererContainerInfo.DiscovererContainerInfo' API.
-- 
-- As a simple example, if you run t'GI.GstPbutils.Objects.Discoverer.Discoverer' on an AVI file with one audio
-- and one video stream, you will get a t'GI.GstPbutils.Objects.DiscovererContainerInfo.DiscovererContainerInfo'
-- corresponding to the AVI container, which in turn will have a
-- t'GI.GstPbutils.Objects.DiscovererAudioInfo.DiscovererAudioInfo' sub-stream and a t'GI.GstPbutils.Objects.DiscovererVideoInfo.DiscovererVideoInfo' sub-stream
-- for the audio and video streams respectively.

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

module GI.GstPbutils.Objects.DiscovererStreamInfo
    ( 

-- * Exported types
    DiscovererStreamInfo(..)                ,
    IsDiscovererStreamInfo                  ,
    toDiscovererStreamInfo                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCaps]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getCaps"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getMisc]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getMisc"), [getNext]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getNext"), [getPrevious]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getPrevious"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStreamId]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getStreamId"), [getStreamNumber]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getStreamNumber"), [getStreamTypeNick]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getStreamTypeNick"), [getTags]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getTags"), [getToc]("GI.GstPbutils.Objects.DiscovererStreamInfo#g:method:getToc").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDiscovererStreamInfoMethod       ,
#endif

-- ** getCaps #method:getCaps#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetCapsMethodInfo   ,
#endif
    discovererStreamInfoGetCaps             ,


-- ** getMisc #method:getMisc#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetMiscMethodInfo   ,
#endif
    discovererStreamInfoGetMisc             ,


-- ** getNext #method:getNext#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetNextMethodInfo   ,
#endif
    discovererStreamInfoGetNext             ,


-- ** getPrevious #method:getPrevious#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetPreviousMethodInfo,
#endif
    discovererStreamInfoGetPrevious         ,


-- ** getStreamId #method:getStreamId#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetStreamIdMethodInfo,
#endif
    discovererStreamInfoGetStreamId         ,


-- ** getStreamNumber #method:getStreamNumber#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetStreamNumberMethodInfo,
#endif
    discovererStreamInfoGetStreamNumber     ,


-- ** getStreamTypeNick #method:getStreamTypeNick#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetStreamTypeNickMethodInfo,
#endif
    discovererStreamInfoGetStreamTypeNick   ,


-- ** getTags #method:getTags#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetTagsMethodInfo   ,
#endif
    discovererStreamInfoGetTags             ,


-- ** getToc #method:getToc#

#if defined(ENABLE_OVERLOADING)
    DiscovererStreamInfoGetTocMethodInfo    ,
#endif
    discovererStreamInfoGetToc              ,


-- ** listFree #method:listFree#

    discovererStreamInfoListFree            ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Structs.Caps as Gst.Caps
import qualified GI.Gst.Structs.Structure as Gst.Structure
import qualified GI.Gst.Structs.TagList as Gst.TagList
import qualified GI.Gst.Structs.Toc as Gst.Toc

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

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

foreign import ccall "gst_discoverer_stream_info_get_type"
    c_gst_discoverer_stream_info_get_type :: IO B.Types.GType

instance B.Types.TypedObject DiscovererStreamInfo where
    glibType :: IO GType
glibType = IO GType
c_gst_discoverer_stream_info_get_type

instance B.Types.GObject DiscovererStreamInfo

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

instance O.HasParentTypes DiscovererStreamInfo
type instance O.ParentTypes DiscovererStreamInfo = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDiscovererStreamInfoMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDiscovererStreamInfoMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDiscovererStreamInfoMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDiscovererStreamInfoMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDiscovererStreamInfoMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDiscovererStreamInfoMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDiscovererStreamInfoMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDiscovererStreamInfoMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDiscovererStreamInfoMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDiscovererStreamInfoMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDiscovererStreamInfoMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDiscovererStreamInfoMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDiscovererStreamInfoMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDiscovererStreamInfoMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDiscovererStreamInfoMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDiscovererStreamInfoMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDiscovererStreamInfoMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDiscovererStreamInfoMethod "getCaps" o = DiscovererStreamInfoGetCapsMethodInfo
    ResolveDiscovererStreamInfoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDiscovererStreamInfoMethod "getMisc" o = DiscovererStreamInfoGetMiscMethodInfo
    ResolveDiscovererStreamInfoMethod "getNext" o = DiscovererStreamInfoGetNextMethodInfo
    ResolveDiscovererStreamInfoMethod "getPrevious" o = DiscovererStreamInfoGetPreviousMethodInfo
    ResolveDiscovererStreamInfoMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDiscovererStreamInfoMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDiscovererStreamInfoMethod "getStreamId" o = DiscovererStreamInfoGetStreamIdMethodInfo
    ResolveDiscovererStreamInfoMethod "getStreamNumber" o = DiscovererStreamInfoGetStreamNumberMethodInfo
    ResolveDiscovererStreamInfoMethod "getStreamTypeNick" o = DiscovererStreamInfoGetStreamTypeNickMethodInfo
    ResolveDiscovererStreamInfoMethod "getTags" o = DiscovererStreamInfoGetTagsMethodInfo
    ResolveDiscovererStreamInfoMethod "getToc" o = DiscovererStreamInfoGetTocMethodInfo
    ResolveDiscovererStreamInfoMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDiscovererStreamInfoMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDiscovererStreamInfoMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDiscovererStreamInfoMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DiscovererStreamInfo
type instance O.AttributeList DiscovererStreamInfo = DiscovererStreamInfoAttributeList
type DiscovererStreamInfoAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DiscovererStreamInfo = DiscovererStreamInfoSignalList
type DiscovererStreamInfoSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method DiscovererStreamInfo::get_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererStreamInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDiscovererStreamInfo"
--                 , 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_discoverer_stream_info_get_caps" gst_discoverer_stream_info_get_caps :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO (Ptr Gst.Caps.Caps)

-- | /No description available in the introspection data./
discovererStreamInfoGetCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m (Maybe Gst.Caps.Caps)
    -- ^ __Returns:__ the t'GI.Gst.Structs.Caps.Caps' of the stream. Unref with
    -- @/gst_caps_unref/@ after usage.
discovererStreamInfoGetCaps :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m (Maybe Caps)
discovererStreamInfoGetCaps a
info = IO (Maybe Caps) -> m (Maybe Caps)
forall a. IO a -> m a
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 DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr Caps
result <- Ptr DiscovererStreamInfo -> IO (Ptr Caps)
gst_discoverer_stream_info_get_caps Ptr DiscovererStreamInfo
info'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Maybe Caps -> IO (Maybe Caps)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Caps
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetCapsMethodInfo
instance (signature ~ (m (Maybe Gst.Caps.Caps)), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetCapsMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetCaps

instance O.OverloadedMethodInfo DiscovererStreamInfoGetCapsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetCaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetCaps"
        })


#endif

-- method DiscovererStreamInfo::get_misc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererStreamInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDiscovererStreamInfo"
--                 , 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_discoverer_stream_info_get_misc" gst_discoverer_stream_info_get_misc :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO (Ptr Gst.Structure.Structure)

{-# DEPRECATED discovererStreamInfoGetMisc ["This functions is deprecated since version 1.4, use","@/gst_discoverer_info_get_missing_elements_installer_details/@"] #-}
-- | /No description available in the introspection data./
discovererStreamInfoGetMisc ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ additional information regarding the stream (for
    -- example codec version, profile, etc..). If you wish to use the t'GI.Gst.Structs.Structure.Structure'
    -- after the life-time of /@info@/ you will need to copy it.
discovererStreamInfoGetMisc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m (Maybe Structure)
discovererStreamInfoGetMisc a
info = IO (Maybe Structure) -> m (Maybe Structure)
forall a. IO a -> m a
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 DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr Structure
result <- Ptr DiscovererStreamInfo -> IO (Ptr Structure)
gst_discoverer_stream_info_get_misc Ptr DiscovererStreamInfo
info'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result'
        Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Maybe Structure -> IO (Maybe Structure)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetMiscMethodInfo
instance (signature ~ (m (Maybe Gst.Structure.Structure)), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetMiscMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetMisc

instance O.OverloadedMethodInfo DiscovererStreamInfoGetMiscMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetMisc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetMisc"
        })


#endif

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

foreign import ccall "gst_discoverer_stream_info_get_next" gst_discoverer_stream_info_get_next :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO (Ptr DiscovererStreamInfo)

-- | /No description available in the introspection data./
discovererStreamInfoGetNext ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m (Maybe DiscovererStreamInfo)
    -- ^ __Returns:__ the next t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo' in a chain. 'P.Nothing'
    -- for final streams.
    -- Unref with @/gst_discoverer_stream_info_unref/@ after usage.
discovererStreamInfoGetNext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m (Maybe DiscovererStreamInfo)
discovererStreamInfoGetNext a
info = IO (Maybe DiscovererStreamInfo) -> m (Maybe DiscovererStreamInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiscovererStreamInfo) -> m (Maybe DiscovererStreamInfo))
-> IO (Maybe DiscovererStreamInfo)
-> m (Maybe DiscovererStreamInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr DiscovererStreamInfo
result <- Ptr DiscovererStreamInfo -> IO (Ptr DiscovererStreamInfo)
gst_discoverer_stream_info_get_next Ptr DiscovererStreamInfo
info'
    Maybe DiscovererStreamInfo
maybeResult <- Ptr DiscovererStreamInfo
-> (Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
-> IO (Maybe DiscovererStreamInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiscovererStreamInfo
result ((Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
 -> IO (Maybe DiscovererStreamInfo))
-> (Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
-> IO (Maybe DiscovererStreamInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr DiscovererStreamInfo
result' -> do
        DiscovererStreamInfo
result'' <- ((ManagedPtr DiscovererStreamInfo -> DiscovererStreamInfo)
-> Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererStreamInfo -> DiscovererStreamInfo
DiscovererStreamInfo) Ptr DiscovererStreamInfo
result'
        DiscovererStreamInfo -> IO DiscovererStreamInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiscovererStreamInfo
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Maybe DiscovererStreamInfo -> IO (Maybe DiscovererStreamInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiscovererStreamInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetNextMethodInfo
instance (signature ~ (m (Maybe DiscovererStreamInfo)), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetNextMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetNext

instance O.OverloadedMethodInfo DiscovererStreamInfoGetNextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetNext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetNext"
        })


#endif

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

foreign import ccall "gst_discoverer_stream_info_get_previous" gst_discoverer_stream_info_get_previous :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO (Ptr DiscovererStreamInfo)

-- | /No description available in the introspection data./
discovererStreamInfoGetPrevious ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m (Maybe DiscovererStreamInfo)
    -- ^ __Returns:__ the previous t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo' in a chain.
    -- 'P.Nothing' for starting points. Unref with @/gst_discoverer_stream_info_unref/@
    -- after usage.
discovererStreamInfoGetPrevious :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m (Maybe DiscovererStreamInfo)
discovererStreamInfoGetPrevious a
info = IO (Maybe DiscovererStreamInfo) -> m (Maybe DiscovererStreamInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiscovererStreamInfo) -> m (Maybe DiscovererStreamInfo))
-> IO (Maybe DiscovererStreamInfo)
-> m (Maybe DiscovererStreamInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr DiscovererStreamInfo
result <- Ptr DiscovererStreamInfo -> IO (Ptr DiscovererStreamInfo)
gst_discoverer_stream_info_get_previous Ptr DiscovererStreamInfo
info'
    Maybe DiscovererStreamInfo
maybeResult <- Ptr DiscovererStreamInfo
-> (Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
-> IO (Maybe DiscovererStreamInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DiscovererStreamInfo
result ((Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
 -> IO (Maybe DiscovererStreamInfo))
-> (Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
-> IO (Maybe DiscovererStreamInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr DiscovererStreamInfo
result' -> do
        DiscovererStreamInfo
result'' <- ((ManagedPtr DiscovererStreamInfo -> DiscovererStreamInfo)
-> Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererStreamInfo -> DiscovererStreamInfo
DiscovererStreamInfo) Ptr DiscovererStreamInfo
result'
        DiscovererStreamInfo -> IO DiscovererStreamInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiscovererStreamInfo
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Maybe DiscovererStreamInfo -> IO (Maybe DiscovererStreamInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiscovererStreamInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetPreviousMethodInfo
instance (signature ~ (m (Maybe DiscovererStreamInfo)), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetPreviousMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetPrevious

instance O.OverloadedMethodInfo DiscovererStreamInfoGetPreviousMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetPrevious",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetPrevious"
        })


#endif

-- method DiscovererStreamInfo::get_stream_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererStreamInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDiscovererStreamInfo"
--                 , 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_discoverer_stream_info_get_stream_id" gst_discoverer_stream_info_get_stream_id :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO CString

-- | /No description available in the introspection data./
discovererStreamInfoGetStreamId ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m T.Text
    -- ^ __Returns:__ the stream ID of this stream. If you wish to
    -- use the stream ID after the life-time of /@info@/ you will need to copy it.
discovererStreamInfoGetStreamId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m Text
discovererStreamInfoGetStreamId a
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    CString
result <- Ptr DiscovererStreamInfo -> IO CString
gst_discoverer_stream_info_get_stream_id Ptr DiscovererStreamInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererStreamInfoGetStreamId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetStreamIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetStreamIdMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetStreamId

instance O.OverloadedMethodInfo DiscovererStreamInfoGetStreamIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetStreamId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetStreamId"
        })


#endif

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

foreign import ccall "gst_discoverer_stream_info_get_stream_number" gst_discoverer_stream_info_get_stream_number :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO Int32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.20/
discovererStreamInfoGetStreamNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m Int32
    -- ^ __Returns:__ the stream number, -1 if no index could be determined. This property
    -- acts as a unique identifier as a \'int\' for the stream.
discovererStreamInfoGetStreamNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m Int32
discovererStreamInfoGetStreamNumber a
info = IO Int32 -> m Int32
forall a. IO a -> m a
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 DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Int32
result <- Ptr DiscovererStreamInfo -> IO Int32
gst_discoverer_stream_info_get_stream_number Ptr DiscovererStreamInfo
info'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetStreamNumberMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetStreamNumberMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetStreamNumber

instance O.OverloadedMethodInfo DiscovererStreamInfoGetStreamNumberMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetStreamNumber",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetStreamNumber"
        })


#endif

-- method DiscovererStreamInfo::get_stream_type_nick
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererStreamInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDiscovererStreamInfo"
--                 , 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_discoverer_stream_info_get_stream_type_nick" gst_discoverer_stream_info_get_stream_type_nick :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO CString

-- | /No description available in the introspection data./
discovererStreamInfoGetStreamTypeNick ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m T.Text
    -- ^ __Returns:__ a human readable name for the stream type of the given /@info@/ (ex : \"audio\",
    -- \"container\",...).
discovererStreamInfoGetStreamTypeNick :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m Text
discovererStreamInfoGetStreamTypeNick a
info = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    CString
result <- Ptr DiscovererStreamInfo -> IO CString
gst_discoverer_stream_info_get_stream_type_nick Ptr DiscovererStreamInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererStreamInfoGetStreamTypeNick" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetStreamTypeNickMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetStreamTypeNickMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetStreamTypeNick

instance O.OverloadedMethodInfo DiscovererStreamInfoGetStreamTypeNickMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetStreamTypeNick",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetStreamTypeNick"
        })


#endif

-- method DiscovererStreamInfo::get_tags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererStreamInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDiscovererStreamInfo"
--                 , 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_discoverer_stream_info_get_tags" gst_discoverer_stream_info_get_tags :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO (Ptr Gst.TagList.TagList)

-- | /No description available in the introspection data./
discovererStreamInfoGetTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m (Maybe Gst.TagList.TagList)
    -- ^ __Returns:__ the tags contained in this stream. If you wish to
    -- use the tags after the life-time of /@info@/ you will need to copy them.
discovererStreamInfoGetTags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m (Maybe TagList)
discovererStreamInfoGetTags a
info = IO (Maybe TagList) -> m (Maybe TagList)
forall a. IO a -> m a
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 DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr TagList
result <- Ptr DiscovererStreamInfo -> IO (Ptr TagList)
gst_discoverer_stream_info_get_tags Ptr DiscovererStreamInfo
info'
    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
newBoxed ManagedPtr TagList -> TagList
Gst.TagList.TagList) Ptr TagList
result'
        TagList -> IO TagList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TagList
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Maybe TagList -> IO (Maybe TagList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TagList
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetTagsMethodInfo
instance (signature ~ (m (Maybe Gst.TagList.TagList)), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetTagsMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetTags

instance O.OverloadedMethodInfo DiscovererStreamInfoGetTagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetTags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetTags"
        })


#endif

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

foreign import ccall "gst_discoverer_stream_info_get_toc" gst_discoverer_stream_info_get_toc :: 
    Ptr DiscovererStreamInfo ->             -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"})
    IO (Ptr Gst.Toc.Toc)

-- | /No description available in the introspection data./
discovererStreamInfoGetToc ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m (Maybe Gst.Toc.Toc)
    -- ^ __Returns:__ the TOC contained in this stream. If you wish to
    -- use the TOC after the life-time of /@info@/ you will need to copy it.
discovererStreamInfoGetToc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
a -> m (Maybe Toc)
discovererStreamInfoGetToc a
info = IO (Maybe Toc) -> m (Maybe Toc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Toc) -> m (Maybe Toc))
-> IO (Maybe Toc) -> m (Maybe Toc)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererStreamInfo
info' <- a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr Toc
result <- Ptr DiscovererStreamInfo -> IO (Ptr Toc)
gst_discoverer_stream_info_get_toc Ptr DiscovererStreamInfo
info'
    Maybe Toc
maybeResult <- Ptr Toc -> (Ptr Toc -> IO Toc) -> IO (Maybe Toc)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Toc
result ((Ptr Toc -> IO Toc) -> IO (Maybe Toc))
-> (Ptr Toc -> IO Toc) -> IO (Maybe Toc)
forall a b. (a -> b) -> a -> b
$ \Ptr Toc
result' -> do
        Toc
result'' <- ((ManagedPtr Toc -> Toc) -> Ptr Toc -> IO Toc
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Toc -> Toc
Gst.Toc.Toc) Ptr Toc
result'
        Toc -> IO Toc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Toc
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Maybe Toc -> IO (Maybe Toc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Toc
maybeResult

#if defined(ENABLE_OVERLOADING)
data DiscovererStreamInfoGetTocMethodInfo
instance (signature ~ (m (Maybe Gst.Toc.Toc)), MonadIO m, IsDiscovererStreamInfo a) => O.OverloadedMethod DiscovererStreamInfoGetTocMethodInfo a signature where
    overloadedMethod = discovererStreamInfoGetToc

instance O.OverloadedMethodInfo DiscovererStreamInfoGetTocMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoGetToc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstpbutils-1.0.27/docs/GI-GstPbutils-Objects-DiscovererStreamInfo.html#v:discovererStreamInfoGetToc"
        })


#endif

-- method DiscovererStreamInfo::list_free
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "infos"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "GstPbutils" , name = "DiscovererStreamInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of #GstDiscovererStreamInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_discoverer_stream_info_list_free" gst_discoverer_stream_info_list_free :: 
    Ptr (GList (Ptr DiscovererStreamInfo)) -> -- infos : TGList (TInterface (Name {namespace = "GstPbutils", name = "DiscovererStreamInfo"}))
    IO ()

-- | Decrements the reference count of all contained t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
-- and fress the t'GI.GLib.Structs.List.List'.
discovererStreamInfoListFree ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
    [a]
    -- ^ /@infos@/: a t'GI.GLib.Structs.List.List' of t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m ()
discovererStreamInfoListFree :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererStreamInfo a) =>
[a] -> m ()
discovererStreamInfoListFree [a]
infos = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    [Ptr DiscovererStreamInfo]
infos' <- (a -> IO (Ptr DiscovererStreamInfo))
-> [a] -> IO [Ptr DiscovererStreamInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr DiscovererStreamInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
infos
    Ptr (GList (Ptr DiscovererStreamInfo))
infos'' <- [Ptr DiscovererStreamInfo]
-> IO (Ptr (GList (Ptr DiscovererStreamInfo)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr DiscovererStreamInfo]
infos'
    Ptr (GList (Ptr DiscovererStreamInfo)) -> IO ()
gst_discoverer_stream_info_list_free Ptr (GList (Ptr DiscovererStreamInfo))
infos''
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
infos
    Ptr (GList (Ptr DiscovererStreamInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererStreamInfo))
infos''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif