{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- These functions allow querying information about registered typefind
-- functions. How to create and register these functions is described in
-- the section \<link linkend=\"gstreamer-Writing-typefind-functions\">
-- \"Writing typefind functions\"\<\/link>.
-- 
-- The following example shows how to write a very simple typefinder that
-- identifies the given data. You can get quite a bit more complicated than
-- that though.
-- 
-- === /C code/
-- >
-- >  typedef struct {
-- >    guint8 *data;
-- >    guint size;
-- >    guint probability;
-- >    GstCaps *data;
-- >  } MyTypeFind;
-- >  static void
-- >  my_peek (gpointer data, gint64 offset, guint size)
-- >  {
-- >    MyTypeFind *find = (MyTypeFind *) data;
-- >    if (offset &gt;= 0 &amp;&amp; offset + size &lt;= find->size) {
-- >      return find->data + offset;
-- >    }
-- >    return NULL;
-- >  }
-- >  static void
-- >  my_suggest (gpointer data, guint probability, GstCaps *caps)
-- >  {
-- >    MyTypeFind *find = (MyTypeFind *) data;
-- >    if (probability &gt; find->probability) {
-- >      find->probability = probability;
-- >      gst_caps_replace (&amp;find->caps, caps);
-- >    }
-- >  }
-- >  static GstCaps *
-- >  find_type (guint8 *data, guint size)
-- >  {
-- >    GList *walk, *type_list;
-- >    MyTypeFind find = {data, size, 0, NULL};
-- >    GstTypeFind gst_find = {my_peek, my_suggest, &amp;find, };
-- >    walk = type_list = gst_type_find_factory_get_list ();
-- >    while (walk) {
-- >      GstTypeFindFactory *factory = GST_TYPE_FIND_FACTORY (walk->data);
-- >      walk = g_list_next (walk)
-- >      gst_type_find_factory_call_function (factory, &amp;gst_find);
-- >    }
-- >    g_list_free (type_list);
-- >    return find.caps;
-- >  };
-- 

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

module GI.Gst.Objects.TypeFindFactory
    ( 

-- * Exported types
    TypeFindFactory(..)                     ,
    IsTypeFindFactory                       ,
    toTypeFindFactory                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTypeFindFactoryMethod            ,
#endif


-- ** callFunction #method:callFunction#

#if defined(ENABLE_OVERLOADING)
    TypeFindFactoryCallFunctionMethodInfo   ,
#endif
    typeFindFactoryCallFunction             ,


-- ** getCaps #method:getCaps#

#if defined(ENABLE_OVERLOADING)
    TypeFindFactoryGetCapsMethodInfo        ,
#endif
    typeFindFactoryGetCaps                  ,


-- ** getExtensions #method:getExtensions#

#if defined(ENABLE_OVERLOADING)
    TypeFindFactoryGetExtensionsMethodInfo  ,
#endif
    typeFindFactoryGetExtensions            ,


-- ** getList #method:getList#

    typeFindFactoryGetList                  ,


-- ** hasFunction #method:hasFunction#

#if defined(ENABLE_OVERLOADING)
    TypeFindFactoryHasFunctionMethodInfo    ,
#endif
    typeFindFactoryHasFunction              ,




    ) where

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

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

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

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

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

foreign import ccall "gst_type_find_factory_get_type"
    c_gst_type_find_factory_get_type :: IO B.Types.GType

instance B.Types.TypedObject TypeFindFactory where
    glibType :: IO GType
glibType = IO GType
c_gst_type_find_factory_get_type

instance B.Types.GObject TypeFindFactory

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTypeFindFactoryMethod (t :: Symbol) (o :: *) :: * where
    ResolveTypeFindFactoryMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveTypeFindFactoryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTypeFindFactoryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTypeFindFactoryMethod "callFunction" o = TypeFindFactoryCallFunctionMethodInfo
    ResolveTypeFindFactoryMethod "checkVersion" o = Gst.PluginFeature.PluginFeatureCheckVersionMethodInfo
    ResolveTypeFindFactoryMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveTypeFindFactoryMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTypeFindFactoryMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTypeFindFactoryMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTypeFindFactoryMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveTypeFindFactoryMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveTypeFindFactoryMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveTypeFindFactoryMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveTypeFindFactoryMethod "hasFunction" o = TypeFindFactoryHasFunctionMethodInfo
    ResolveTypeFindFactoryMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTypeFindFactoryMethod "load" o = Gst.PluginFeature.PluginFeatureLoadMethodInfo
    ResolveTypeFindFactoryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTypeFindFactoryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTypeFindFactoryMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveTypeFindFactoryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTypeFindFactoryMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveTypeFindFactoryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTypeFindFactoryMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTypeFindFactoryMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTypeFindFactoryMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveTypeFindFactoryMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveTypeFindFactoryMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTypeFindFactoryMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveTypeFindFactoryMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveTypeFindFactoryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTypeFindFactoryMethod "getCaps" o = TypeFindFactoryGetCapsMethodInfo
    ResolveTypeFindFactoryMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveTypeFindFactoryMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveTypeFindFactoryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTypeFindFactoryMethod "getExtensions" o = TypeFindFactoryGetExtensionsMethodInfo
    ResolveTypeFindFactoryMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveTypeFindFactoryMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveTypeFindFactoryMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveTypeFindFactoryMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveTypeFindFactoryMethod "getPlugin" o = Gst.PluginFeature.PluginFeatureGetPluginMethodInfo
    ResolveTypeFindFactoryMethod "getPluginName" o = Gst.PluginFeature.PluginFeatureGetPluginNameMethodInfo
    ResolveTypeFindFactoryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTypeFindFactoryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTypeFindFactoryMethod "getRank" o = Gst.PluginFeature.PluginFeatureGetRankMethodInfo
    ResolveTypeFindFactoryMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveTypeFindFactoryMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveTypeFindFactoryMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveTypeFindFactoryMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveTypeFindFactoryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTypeFindFactoryMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTypeFindFactoryMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveTypeFindFactoryMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveTypeFindFactoryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTypeFindFactoryMethod "setRank" o = Gst.PluginFeature.PluginFeatureSetRankMethodInfo
    ResolveTypeFindFactoryMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TypeFindFactory
type instance O.AttributeList TypeFindFactory = TypeFindFactoryAttributeList
type TypeFindFactoryAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method TypeFindFactory::call_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TypeFindFactory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTypeFindFactory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "find"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TypeFind" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a properly setup #GstTypeFind entry. The get_data\n    and suggest_type members must be set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_type_find_factory_call_function" gst_type_find_factory_call_function :: 
    Ptr TypeFindFactory ->                  -- factory : TInterface (Name {namespace = "Gst", name = "TypeFindFactory"})
    Ptr Gst.TypeFind.TypeFind ->            -- find : TInterface (Name {namespace = "Gst", name = "TypeFind"})
    IO ()

-- | Calls the t'GI.Gst.Callbacks.TypeFindFunction' associated with this factory.
typeFindFactoryCallFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsTypeFindFactory a) =>
    a
    -- ^ /@factory@/: A t'GI.Gst.Objects.TypeFindFactory.TypeFindFactory'
    -> Gst.TypeFind.TypeFind
    -- ^ /@find@/: a properly setup t'GI.Gst.Structs.TypeFind.TypeFind' entry. The get_data
    --     and suggest_type members must be set.
    -> m ()
typeFindFactoryCallFunction :: a -> TypeFind -> m ()
typeFindFactoryCallFunction a
factory TypeFind
find = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeFindFactory
factory' <- a -> IO (Ptr TypeFindFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    Ptr TypeFind
find' <- TypeFind -> IO (Ptr TypeFind)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeFind
find
    Ptr TypeFindFactory -> Ptr TypeFind -> IO ()
gst_type_find_factory_call_function Ptr TypeFindFactory
factory' Ptr TypeFind
find'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    TypeFind -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeFind
find
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TypeFindFactoryCallFunctionMethodInfo
instance (signature ~ (Gst.TypeFind.TypeFind -> m ()), MonadIO m, IsTypeFindFactory a) => O.MethodInfo TypeFindFactoryCallFunctionMethodInfo a signature where
    overloadedMethod = typeFindFactoryCallFunction

#endif

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

foreign import ccall "gst_type_find_factory_get_caps" gst_type_find_factory_get_caps :: 
    Ptr TypeFindFactory ->                  -- factory : TInterface (Name {namespace = "Gst", name = "TypeFindFactory"})
    IO (Ptr Gst.Caps.Caps)

-- | Gets the t'GI.Gst.Structs.Caps.Caps' associated with a typefind factory.
typeFindFactoryGetCaps ::
    (B.CallStack.HasCallStack, MonadIO m, IsTypeFindFactory a) =>
    a
    -- ^ /@factory@/: A t'GI.Gst.Objects.TypeFindFactory.TypeFindFactory'
    -> m Gst.Caps.Caps
    -- ^ __Returns:__ the t'GI.Gst.Structs.Caps.Caps' associated with this factory
typeFindFactoryGetCaps :: a -> m Caps
typeFindFactoryGetCaps a
factory = IO Caps -> m Caps
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Caps -> m Caps) -> IO Caps -> m Caps
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeFindFactory
factory' <- a -> IO (Ptr TypeFindFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    Ptr Caps
result <- Ptr TypeFindFactory -> IO (Ptr Caps)
gst_type_find_factory_get_caps Ptr TypeFindFactory
factory'
    Text -> Ptr Caps -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"typeFindFactoryGetCaps" Ptr Caps
result
    Caps
result' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result'

#if defined(ENABLE_OVERLOADING)
data TypeFindFactoryGetCapsMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m, IsTypeFindFactory a) => O.MethodInfo TypeFindFactoryGetCapsMethodInfo a signature where
    overloadedMethod = typeFindFactoryGetCaps

#endif

-- method TypeFindFactory::get_extensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TypeFindFactory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTypeFindFactory"
--                 , 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_type_find_factory_get_extensions" gst_type_find_factory_get_extensions :: 
    Ptr TypeFindFactory ->                  -- factory : TInterface (Name {namespace = "Gst", name = "TypeFindFactory"})
    IO (Ptr CString)

-- | Gets the extensions associated with a t'GI.Gst.Objects.TypeFindFactory.TypeFindFactory'. The returned
-- array should not be changed. If you need to change stuff in it, you should
-- copy it using @/g_strdupv()/@.  This function may return 'P.Nothing' to indicate
-- a 0-length list.
typeFindFactoryGetExtensions ::
    (B.CallStack.HasCallStack, MonadIO m, IsTypeFindFactory a) =>
    a
    -- ^ /@factory@/: A t'GI.Gst.Objects.TypeFindFactory.TypeFindFactory'
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ 
    --     a 'P.Nothing'-terminated array of extensions associated with this factory
typeFindFactoryGetExtensions :: a -> m (Maybe [Text])
typeFindFactoryGetExtensions a
factory = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeFindFactory
factory' <- a -> IO (Ptr TypeFindFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    Ptr CString
result <- Ptr TypeFindFactory -> IO (Ptr CString)
gst_type_find_factory_get_extensions Ptr TypeFindFactory
factory'
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

#if defined(ENABLE_OVERLOADING)
data TypeFindFactoryGetExtensionsMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsTypeFindFactory a) => O.MethodInfo TypeFindFactoryGetExtensionsMethodInfo a signature where
    overloadedMethod = typeFindFactoryGetExtensions

#endif

-- method TypeFindFactory::has_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "TypeFindFactory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstTypeFindFactory"
--                 , 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_type_find_factory_has_function" gst_type_find_factory_has_function :: 
    Ptr TypeFindFactory ->                  -- factory : TInterface (Name {namespace = "Gst", name = "TypeFindFactory"})
    IO CInt

-- | Check whether the factory has a typefind function. Typefind factories
-- without typefind functions are a last-effort fallback mechanism to
-- e.g. assume a certain media type based on the file extension.
typeFindFactoryHasFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsTypeFindFactory a) =>
    a
    -- ^ /@factory@/: A t'GI.Gst.Objects.TypeFindFactory.TypeFindFactory'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the factory has a typefind functions set, otherwise 'P.False'
typeFindFactoryHasFunction :: a -> m Bool
typeFindFactoryHasFunction a
factory = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeFindFactory
factory' <- a -> IO (Ptr TypeFindFactory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    CInt
result <- Ptr TypeFindFactory -> IO CInt
gst_type_find_factory_has_function Ptr TypeFindFactory
factory'
    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
factory
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TypeFindFactoryHasFunctionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTypeFindFactory a) => O.MethodInfo TypeFindFactoryHasFunctionMethodInfo a signature where
    overloadedMethod = typeFindFactoryHasFunction

#endif

-- method TypeFindFactory::get_list
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gst" , name = "TypeFindFactory" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_type_find_factory_get_list" gst_type_find_factory_get_list :: 
    IO (Ptr (GList (Ptr TypeFindFactory)))

-- | Gets the list of all registered typefind factories. You must free the
-- list using 'GI.Gst.Objects.PluginFeature.pluginFeatureListFree'.
-- 
-- The returned factories are sorted by highest rank first, and then by
-- factory name.
-- 
-- Free-function: gst_plugin_feature_list_free
typeFindFactoryGetList ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [TypeFindFactory]
    -- ^ __Returns:__ the list of all
    --     registered t'GI.Gst.Objects.TypeFindFactory.TypeFindFactory'.
typeFindFactoryGetList :: m [TypeFindFactory]
typeFindFactoryGetList  = IO [TypeFindFactory] -> m [TypeFindFactory]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TypeFindFactory] -> m [TypeFindFactory])
-> IO [TypeFindFactory] -> m [TypeFindFactory]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GList (Ptr TypeFindFactory))
result <- IO (Ptr (GList (Ptr TypeFindFactory)))
gst_type_find_factory_get_list
    [Ptr TypeFindFactory]
result' <- Ptr (GList (Ptr TypeFindFactory)) -> IO [Ptr TypeFindFactory]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TypeFindFactory))
result
    [TypeFindFactory]
result'' <- (Ptr TypeFindFactory -> IO TypeFindFactory)
-> [Ptr TypeFindFactory] -> IO [TypeFindFactory]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr TypeFindFactory -> TypeFindFactory)
-> Ptr TypeFindFactory -> IO TypeFindFactory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TypeFindFactory -> TypeFindFactory
TypeFindFactory) [Ptr TypeFindFactory]
result'
    Ptr (GList (Ptr TypeFindFactory)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TypeFindFactory))
result
    [TypeFindFactory] -> IO [TypeFindFactory]
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeFindFactory]
result''

#if defined(ENABLE_OVERLOADING)
#endif