{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Structure containing the information of a URI analyzed by t'GI.GstPbutils.Objects.Discoverer.Discoverer'.

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

module GI.GstPbutils.Objects.DiscovererInfo
    ( 

-- * Exported types
    DiscovererInfo(..)                      ,
    IsDiscovererInfo                        ,
    toDiscovererInfo                        ,


 -- * 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"), [copy]("GI.GstPbutils.Objects.DiscovererInfo#g:method:copy"), [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"), [toVariant]("GI.GstPbutils.Objects.DiscovererInfo#g:method:toVariant"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAudioStreams]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getAudioStreams"), [getContainerStreams]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getContainerStreams"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDuration]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getDuration"), [getLive]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getLive"), [getMisc]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getMisc"), [getMissingElementsInstallerDetails]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getMissingElementsInstallerDetails"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getResult]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getResult"), [getSeekable]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getSeekable"), [getStreamInfo]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getStreamInfo"), [getStreamList]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getStreamList"), [getStreams]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getStreams"), [getSubtitleStreams]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getSubtitleStreams"), [getTags]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getTags"), [getToc]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getToc"), [getUri]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getUri"), [getVideoStreams]("GI.GstPbutils.Objects.DiscovererInfo#g:method:getVideoStreams").
-- 
-- ==== 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)
    ResolveDiscovererInfoMethod             ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoCopyMethodInfo            ,
#endif
    discovererInfoCopy                      ,


-- ** fromVariant #method:fromVariant#

    discovererInfoFromVariant               ,


-- ** getAudioStreams #method:getAudioStreams#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetAudioStreamsMethodInfo ,
#endif
    discovererInfoGetAudioStreams           ,


-- ** getContainerStreams #method:getContainerStreams#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetContainerStreamsMethodInfo,
#endif
    discovererInfoGetContainerStreams       ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetDurationMethodInfo     ,
#endif
    discovererInfoGetDuration               ,


-- ** getLive #method:getLive#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetLiveMethodInfo         ,
#endif
    discovererInfoGetLive                   ,


-- ** getMisc #method:getMisc#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetMiscMethodInfo         ,
#endif
    discovererInfoGetMisc                   ,


-- ** getMissingElementsInstallerDetails #method:getMissingElementsInstallerDetails#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetMissingElementsInstallerDetailsMethodInfo,
#endif
    discovererInfoGetMissingElementsInstallerDetails,


-- ** getResult #method:getResult#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetResultMethodInfo       ,
#endif
    discovererInfoGetResult                 ,


-- ** getSeekable #method:getSeekable#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetSeekableMethodInfo     ,
#endif
    discovererInfoGetSeekable               ,


-- ** getStreamInfo #method:getStreamInfo#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetStreamInfoMethodInfo   ,
#endif
    discovererInfoGetStreamInfo             ,


-- ** getStreamList #method:getStreamList#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetStreamListMethodInfo   ,
#endif
    discovererInfoGetStreamList             ,


-- ** getStreams #method:getStreams#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetStreamsMethodInfo      ,
#endif
    discovererInfoGetStreams                ,


-- ** getSubtitleStreams #method:getSubtitleStreams#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetSubtitleStreamsMethodInfo,
#endif
    discovererInfoGetSubtitleStreams        ,


-- ** getTags #method:getTags#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetTagsMethodInfo         ,
#endif
    discovererInfoGetTags                   ,


-- ** getToc #method:getToc#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetTocMethodInfo          ,
#endif
    discovererInfoGetToc                    ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetUriMethodInfo          ,
#endif
    discovererInfoGetUri                    ,


-- ** getVideoStreams #method:getVideoStreams#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoGetVideoStreamsMethodInfo ,
#endif
    discovererInfoGetVideoStreams           ,


-- ** toVariant #method:toVariant#

#if defined(ENABLE_OVERLOADING)
    DiscovererInfoToVariantMethodInfo       ,
#endif
    discovererInfoToVariant                 ,




    ) 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.Structure as Gst.Structure
import qualified GI.Gst.Structs.TagList as Gst.TagList
import qualified GI.Gst.Structs.Toc as Gst.Toc
import {-# SOURCE #-} qualified GI.GstPbutils.Enums as GstPbutils.Enums
import {-# SOURCE #-} qualified GI.GstPbutils.Flags as GstPbutils.Flags
import {-# SOURCE #-} qualified GI.GstPbutils.Objects.DiscovererAudioInfo as GstPbutils.DiscovererAudioInfo
import {-# SOURCE #-} qualified GI.GstPbutils.Objects.DiscovererContainerInfo as GstPbutils.DiscovererContainerInfo
import {-# SOURCE #-} qualified GI.GstPbutils.Objects.DiscovererStreamInfo as GstPbutils.DiscovererStreamInfo
import {-# SOURCE #-} qualified GI.GstPbutils.Objects.DiscovererSubtitleInfo as GstPbutils.DiscovererSubtitleInfo
import {-# SOURCE #-} qualified GI.GstPbutils.Objects.DiscovererVideoInfo as GstPbutils.DiscovererVideoInfo

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

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

foreign import ccall "gst_discoverer_info_get_type"
    c_gst_discoverer_info_get_type :: IO B.Types.GType

instance B.Types.TypedObject DiscovererInfo where
    glibType :: IO GType
glibType = IO GType
c_gst_discoverer_info_get_type

instance B.Types.GObject DiscovererInfo

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

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

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

-- | Convert 'DiscovererInfo' 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 DiscovererInfo) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_discoverer_info_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DiscovererInfo -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DiscovererInfo
P.Nothing = Ptr GValue -> Ptr DiscovererInfo -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DiscovererInfo
forall a. Ptr a
FP.nullPtr :: FP.Ptr DiscovererInfo)
    gvalueSet_ Ptr GValue
gv (P.Just DiscovererInfo
obj) = DiscovererInfo -> (Ptr DiscovererInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DiscovererInfo
obj (Ptr GValue -> Ptr DiscovererInfo -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DiscovererInfo)
gvalueGet_ Ptr GValue
gv = do
        Ptr DiscovererInfo
ptr <- Ptr GValue -> IO (Ptr DiscovererInfo)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DiscovererInfo)
        if Ptr DiscovererInfo
ptr Ptr DiscovererInfo -> Ptr DiscovererInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DiscovererInfo
forall a. Ptr a
FP.nullPtr
        then DiscovererInfo -> Maybe DiscovererInfo
forall a. a -> Maybe a
P.Just (DiscovererInfo -> Maybe DiscovererInfo)
-> IO DiscovererInfo -> IO (Maybe DiscovererInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DiscovererInfo -> DiscovererInfo)
-> Ptr DiscovererInfo -> IO DiscovererInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DiscovererInfo -> DiscovererInfo
DiscovererInfo Ptr DiscovererInfo
ptr
        else Maybe DiscovererInfo -> IO (Maybe DiscovererInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiscovererInfo
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveDiscovererInfoMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDiscovererInfoMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDiscovererInfoMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDiscovererInfoMethod "copy" o = DiscovererInfoCopyMethodInfo
    ResolveDiscovererInfoMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDiscovererInfoMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDiscovererInfoMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDiscovererInfoMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDiscovererInfoMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDiscovererInfoMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDiscovererInfoMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDiscovererInfoMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDiscovererInfoMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDiscovererInfoMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDiscovererInfoMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDiscovererInfoMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDiscovererInfoMethod "toVariant" o = DiscovererInfoToVariantMethodInfo
    ResolveDiscovererInfoMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDiscovererInfoMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDiscovererInfoMethod "getAudioStreams" o = DiscovererInfoGetAudioStreamsMethodInfo
    ResolveDiscovererInfoMethod "getContainerStreams" o = DiscovererInfoGetContainerStreamsMethodInfo
    ResolveDiscovererInfoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDiscovererInfoMethod "getDuration" o = DiscovererInfoGetDurationMethodInfo
    ResolveDiscovererInfoMethod "getLive" o = DiscovererInfoGetLiveMethodInfo
    ResolveDiscovererInfoMethod "getMisc" o = DiscovererInfoGetMiscMethodInfo
    ResolveDiscovererInfoMethod "getMissingElementsInstallerDetails" o = DiscovererInfoGetMissingElementsInstallerDetailsMethodInfo
    ResolveDiscovererInfoMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDiscovererInfoMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDiscovererInfoMethod "getResult" o = DiscovererInfoGetResultMethodInfo
    ResolveDiscovererInfoMethod "getSeekable" o = DiscovererInfoGetSeekableMethodInfo
    ResolveDiscovererInfoMethod "getStreamInfo" o = DiscovererInfoGetStreamInfoMethodInfo
    ResolveDiscovererInfoMethod "getStreamList" o = DiscovererInfoGetStreamListMethodInfo
    ResolveDiscovererInfoMethod "getStreams" o = DiscovererInfoGetStreamsMethodInfo
    ResolveDiscovererInfoMethod "getSubtitleStreams" o = DiscovererInfoGetSubtitleStreamsMethodInfo
    ResolveDiscovererInfoMethod "getTags" o = DiscovererInfoGetTagsMethodInfo
    ResolveDiscovererInfoMethod "getToc" o = DiscovererInfoGetTocMethodInfo
    ResolveDiscovererInfoMethod "getUri" o = DiscovererInfoGetUriMethodInfo
    ResolveDiscovererInfoMethod "getVideoStreams" o = DiscovererInfoGetVideoStreamsMethodInfo
    ResolveDiscovererInfoMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDiscovererInfoMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDiscovererInfoMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDiscovererInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDiscovererInfoMethod t DiscovererInfo, O.OverloadedMethod info DiscovererInfo p) => OL.IsLabel t (DiscovererInfo -> 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 ~ ResolveDiscovererInfoMethod t DiscovererInfo, O.OverloadedMethod info DiscovererInfo p, R.HasField t DiscovererInfo p) => R.HasField t DiscovererInfo p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "gst_discoverer_info_copy" gst_discoverer_info_copy :: 
    Ptr DiscovererInfo ->                   -- ptr : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr DiscovererInfo)

-- | /No description available in the introspection data./
discovererInfoCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@ptr@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m DiscovererInfo
    -- ^ __Returns:__ A copy of the t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
discovererInfoCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m DiscovererInfo
discovererInfoCopy a
ptr = IO DiscovererInfo -> m DiscovererInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DiscovererInfo -> m DiscovererInfo)
-> IO DiscovererInfo -> m DiscovererInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
ptr' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
ptr
    Ptr DiscovererInfo
result <- Ptr DiscovererInfo -> IO (Ptr DiscovererInfo)
gst_discoverer_info_copy Ptr DiscovererInfo
ptr'
    Text -> Ptr DiscovererInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererInfoCopy" Ptr DiscovererInfo
result
    DiscovererInfo
result' <- ((ManagedPtr DiscovererInfo -> DiscovererInfo)
-> Ptr DiscovererInfo -> IO DiscovererInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererInfo -> DiscovererInfo
DiscovererInfo) Ptr DiscovererInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
ptr
    DiscovererInfo -> IO DiscovererInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiscovererInfo
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoCopyMethodInfo
instance (signature ~ (m DiscovererInfo), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoCopyMethodInfo a signature where
    overloadedMethod = discovererInfoCopy

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


#endif

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

foreign import ccall "gst_discoverer_info_get_audio_streams" gst_discoverer_info_get_audio_streams :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr (GList (Ptr GstPbutils.DiscovererAudioInfo.DiscovererAudioInfo)))

-- | Finds all the t'GI.GstPbutils.Objects.DiscovererAudioInfo.DiscovererAudioInfo' contained in /@info@/
discovererInfoGetAudioStreams ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m [GstPbutils.DiscovererAudioInfo.DiscovererAudioInfo]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of
    -- matching t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'. The caller should free it with
    -- 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoListFree'.
discovererInfoGetAudioStreams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m [DiscovererAudioInfo]
discovererInfoGetAudioStreams a
info = IO [DiscovererAudioInfo] -> m [DiscovererAudioInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscovererAudioInfo] -> m [DiscovererAudioInfo])
-> IO [DiscovererAudioInfo] -> m [DiscovererAudioInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr (GList (Ptr DiscovererAudioInfo))
result <- Ptr DiscovererInfo -> IO (Ptr (GList (Ptr DiscovererAudioInfo)))
gst_discoverer_info_get_audio_streams Ptr DiscovererInfo
info'
    [Ptr DiscovererAudioInfo]
result' <- Ptr (GList (Ptr DiscovererAudioInfo))
-> IO [Ptr DiscovererAudioInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DiscovererAudioInfo))
result
    [DiscovererAudioInfo]
result'' <- (Ptr DiscovererAudioInfo -> IO DiscovererAudioInfo)
-> [Ptr DiscovererAudioInfo] -> IO [DiscovererAudioInfo]
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 ((ManagedPtr DiscovererAudioInfo -> DiscovererAudioInfo)
-> Ptr DiscovererAudioInfo -> IO DiscovererAudioInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererAudioInfo -> DiscovererAudioInfo
GstPbutils.DiscovererAudioInfo.DiscovererAudioInfo) [Ptr DiscovererAudioInfo]
result'
    Ptr (GList (Ptr DiscovererAudioInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererAudioInfo))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    [DiscovererAudioInfo] -> IO [DiscovererAudioInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiscovererAudioInfo]
result''

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetAudioStreamsMethodInfo
instance (signature ~ (m [GstPbutils.DiscovererAudioInfo.DiscovererAudioInfo]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetAudioStreamsMethodInfo a signature where
    overloadedMethod = discovererInfoGetAudioStreams

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


#endif

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

foreign import ccall "gst_discoverer_info_get_container_streams" gst_discoverer_info_get_container_streams :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr (GList (Ptr GstPbutils.DiscovererContainerInfo.DiscovererContainerInfo)))

-- | Finds all the t'GI.GstPbutils.Objects.DiscovererContainerInfo.DiscovererContainerInfo' contained in /@info@/
discovererInfoGetContainerStreams ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m [GstPbutils.DiscovererContainerInfo.DiscovererContainerInfo]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of
    -- matching t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'. The caller should free it with
    -- 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoListFree'.
discovererInfoGetContainerStreams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m [DiscovererContainerInfo]
discovererInfoGetContainerStreams a
info = IO [DiscovererContainerInfo] -> m [DiscovererContainerInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscovererContainerInfo] -> m [DiscovererContainerInfo])
-> IO [DiscovererContainerInfo] -> m [DiscovererContainerInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr (GList (Ptr DiscovererContainerInfo))
result <- Ptr DiscovererInfo
-> IO (Ptr (GList (Ptr DiscovererContainerInfo)))
gst_discoverer_info_get_container_streams Ptr DiscovererInfo
info'
    [Ptr DiscovererContainerInfo]
result' <- Ptr (GList (Ptr DiscovererContainerInfo))
-> IO [Ptr DiscovererContainerInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DiscovererContainerInfo))
result
    [DiscovererContainerInfo]
result'' <- (Ptr DiscovererContainerInfo -> IO DiscovererContainerInfo)
-> [Ptr DiscovererContainerInfo] -> IO [DiscovererContainerInfo]
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 ((ManagedPtr DiscovererContainerInfo -> DiscovererContainerInfo)
-> Ptr DiscovererContainerInfo -> IO DiscovererContainerInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererContainerInfo -> DiscovererContainerInfo
GstPbutils.DiscovererContainerInfo.DiscovererContainerInfo) [Ptr DiscovererContainerInfo]
result'
    Ptr (GList (Ptr DiscovererContainerInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererContainerInfo))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    [DiscovererContainerInfo] -> IO [DiscovererContainerInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiscovererContainerInfo]
result''

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetContainerStreamsMethodInfo
instance (signature ~ (m [GstPbutils.DiscovererContainerInfo.DiscovererContainerInfo]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetContainerStreamsMethodInfo a signature where
    overloadedMethod = discovererInfoGetContainerStreams

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


#endif

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

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

-- | /No description available in the introspection data./
discovererInfoGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m Word64
    -- ^ __Returns:__ the duration of the URI in @/GstClockTime/@ (nanoseconds).
discovererInfoGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m Word64
discovererInfoGetDuration a
info = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Word64
result <- Ptr DiscovererInfo -> IO Word64
gst_discoverer_info_get_duration Ptr DiscovererInfo
info'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetDurationMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetDurationMethodInfo a signature where
    overloadedMethod = discovererInfoGetDuration

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


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 1.14/
discovererInfoGetLive ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m Bool
    -- ^ __Returns:__ whether the URI is live.
discovererInfoGetLive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m Bool
discovererInfoGetLive a
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    CInt
result <- Ptr DiscovererInfo -> IO CInt
gst_discoverer_info_get_live Ptr DiscovererInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetLiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetLiveMethodInfo a signature where
    overloadedMethod = discovererInfoGetLive

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


#endif

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

{-# DEPRECATED discovererInfoGetMisc ["This functions is deprecated since version 1.4, use","@/gst_discoverer_info_get_missing_elements_installer_details/@"] #-}
-- | /No description available in the introspection data./
discovererInfoGetMisc ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ Miscellaneous information stored as a t'GI.Gst.Structs.Structure.Structure'
    -- (for example: information about missing plugins). If you wish to use the
    -- t'GI.Gst.Structs.Structure.Structure' after the life-time of /@info@/, you will need to copy it.
discovererInfoGetMisc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m (Maybe Structure)
discovererInfoGetMisc 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr Structure
result <- Ptr DiscovererInfo -> IO (Ptr Structure)
gst_discoverer_info_get_misc Ptr DiscovererInfo
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 DiscovererInfoGetMiscMethodInfo
instance (signature ~ (m (Maybe Gst.Structure.Structure)), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetMiscMethodInfo a signature where
    overloadedMethod = discovererInfoGetMisc

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


#endif

-- method DiscovererInfo::get_missing_elements_installer_details
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GstDiscovererStreamInfo to retrieve installer detail\nfor the missing element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

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

-- | Get the installer details for missing elements
-- 
-- /Since: 1.4/
discovererInfoGetMissingElementsInstallerDetails ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo' to retrieve installer detail
    -- for the missing element
    -> m [T.Text]
    -- ^ __Returns:__ An array of strings
    -- containing information about how to install the various missing elements
    -- for /@info@/ to be usable. If you wish to use the strings after the life-time
    -- of /@info@/, you will need to copy them.
discovererInfoGetMissingElementsInstallerDetails :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m [Text]
discovererInfoGetMissingElementsInstallerDetails 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr CString
result <- Ptr DiscovererInfo -> IO (Ptr CString)
gst_discoverer_info_get_missing_elements_installer_details Ptr DiscovererInfo
info'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererInfoGetMissingElementsInstallerDetails" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr 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 DiscovererInfoGetMissingElementsInstallerDetailsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetMissingElementsInstallerDetailsMethodInfo a signature where
    overloadedMethod = discovererInfoGetMissingElementsInstallerDetails

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


#endif

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

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

-- | /No description available in the introspection data./
discovererInfoGetResult ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m GstPbutils.Enums.DiscovererResult
    -- ^ __Returns:__ the result of the discovery as a t'GI.GstPbutils.Enums.DiscovererResult'.
discovererInfoGetResult :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m DiscovererResult
discovererInfoGetResult a
info = IO DiscovererResult -> m DiscovererResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DiscovererResult -> m DiscovererResult)
-> IO DiscovererResult -> m DiscovererResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    CUInt
result <- Ptr DiscovererInfo -> IO CUInt
gst_discoverer_info_get_result Ptr DiscovererInfo
info'
    let result' :: DiscovererResult
result' = (Int -> DiscovererResult
forall a. Enum a => Int -> a
toEnum (Int -> DiscovererResult)
-> (CUInt -> Int) -> CUInt -> DiscovererResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    DiscovererResult -> IO DiscovererResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiscovererResult
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetResultMethodInfo
instance (signature ~ (m GstPbutils.Enums.DiscovererResult), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetResultMethodInfo a signature where
    overloadedMethod = discovererInfoGetResult

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


#endif

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

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

-- | /No description available in the introspection data./
discovererInfoGetSeekable ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m Bool
    -- ^ __Returns:__ the whether the URI is seekable.
discovererInfoGetSeekable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m Bool
discovererInfoGetSeekable a
info = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    CInt
result <- Ptr DiscovererInfo -> IO CInt
gst_discoverer_info_get_seekable Ptr DiscovererInfo
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetSeekableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetSeekableMethodInfo a signature where
    overloadedMethod = discovererInfoGetSeekable

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


#endif

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

-- | /No description available in the introspection data./
discovererInfoGetStreamInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m (Maybe GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo)
    -- ^ __Returns:__ the structure (or topology) of the URI as a
    -- t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'.
    -- This structure can be traversed to see the original hierarchy. Unref with
    -- @/gst_discoverer_stream_info_unref()/@ after usage.
discovererInfoGetStreamInfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m (Maybe DiscovererStreamInfo)
discovererInfoGetStreamInfo 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr DiscovererStreamInfo
result <- Ptr DiscovererInfo -> IO (Ptr DiscovererStreamInfo)
gst_discoverer_info_get_stream_info Ptr DiscovererInfo
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
GstPbutils.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 DiscovererInfoGetStreamInfoMethodInfo
instance (signature ~ (m (Maybe GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo)), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetStreamInfoMethodInfo a signature where
    overloadedMethod = discovererInfoGetStreamInfo

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


#endif

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

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

-- | /No description available in the introspection data./
discovererInfoGetStreamList ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m [GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo]
    -- ^ __Returns:__ the list of
    -- all streams contained in the @/info/@. Free after usage
    -- with 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoListFree'.
discovererInfoGetStreamList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m [DiscovererStreamInfo]
discovererInfoGetStreamList a
info = IO [DiscovererStreamInfo] -> m [DiscovererStreamInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscovererStreamInfo] -> m [DiscovererStreamInfo])
-> IO [DiscovererStreamInfo] -> m [DiscovererStreamInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr (GList (Ptr DiscovererStreamInfo))
result <- Ptr DiscovererInfo -> IO (Ptr (GList (Ptr DiscovererStreamInfo)))
gst_discoverer_info_get_stream_list Ptr DiscovererInfo
info'
    [Ptr DiscovererStreamInfo]
result' <- Ptr (GList (Ptr DiscovererStreamInfo))
-> IO [Ptr DiscovererStreamInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DiscovererStreamInfo))
result
    [DiscovererStreamInfo]
result'' <- (Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
-> [Ptr DiscovererStreamInfo] -> IO [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 ((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
GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo) [Ptr DiscovererStreamInfo]
result'
    Ptr (GList (Ptr DiscovererStreamInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererStreamInfo))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    [DiscovererStreamInfo] -> IO [DiscovererStreamInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiscovererStreamInfo]
result''

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetStreamListMethodInfo
instance (signature ~ (m [GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetStreamListMethodInfo a signature where
    overloadedMethod = discovererInfoGetStreamList

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


#endif

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

foreign import ccall "gst_discoverer_info_get_streams" gst_discoverer_info_get_streams :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    CGType ->                               -- streamtype : TBasicType TGType
    IO (Ptr (GList (Ptr GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo)))

-- | Finds the t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo' contained in /@info@/ that match the
-- given /@streamtype@/.
discovererInfoGetStreams ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> GType
    -- ^ /@streamtype@/: a t'GType' derived from t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'
    -> m [GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of
    -- matching t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'. The caller should free it with
    -- 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoListFree'.
discovererInfoGetStreams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> GType -> m [DiscovererStreamInfo]
discovererInfoGetStreams a
info GType
streamtype = IO [DiscovererStreamInfo] -> m [DiscovererStreamInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscovererStreamInfo] -> m [DiscovererStreamInfo])
-> IO [DiscovererStreamInfo] -> m [DiscovererStreamInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    let streamtype' :: Word64
streamtype' = GType -> Word64
gtypeToCGType GType
streamtype
    Ptr (GList (Ptr DiscovererStreamInfo))
result <- Ptr DiscovererInfo
-> Word64 -> IO (Ptr (GList (Ptr DiscovererStreamInfo)))
gst_discoverer_info_get_streams Ptr DiscovererInfo
info' Word64
streamtype'
    [Ptr DiscovererStreamInfo]
result' <- Ptr (GList (Ptr DiscovererStreamInfo))
-> IO [Ptr DiscovererStreamInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DiscovererStreamInfo))
result
    [DiscovererStreamInfo]
result'' <- (Ptr DiscovererStreamInfo -> IO DiscovererStreamInfo)
-> [Ptr DiscovererStreamInfo] -> IO [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 ((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
GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo) [Ptr DiscovererStreamInfo]
result'
    Ptr (GList (Ptr DiscovererStreamInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererStreamInfo))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    [DiscovererStreamInfo] -> IO [DiscovererStreamInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiscovererStreamInfo]
result''

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetStreamsMethodInfo
instance (signature ~ (GType -> m [GstPbutils.DiscovererStreamInfo.DiscovererStreamInfo]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetStreamsMethodInfo a signature where
    overloadedMethod = discovererInfoGetStreams

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


#endif

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

foreign import ccall "gst_discoverer_info_get_subtitle_streams" gst_discoverer_info_get_subtitle_streams :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr (GList (Ptr GstPbutils.DiscovererSubtitleInfo.DiscovererSubtitleInfo)))

-- | Finds all the t'GI.GstPbutils.Objects.DiscovererSubtitleInfo.DiscovererSubtitleInfo' contained in /@info@/
discovererInfoGetSubtitleStreams ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m [GstPbutils.DiscovererSubtitleInfo.DiscovererSubtitleInfo]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of
    -- matching t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'. The caller should free it with
    -- 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoListFree'.
discovererInfoGetSubtitleStreams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m [DiscovererSubtitleInfo]
discovererInfoGetSubtitleStreams a
info = IO [DiscovererSubtitleInfo] -> m [DiscovererSubtitleInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscovererSubtitleInfo] -> m [DiscovererSubtitleInfo])
-> IO [DiscovererSubtitleInfo] -> m [DiscovererSubtitleInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr (GList (Ptr DiscovererSubtitleInfo))
result <- Ptr DiscovererInfo -> IO (Ptr (GList (Ptr DiscovererSubtitleInfo)))
gst_discoverer_info_get_subtitle_streams Ptr DiscovererInfo
info'
    [Ptr DiscovererSubtitleInfo]
result' <- Ptr (GList (Ptr DiscovererSubtitleInfo))
-> IO [Ptr DiscovererSubtitleInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DiscovererSubtitleInfo))
result
    [DiscovererSubtitleInfo]
result'' <- (Ptr DiscovererSubtitleInfo -> IO DiscovererSubtitleInfo)
-> [Ptr DiscovererSubtitleInfo] -> IO [DiscovererSubtitleInfo]
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 ((ManagedPtr DiscovererSubtitleInfo -> DiscovererSubtitleInfo)
-> Ptr DiscovererSubtitleInfo -> IO DiscovererSubtitleInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererSubtitleInfo -> DiscovererSubtitleInfo
GstPbutils.DiscovererSubtitleInfo.DiscovererSubtitleInfo) [Ptr DiscovererSubtitleInfo]
result'
    Ptr (GList (Ptr DiscovererSubtitleInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererSubtitleInfo))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    [DiscovererSubtitleInfo] -> IO [DiscovererSubtitleInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiscovererSubtitleInfo]
result''

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetSubtitleStreamsMethodInfo
instance (signature ~ (m [GstPbutils.DiscovererSubtitleInfo.DiscovererSubtitleInfo]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetSubtitleStreamsMethodInfo a signature where
    overloadedMethod = discovererInfoGetSubtitleStreams

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


#endif

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

{-# DEPRECATED discovererInfoGetTags ["(Since version 1.20)","Use gst_discoverer_{container,stream}@/_info_get_tags()/@ instead."] #-}
-- | /No description available in the introspection data./
discovererInfoGetTags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m (Maybe Gst.TagList.TagList)
    -- ^ __Returns:__ all tags contained in the URI. If you wish to use
    -- the tags after the life-time of /@info@/, you will need to copy them.
discovererInfoGetTags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m (Maybe TagList)
discovererInfoGetTags 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr TagList
result <- Ptr DiscovererInfo -> IO (Ptr TagList)
gst_discoverer_info_get_tags Ptr DiscovererInfo
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 DiscovererInfoGetTagsMethodInfo
instance (signature ~ (m (Maybe Gst.TagList.TagList)), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetTagsMethodInfo a signature where
    overloadedMethod = discovererInfoGetTags

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


#endif

-- method DiscovererInfo::get_toc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDiscovererInfo"
--                 , 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_info_get_toc" gst_discoverer_info_get_toc :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr Gst.Toc.Toc)

-- | /No description available in the introspection data./
discovererInfoGetToc ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m (Maybe Gst.Toc.Toc)
    -- ^ __Returns:__ TOC contained in the URI. If you wish to use
    -- the TOC after the life-time of /@info@/, you will need to copy it.
discovererInfoGetToc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m (Maybe Toc)
discovererInfoGetToc 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr Toc
result <- Ptr DiscovererInfo -> IO (Ptr Toc)
gst_discoverer_info_get_toc Ptr DiscovererInfo
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 DiscovererInfoGetTocMethodInfo
instance (signature ~ (m (Maybe Gst.Toc.Toc)), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetTocMethodInfo a signature where
    overloadedMethod = discovererInfoGetToc

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


#endif

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

-- | /No description available in the introspection data./
discovererInfoGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m T.Text
    -- ^ __Returns:__ the URI to which this information corresponds to.
    -- Copy it if you wish to use it after the life-time of /@info@/.
discovererInfoGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m Text
discovererInfoGetUri 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 DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    CString
result <- Ptr DiscovererInfo -> IO CString
gst_discoverer_info_get_uri Ptr DiscovererInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererInfoGetUri" 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 DiscovererInfoGetUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetUriMethodInfo a signature where
    overloadedMethod = discovererInfoGetUri

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


#endif

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

foreign import ccall "gst_discoverer_info_get_video_streams" gst_discoverer_info_get_video_streams :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    IO (Ptr (GList (Ptr GstPbutils.DiscovererVideoInfo.DiscovererVideoInfo)))

-- | Finds all the t'GI.GstPbutils.Objects.DiscovererVideoInfo.DiscovererVideoInfo' contained in /@info@/
discovererInfoGetVideoStreams ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> m [GstPbutils.DiscovererVideoInfo.DiscovererVideoInfo]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of
    -- matching t'GI.GstPbutils.Objects.DiscovererStreamInfo.DiscovererStreamInfo'. The caller should free it with
    -- 'GI.GstPbutils.Objects.DiscovererStreamInfo.discovererStreamInfoListFree'.
discovererInfoGetVideoStreams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> m [DiscovererVideoInfo]
discovererInfoGetVideoStreams a
info = IO [DiscovererVideoInfo] -> m [DiscovererVideoInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DiscovererVideoInfo] -> m [DiscovererVideoInfo])
-> IO [DiscovererVideoInfo] -> m [DiscovererVideoInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    Ptr (GList (Ptr DiscovererVideoInfo))
result <- Ptr DiscovererInfo -> IO (Ptr (GList (Ptr DiscovererVideoInfo)))
gst_discoverer_info_get_video_streams Ptr DiscovererInfo
info'
    [Ptr DiscovererVideoInfo]
result' <- Ptr (GList (Ptr DiscovererVideoInfo))
-> IO [Ptr DiscovererVideoInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr DiscovererVideoInfo))
result
    [DiscovererVideoInfo]
result'' <- (Ptr DiscovererVideoInfo -> IO DiscovererVideoInfo)
-> [Ptr DiscovererVideoInfo] -> IO [DiscovererVideoInfo]
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 ((ManagedPtr DiscovererVideoInfo -> DiscovererVideoInfo)
-> Ptr DiscovererVideoInfo -> IO DiscovererVideoInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererVideoInfo -> DiscovererVideoInfo
GstPbutils.DiscovererVideoInfo.DiscovererVideoInfo) [Ptr DiscovererVideoInfo]
result'
    Ptr (GList (Ptr DiscovererVideoInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr DiscovererVideoInfo))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    [DiscovererVideoInfo] -> IO [DiscovererVideoInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DiscovererVideoInfo]
result''

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoGetVideoStreamsMethodInfo
instance (signature ~ (m [GstPbutils.DiscovererVideoInfo.DiscovererVideoInfo]), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoGetVideoStreamsMethodInfo a signature where
    overloadedMethod = discovererInfoGetVideoStreams

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


#endif

-- method DiscovererInfo::to_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface
--                 Name { namespace = "GstPbutils" , name = "DiscovererInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstDiscovererInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstPbutils" , name = "DiscovererSerializeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A combination of #GstDiscovererSerializeFlags to specify\nwhat needs to be serialized."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "gst_discoverer_info_to_variant" gst_discoverer_info_to_variant :: 
    Ptr DiscovererInfo ->                   -- info : TInterface (Name {namespace = "GstPbutils", name = "DiscovererInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstPbutils", name = "DiscovererSerializeFlags"})
    IO (Ptr GVariant)

-- | Serializes /@info@/ to a t'GVariant' that can be parsed again
-- through 'GI.GstPbutils.Objects.DiscovererInfo.discovererInfoFromVariant'.
-- 
-- Note that any t'GI.Gst.Structs.Toc.Toc' (s) that might have been discovered will not be serialized
-- for now.
-- 
-- /Since: 1.6/
discovererInfoToVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsDiscovererInfo a) =>
    a
    -- ^ /@info@/: A t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'
    -> [GstPbutils.Flags.DiscovererSerializeFlags]
    -- ^ /@flags@/: A combination of t'GI.GstPbutils.Flags.DiscovererSerializeFlags' to specify
    -- what needs to be serialized.
    -> m GVariant
    -- ^ __Returns:__ A newly-allocated t'GVariant' representing /@info@/.
discovererInfoToVariant :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDiscovererInfo a) =>
a -> [DiscovererSerializeFlags] -> m GVariant
discovererInfoToVariant a
info [DiscovererSerializeFlags]
flags = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr DiscovererInfo
info' <- a -> IO (Ptr DiscovererInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
info
    let flags' :: CUInt
flags' = [DiscovererSerializeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DiscovererSerializeFlags]
flags
    Ptr GVariant
result <- Ptr DiscovererInfo -> CUInt -> IO (Ptr GVariant)
gst_discoverer_info_to_variant Ptr DiscovererInfo
info' CUInt
flags'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererInfoToVariant" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
info
    GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data DiscovererInfoToVariantMethodInfo
instance (signature ~ ([GstPbutils.Flags.DiscovererSerializeFlags] -> m GVariant), MonadIO m, IsDiscovererInfo a) => O.OverloadedMethod DiscovererInfoToVariantMethodInfo a signature where
    overloadedMethod = discovererInfoToVariant

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


#endif

-- method DiscovererInfo::from_variant
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "variant"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GVariant to deserialize into a #GstDiscovererInfo."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstPbutils" , name = "DiscovererInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_discoverer_info_from_variant" gst_discoverer_info_from_variant :: 
    Ptr GVariant ->                         -- variant : TVariant
    IO (Ptr DiscovererInfo)

-- | Parses a t'GVariant' as produced by 'GI.GstPbutils.Objects.DiscovererInfo.discovererInfoToVariant'
-- back to a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'.
-- 
-- /Since: 1.6/
discovererInfoFromVariant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GVariant
    -- ^ /@variant@/: A t'GVariant' to deserialize into a t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'.
    -> m DiscovererInfo
    -- ^ __Returns:__ A newly-allocated t'GI.GstPbutils.Objects.DiscovererInfo.DiscovererInfo'.
discovererInfoFromVariant :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GVariant -> m DiscovererInfo
discovererInfoFromVariant GVariant
variant = IO DiscovererInfo -> m DiscovererInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DiscovererInfo -> m DiscovererInfo)
-> IO DiscovererInfo -> m DiscovererInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr GVariant
variant' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
variant
    Ptr DiscovererInfo
result <- Ptr GVariant -> IO (Ptr DiscovererInfo)
gst_discoverer_info_from_variant Ptr GVariant
variant'
    Text -> Ptr DiscovererInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"discovererInfoFromVariant" Ptr DiscovererInfo
result
    DiscovererInfo
result' <- ((ManagedPtr DiscovererInfo -> DiscovererInfo)
-> Ptr DiscovererInfo -> IO DiscovererInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DiscovererInfo -> DiscovererInfo
DiscovererInfo) Ptr DiscovererInfo
result
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
variant
    DiscovererInfo -> IO DiscovererInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DiscovererInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif