{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GStreamer is extensible, so t'GI.Gst.Objects.Element.Element' instances can be loaded at runtime.
-- A plugin system can provide one or more of the basic GStreamer
-- t'GI.Gst.Objects.PluginFeature.PluginFeature' subclasses.
-- 
-- A plugin should export a symbol @gst_plugin_desc@ that is a
-- struct of type t'GI.Gst.Structs.PluginDesc.PluginDesc'.
-- the plugin loader will check the version of the core library the plugin was
-- linked against and will create a new t'GI.Gst.Objects.Plugin.Plugin'. It will then call the
-- t'GI.Gst.Callbacks.PluginInitFunc' function that was provided in the
-- @gst_plugin_desc@.
-- 
-- Once you have a handle to a t'GI.Gst.Objects.Plugin.Plugin' (e.g. from the t'GI.Gst.Objects.Registry.Registry'), you
-- can add any object that subclasses t'GI.Gst.Objects.PluginFeature.PluginFeature'.
-- 
-- Usually plugins are always automatically loaded so you don\'t need to call
-- 'GI.Gst.Objects.Plugin.pluginLoad' explicitly to bring it into memory. There are options to
-- statically link plugins to an app or even use GStreamer without a plugin
-- repository in which case 'GI.Gst.Objects.Plugin.pluginLoad' can be needed to bring the plugin
-- into memory.

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

module GI.Gst.Objects.Plugin
    ( 

-- * Exported types
    Plugin(..)                              ,
    IsPlugin                                ,
    toPlugin                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [addDependency]("GI.Gst.Objects.Plugin#g:method:addDependency"), [addDependencySimple]("GI.Gst.Objects.Plugin#g:method:addDependencySimple"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLoaded]("GI.Gst.Objects.Plugin#g:method:isLoaded"), [load]("GI.Gst.Objects.Plugin#g:method:load"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCacheData]("GI.Gst.Objects.Plugin#g:method:getCacheData"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.Gst.Objects.Plugin#g:method:getDescription"), [getFilename]("GI.Gst.Objects.Plugin#g:method:getFilename"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getLicense]("GI.Gst.Objects.Plugin#g:method:getLicense"), [getName]("GI.Gst.Objects.Plugin#g:method:getName"), [getOrigin]("GI.Gst.Objects.Plugin#g:method:getOrigin"), [getPackage]("GI.Gst.Objects.Plugin#g:method:getPackage"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getReleaseDateString]("GI.Gst.Objects.Plugin#g:method:getReleaseDateString"), [getSource]("GI.Gst.Objects.Plugin#g:method:getSource"), [getValue]("GI.Gst.Objects.Object#g:method:getValue"), [getVersion]("GI.Gst.Objects.Plugin#g:method:getVersion").
-- 
-- ==== Setters
-- [setCacheData]("GI.Gst.Objects.Plugin#g:method:setCacheData"), [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePluginMethod                     ,
#endif

-- ** addDependency #method:addDependency#

#if defined(ENABLE_OVERLOADING)
    PluginAddDependencyMethodInfo           ,
#endif
    pluginAddDependency                     ,


-- ** addDependencySimple #method:addDependencySimple#

#if defined(ENABLE_OVERLOADING)
    PluginAddDependencySimpleMethodInfo     ,
#endif
    pluginAddDependencySimple               ,


-- ** getCacheData #method:getCacheData#

#if defined(ENABLE_OVERLOADING)
    PluginGetCacheDataMethodInfo            ,
#endif
    pluginGetCacheData                      ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    PluginGetDescriptionMethodInfo          ,
#endif
    pluginGetDescription                    ,


-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    PluginGetFilenameMethodInfo             ,
#endif
    pluginGetFilename                       ,


-- ** getLicense #method:getLicense#

#if defined(ENABLE_OVERLOADING)
    PluginGetLicenseMethodInfo              ,
#endif
    pluginGetLicense                        ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    PluginGetNameMethodInfo                 ,
#endif
    pluginGetName                           ,


-- ** getOrigin #method:getOrigin#

#if defined(ENABLE_OVERLOADING)
    PluginGetOriginMethodInfo               ,
#endif
    pluginGetOrigin                         ,


-- ** getPackage #method:getPackage#

#if defined(ENABLE_OVERLOADING)
    PluginGetPackageMethodInfo              ,
#endif
    pluginGetPackage                        ,


-- ** getReleaseDateString #method:getReleaseDateString#

#if defined(ENABLE_OVERLOADING)
    PluginGetReleaseDateStringMethodInfo    ,
#endif
    pluginGetReleaseDateString              ,


-- ** getSource #method:getSource#

#if defined(ENABLE_OVERLOADING)
    PluginGetSourceMethodInfo               ,
#endif
    pluginGetSource                         ,


-- ** getVersion #method:getVersion#

#if defined(ENABLE_OVERLOADING)
    PluginGetVersionMethodInfo              ,
#endif
    pluginGetVersion                        ,


-- ** isLoaded #method:isLoaded#

#if defined(ENABLE_OVERLOADING)
    PluginIsLoadedMethodInfo                ,
#endif
    pluginIsLoaded                          ,


-- ** listFree #method:listFree#

    pluginListFree                          ,


-- ** load #method:load#

#if defined(ENABLE_OVERLOADING)
    PluginLoadMethodInfo                    ,
#endif
    pluginLoad                              ,


-- ** loadByName #method:loadByName#

    pluginLoadByName                        ,


-- ** loadFile #method:loadFile#

    pluginLoadFile                          ,


-- ** registerStatic #method:registerStatic#

    pluginRegisterStatic                    ,


-- ** registerStaticFull #method:registerStaticFull#

    pluginRegisterStaticFull                ,


-- ** setCacheData #method:setCacheData#

#if defined(ENABLE_OVERLOADING)
    PluginSetCacheDataMethodInfo            ,
#endif
    pluginSetCacheData                      ,




    ) 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.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 GHC.Records as R

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

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

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

foreign import ccall "gst_plugin_get_type"
    c_gst_plugin_get_type :: IO B.Types.GType

instance B.Types.TypedObject Plugin where
    glibType :: IO GType
glibType = IO GType
c_gst_plugin_get_type

instance B.Types.GObject Plugin

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePluginMethod (t :: Symbol) (o :: *) :: * where
    ResolvePluginMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolvePluginMethod "addDependency" o = PluginAddDependencyMethodInfo
    ResolvePluginMethod "addDependencySimple" o = PluginAddDependencySimpleMethodInfo
    ResolvePluginMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePluginMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePluginMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolvePluginMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePluginMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePluginMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePluginMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolvePluginMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolvePluginMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolvePluginMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolvePluginMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePluginMethod "isLoaded" o = PluginIsLoadedMethodInfo
    ResolvePluginMethod "load" o = PluginLoadMethodInfo
    ResolvePluginMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePluginMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePluginMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolvePluginMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePluginMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolvePluginMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePluginMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePluginMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePluginMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolvePluginMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolvePluginMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePluginMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolvePluginMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolvePluginMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePluginMethod "getCacheData" o = PluginGetCacheDataMethodInfo
    ResolvePluginMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolvePluginMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolvePluginMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePluginMethod "getDescription" o = PluginGetDescriptionMethodInfo
    ResolvePluginMethod "getFilename" o = PluginGetFilenameMethodInfo
    ResolvePluginMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolvePluginMethod "getLicense" o = PluginGetLicenseMethodInfo
    ResolvePluginMethod "getName" o = PluginGetNameMethodInfo
    ResolvePluginMethod "getOrigin" o = PluginGetOriginMethodInfo
    ResolvePluginMethod "getPackage" o = PluginGetPackageMethodInfo
    ResolvePluginMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolvePluginMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolvePluginMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePluginMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePluginMethod "getReleaseDateString" o = PluginGetReleaseDateStringMethodInfo
    ResolvePluginMethod "getSource" o = PluginGetSourceMethodInfo
    ResolvePluginMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolvePluginMethod "getVersion" o = PluginGetVersionMethodInfo
    ResolvePluginMethod "setCacheData" o = PluginSetCacheDataMethodInfo
    ResolvePluginMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolvePluginMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolvePluginMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolvePluginMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePluginMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePluginMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolvePluginMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolvePluginMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePluginMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Plugin::add_dependency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstPlugin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "env_vars"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%NULL-terminated array of environment variables affecting the\n    feature set of the plugin (e.g. an environment variable containing\n    paths where to look for additional modules/plugins of a library),\n    or %NULL. Environment variable names may be followed by a path component\n     which will be added to the content of the environment variable, e.g.\n     \"HOME/.mystuff/plugins\"."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paths"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%NULL-terminated array of directories/paths where dependent files\n    may be, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "names"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%NULL-terminated array of file names (or file name suffixes,\n    depending on @flags) to be used in combination with the paths from\n    @paths and/or the paths extracted from the environment variables in\n    @env_vars, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PluginDependencyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional flags, or #GST_PLUGIN_DEPENDENCY_FLAG_NONE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_plugin_add_dependency" gst_plugin_add_dependency :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    Ptr CString ->                          -- env_vars : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr CString ->                          -- paths : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr CString ->                          -- names : TCArray True (-1) (-1) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "PluginDependencyFlags"})
    IO ()

-- | Make GStreamer aware of external dependencies which affect the feature
-- set of this plugin (ie. the elements or typefinders associated with it).
-- 
-- GStreamer will re-inspect plugins with external dependencies whenever any
-- of the external dependencies change. This is useful for plugins which wrap
-- other plugin systems, e.g. a plugin which wraps a plugin-based visualisation
-- library and makes visualisations available as GStreamer elements, or a
-- codec loader which exposes elements and\/or caps dependent on what external
-- codec libraries are currently installed.
pluginAddDependency ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: a t'GI.Gst.Objects.Plugin.Plugin'
    -> Maybe ([T.Text])
    -- ^ /@envVars@/: 'P.Nothing'-terminated array of environment variables affecting the
    --     feature set of the plugin (e.g. an environment variable containing
    --     paths where to look for additional modules\/plugins of a library),
    --     or 'P.Nothing'. Environment variable names may be followed by a path component
    --      which will be added to the content of the environment variable, e.g.
    --      \"HOME\/.mystuff\/plugins\".
    -> Maybe ([T.Text])
    -- ^ /@paths@/: 'P.Nothing'-terminated array of directories\/paths where dependent files
    --     may be, or 'P.Nothing'.
    -> Maybe ([T.Text])
    -- ^ /@names@/: 'P.Nothing'-terminated array of file names (or file name suffixes,
    --     depending on /@flags@/) to be used in combination with the paths from
    --     /@paths@/ and\/or the paths extracted from the environment variables in
    --     /@envVars@/, or 'P.Nothing'.
    -> [Gst.Flags.PluginDependencyFlags]
    -- ^ /@flags@/: optional flags, or @/GST_PLUGIN_DEPENDENCY_FLAG_NONE/@
    -> m ()
pluginAddDependency :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> [PluginDependencyFlags]
-> m ()
pluginAddDependency a
plugin Maybe [Text]
envVars Maybe [Text]
paths Maybe [Text]
names [PluginDependencyFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr CString
maybeEnvVars <- case Maybe [Text]
envVars of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jEnvVars -> do
            Ptr CString
jEnvVars' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jEnvVars
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jEnvVars'
    Ptr CString
maybePaths <- case Maybe [Text]
paths of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jPaths -> do
            Ptr CString
jPaths' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jPaths
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jPaths'
    Ptr CString
maybeNames <- case Maybe [Text]
names of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jNames -> do
            Ptr CString
jNames' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jNames
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jNames'
    let flags' :: CUInt
flags' = [PluginDependencyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PluginDependencyFlags]
flags
    Ptr Plugin
-> Ptr CString -> Ptr CString -> Ptr CString -> CUInt -> IO ()
gst_plugin_add_dependency Ptr Plugin
plugin' Ptr CString
maybeEnvVars Ptr CString
maybePaths Ptr CString
maybeNames CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeEnvVars
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeEnvVars
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybePaths
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybePaths
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeNames
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeNames
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PluginAddDependencyMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> Maybe ([T.Text]) -> Maybe ([T.Text]) -> [Gst.Flags.PluginDependencyFlags] -> m ()), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginAddDependencyMethodInfo a signature where
    overloadedMethod = pluginAddDependency

instance O.OverloadedMethodInfo PluginAddDependencyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginAddDependency",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginAddDependency"
        }


#endif

-- method Plugin::add_dependency_simple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstPlugin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "env_vars"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "one or more environment variables (separated by ':', ';' or ','),\n     or %NULL. Environment variable names may be followed by a path component\n     which will be added to the content of the environment variable, e.g.\n     \"HOME/.mystuff/plugins:MYSTUFF_PLUGINS_PATH\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paths"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "one ore more directory paths (separated by ':' or ';' or ','),\n     or %NULL. Example: \"/usr/lib/mystuff/plugins\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "names"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "one or more file names or file name suffixes (separated by commas),\n     or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gst" , name = "PluginDependencyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional flags, or #GST_PLUGIN_DEPENDENCY_FLAG_NONE"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_plugin_add_dependency_simple" gst_plugin_add_dependency_simple :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    CString ->                              -- env_vars : TBasicType TUTF8
    CString ->                              -- paths : TBasicType TUTF8
    CString ->                              -- names : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "PluginDependencyFlags"})
    IO ()

-- | Make GStreamer aware of external dependencies which affect the feature
-- set of this plugin (ie. the elements or typefinders associated with it).
-- 
-- GStreamer will re-inspect plugins with external dependencies whenever any
-- of the external dependencies change. This is useful for plugins which wrap
-- other plugin systems, e.g. a plugin which wraps a plugin-based visualisation
-- library and makes visualisations available as GStreamer elements, or a
-- codec loader which exposes elements and\/or caps dependent on what external
-- codec libraries are currently installed.
-- 
-- Convenience wrapper function for 'GI.Gst.Objects.Plugin.pluginAddDependency' which
-- takes simple strings as arguments instead of string arrays, with multiple
-- arguments separated by predefined delimiters (see above).
pluginAddDependencySimple ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: the t'GI.Gst.Objects.Plugin.Plugin'
    -> Maybe (T.Text)
    -- ^ /@envVars@/: one or more environment variables (separated by \':\', \';\' or \',\'),
    --      or 'P.Nothing'. Environment variable names may be followed by a path component
    --      which will be added to the content of the environment variable, e.g.
    --      \"HOME\/.mystuff\/plugins:MYSTUFF_PLUGINS_PATH\"
    -> Maybe (T.Text)
    -- ^ /@paths@/: one ore more directory paths (separated by \':\' or \';\' or \',\'),
    --      or 'P.Nothing'. Example: \"\/usr\/lib\/mystuff\/plugins\"
    -> Maybe (T.Text)
    -- ^ /@names@/: one or more file names or file name suffixes (separated by commas),
    --      or 'P.Nothing'
    -> [Gst.Flags.PluginDependencyFlags]
    -- ^ /@flags@/: optional flags, or @/GST_PLUGIN_DEPENDENCY_FLAG_NONE/@
    -> m ()
pluginAddDependencySimple :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [PluginDependencyFlags]
-> m ()
pluginAddDependencySimple a
plugin Maybe Text
envVars Maybe Text
paths Maybe Text
names [PluginDependencyFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
maybeEnvVars <- case Maybe Text
envVars of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEnvVars -> do
            CString
jEnvVars' <- Text -> IO CString
textToCString Text
jEnvVars
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEnvVars'
    CString
maybePaths <- case Maybe Text
paths of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPaths -> do
            CString
jPaths' <- Text -> IO CString
textToCString Text
jPaths
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPaths'
    CString
maybeNames <- case Maybe Text
names of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jNames -> do
            CString
jNames' <- Text -> IO CString
textToCString Text
jNames
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jNames'
    let flags' :: CUInt
flags' = [PluginDependencyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PluginDependencyFlags]
flags
    Ptr Plugin -> CString -> CString -> CString -> CUInt -> IO ()
gst_plugin_add_dependency_simple Ptr Plugin
plugin' CString
maybeEnvVars CString
maybePaths CString
maybeNames CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEnvVars
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePaths
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeNames
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PluginAddDependencySimpleMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> [Gst.Flags.PluginDependencyFlags] -> m ()), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginAddDependencySimpleMethodInfo a signature where
    overloadedMethod = pluginAddDependencySimple

instance O.OverloadedMethodInfo PluginAddDependencySimpleMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginAddDependencySimple",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginAddDependencySimple"
        }


#endif

-- method Plugin::get_cache_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a plugin" , 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_plugin_get_cache_data" gst_plugin_get_cache_data :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO (Ptr Gst.Structure.Structure)

-- | Gets the plugin specific data cache. If it is 'P.Nothing' there is no cached data
-- stored. This is the case when the registry is getting rebuilt.
pluginGetCacheData ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: a plugin
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ The cached data as a
    -- t'GI.Gst.Structs.Structure.Structure' or 'P.Nothing'.
pluginGetCacheData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m (Maybe Structure)
pluginGetCacheData a
plugin = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr Structure
result <- Ptr Plugin -> IO (Ptr Structure)
gst_plugin_get_cache_data Ptr Plugin
plugin'
    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 (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

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

instance O.OverloadedMethodInfo PluginGetCacheDataMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetCacheData",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetCacheData"
        }


#endif

-- method Plugin::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get long name of"
--                 , 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_plugin_get_description" gst_plugin_get_description :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | Get the long descriptive name of the plugin
pluginGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get long name of
    -> m T.Text
    -- ^ __Returns:__ the long name of the plugin
pluginGetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetDescription a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_description Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetDescriptionMethodInfo a signature where
    overloadedMethod = pluginGetDescription

instance O.OverloadedMethodInfo PluginGetDescriptionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetDescription",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetDescription"
        }


#endif

-- method Plugin::get_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the filename of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "gst_plugin_get_filename" gst_plugin_get_filename :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | get the filename of the plugin
pluginGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the filename of
    -> m (Maybe [Char])
    -- ^ __Returns:__ the filename of the plugin
pluginGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m (Maybe [Char])
pluginGetFilename a
plugin = IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_filename Ptr Plugin
plugin'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data PluginGetFilenameMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetFilenameMethodInfo a signature where
    overloadedMethod = pluginGetFilename

instance O.OverloadedMethodInfo PluginGetFilenameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetFilename",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetFilename"
        }


#endif

-- method Plugin::get_license
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the license of"
--                 , 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_plugin_get_license" gst_plugin_get_license :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | get the license of the plugin
pluginGetLicense ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the license of
    -> m T.Text
    -- ^ __Returns:__ the license of the plugin
pluginGetLicense :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetLicense a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_license Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetLicense" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetLicenseMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetLicenseMethodInfo a signature where
    overloadedMethod = pluginGetLicense

instance O.OverloadedMethodInfo PluginGetLicenseMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetLicense",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetLicense"
        }


#endif

-- method Plugin::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the name of"
--                 , 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_plugin_get_name" gst_plugin_get_name :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | Get the short name of the plugin
pluginGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the name of
    -> m T.Text
    -- ^ __Returns:__ the name of the plugin
pluginGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetName a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_name Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetNameMethodInfo a signature where
    overloadedMethod = pluginGetName

instance O.OverloadedMethodInfo PluginGetNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetName"
        }


#endif

-- method Plugin::get_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the origin of"
--                 , 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_plugin_get_origin" gst_plugin_get_origin :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | get the URL where the plugin comes from
pluginGetOrigin ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the origin of
    -> m T.Text
    -- ^ __Returns:__ the origin of the plugin
pluginGetOrigin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetOrigin a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_origin Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetOrigin" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetOriginMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetOriginMethodInfo a signature where
    overloadedMethod = pluginGetOrigin

instance O.OverloadedMethodInfo PluginGetOriginMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetOrigin",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetOrigin"
        }


#endif

-- method Plugin::get_package
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the package of"
--                 , 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_plugin_get_package" gst_plugin_get_package :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | get the package the plugin belongs to.
pluginGetPackage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the package of
    -> m T.Text
    -- ^ __Returns:__ the package of the plugin
pluginGetPackage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetPackage a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_package Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetPackage" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetPackageMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetPackageMethodInfo a signature where
    overloadedMethod = pluginGetPackage

instance O.OverloadedMethodInfo PluginGetPackageMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetPackage",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetPackage"
        }


#endif

-- method Plugin::get_release_date_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the release date of"
--                 , 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_plugin_get_release_date_string" gst_plugin_get_release_date_string :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | Get the release date (and possibly time) in form of a string, if available.
-- 
-- For normal GStreamer plugin releases this will usually just be a date in
-- the form of \"YYYY-MM-DD\", while pre-releases and builds from git may contain
-- a time component after the date as well, in which case the string will be
-- formatted like \"YYYY-MM-DDTHH:MMZ\" (e.g. \"2012-04-30T09:30Z\").
-- 
-- There may be plugins that do not have a valid release date set on them.
pluginGetReleaseDateString ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the release date of
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the date string of the plugin, or 'P.Nothing' if not
    -- available.
pluginGetReleaseDateString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m (Maybe Text)
pluginGetReleaseDateString a
plugin = 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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_release_date_string Ptr Plugin
plugin'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText 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
plugin
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data PluginGetReleaseDateStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetReleaseDateStringMethodInfo a signature where
    overloadedMethod = pluginGetReleaseDateString

instance O.OverloadedMethodInfo PluginGetReleaseDateStringMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetReleaseDateString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetReleaseDateString"
        }


#endif

-- method Plugin::get_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the source of"
--                 , 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_plugin_get_source" gst_plugin_get_source :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | get the source module the plugin belongs to.
pluginGetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the source of
    -> m T.Text
    -- ^ __Returns:__ the source of the plugin
pluginGetSource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetSource a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_source Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetSource" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetSourceMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetSourceMethodInfo a signature where
    overloadedMethod = pluginGetSource

instance O.OverloadedMethodInfo PluginGetSourceMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetSource",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetSource"
        }


#endif

-- method Plugin::get_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to get the version of"
--                 , 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_plugin_get_version" gst_plugin_get_version :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CString

-- | get the version of the plugin
pluginGetVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to get the version of
    -> m T.Text
    -- ^ __Returns:__ the version of the plugin
pluginGetVersion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Text
pluginGetVersion a
plugin = IO Text -> m Text
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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
result <- Ptr Plugin -> IO CString
gst_plugin_get_version Ptr Plugin
plugin'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginGetVersion" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PluginGetVersionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginGetVersionMethodInfo a signature where
    overloadedMethod = pluginGetVersion

instance O.OverloadedMethodInfo PluginGetVersionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginGetVersion",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginGetVersion"
        }


#endif

-- method Plugin::is_loaded
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin to query" , 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_plugin_is_loaded" gst_plugin_is_loaded :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO CInt

-- | queries if the plugin is loaded into memory
pluginIsLoaded ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to query
    -> m Bool
    -- ^ __Returns:__ 'P.True' is loaded, 'P.False' otherwise
pluginIsLoaded :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m Bool
pluginIsLoaded a
plugin = 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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CInt
result <- Ptr Plugin -> IO CInt
gst_plugin_is_loaded Ptr Plugin
plugin'
    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
plugin
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PluginIsLoadedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginIsLoadedMethodInfo a signature where
    overloadedMethod = pluginIsLoaded

instance O.OverloadedMethodInfo PluginIsLoadedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginIsLoaded",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginIsLoaded"
        }


#endif

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

foreign import ccall "gst_plugin_load" gst_plugin_load :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    IO (Ptr Plugin)

-- | Loads /@plugin@/. Note that the *return value* is the loaded plugin; /@plugin@/ is
-- untouched. The normal use pattern of this function goes like this:
-- 
-- >
-- >GstPlugin *loaded_plugin;
-- >loaded_plugin = gst_plugin_load (plugin);
-- >// presumably, we're no longer interested in the potentially-unloaded plugin
-- >gst_object_unref (plugin);
-- >plugin = loaded_plugin;
pluginLoad ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: plugin to load
    -> m (Maybe Plugin)
    -- ^ __Returns:__ a reference to a loaded plugin, or
    -- 'P.Nothing' on error.
pluginLoad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> m (Maybe Plugin)
pluginLoad a
plugin = IO (Maybe Plugin) -> m (Maybe Plugin)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Plugin) -> m (Maybe Plugin))
-> IO (Maybe Plugin) -> m (Maybe Plugin)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr Plugin
result <- Ptr Plugin -> IO (Ptr Plugin)
gst_plugin_load Ptr Plugin
plugin'
    Maybe Plugin
maybeResult <- Ptr Plugin -> (Ptr Plugin -> IO Plugin) -> IO (Maybe Plugin)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Plugin
result ((Ptr Plugin -> IO Plugin) -> IO (Maybe Plugin))
-> (Ptr Plugin -> IO Plugin) -> IO (Maybe Plugin)
forall a b. (a -> b) -> a -> b
$ \Ptr Plugin
result' -> do
        Plugin
result'' <- ((ManagedPtr Plugin -> Plugin) -> Ptr Plugin -> IO Plugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Plugin -> Plugin
Plugin) Ptr Plugin
result'
        Plugin -> IO Plugin
forall (m :: * -> *) a. Monad m => a -> m a
return Plugin
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Maybe Plugin -> IO (Maybe Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Plugin
maybeResult

#if defined(ENABLE_OVERLOADING)
data PluginLoadMethodInfo
instance (signature ~ (m (Maybe Plugin)), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginLoadMethodInfo a signature where
    overloadedMethod = pluginLoad

instance O.OverloadedMethodInfo PluginLoadMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginLoad",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginLoad"
        }


#endif

-- method Plugin::set_cache_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType = TInterface Name { namespace = "Gst" , name = "Plugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a plugin" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cache_data"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a structure containing the data to cache"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_plugin_set_cache_data" gst_plugin_set_cache_data :: 
    Ptr Plugin ->                           -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    Ptr Gst.Structure.Structure ->          -- cache_data : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO ()

-- | Adds plugin specific data to cache. Passes the ownership of the structure to
-- the /@plugin@/.
-- 
-- The cache is flushed every time the registry is rebuilt.
pluginSetCacheData ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    a
    -- ^ /@plugin@/: a plugin
    -> Gst.Structure.Structure
    -- ^ /@cacheData@/: a structure containing the data to cache
    -> m ()
pluginSetCacheData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
a -> Structure -> m ()
pluginSetCacheData a
plugin Structure
cacheData = 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 Plugin
plugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr Structure
cacheData' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
cacheData
    Ptr Plugin -> Ptr Structure -> IO ()
gst_plugin_set_cache_data Ptr Plugin
plugin' Ptr Structure
cacheData'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
cacheData
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PluginSetCacheDataMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m ()), MonadIO m, IsPlugin a) => O.OverloadedMethod PluginSetCacheDataMethodInfo a signature where
    overloadedMethod = pluginSetCacheData

instance O.OverloadedMethodInfo PluginSetCacheDataMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Plugin.pluginSetCacheData",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Plugin.html#v:pluginSetCacheData"
        }


#endif

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

foreign import ccall "gst_plugin_list_free" gst_plugin_list_free :: 
    Ptr (GList (Ptr Plugin)) ->             -- list : TGList (TInterface (Name {namespace = "Gst", name = "Plugin"}))
    IO ()

-- | Unrefs each member of /@list@/, then frees the list.
pluginListFree ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlugin a) =>
    [a]
    -- ^ /@list@/: list of t'GI.Gst.Objects.Plugin.Plugin'
    -> m ()
pluginListFree :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
[a] -> m ()
pluginListFree [a]
list = 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 Plugin]
list' <- (a -> IO (Ptr Plugin)) -> [a] -> IO [Ptr Plugin]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO (Ptr Plugin)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject [a]
list
    Ptr (GList (Ptr Plugin))
list'' <- [Ptr Plugin] -> IO (Ptr (GList (Ptr Plugin)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr Plugin]
list'
    Ptr (GList (Ptr Plugin)) -> IO ()
gst_plugin_list_free Ptr (GList (Ptr Plugin))
list''
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Plugin::load_by_name
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of plugin to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Plugin" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_plugin_load_by_name" gst_plugin_load_by_name :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Plugin)

-- | Load the named plugin. Refs the plugin.
pluginLoadByName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: name of plugin to load
    -> m (Maybe Plugin)
    -- ^ __Returns:__ a reference to a loaded plugin, or
    -- 'P.Nothing' on error.
pluginLoadByName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Plugin)
pluginLoadByName Text
name = IO (Maybe Plugin) -> m (Maybe Plugin)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Plugin) -> m (Maybe Plugin))
-> IO (Maybe Plugin) -> m (Maybe Plugin)
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Plugin
result <- CString -> IO (Ptr Plugin)
gst_plugin_load_by_name CString
name'
    Maybe Plugin
maybeResult <- Ptr Plugin -> (Ptr Plugin -> IO Plugin) -> IO (Maybe Plugin)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Plugin
result ((Ptr Plugin -> IO Plugin) -> IO (Maybe Plugin))
-> (Ptr Plugin -> IO Plugin) -> IO (Maybe Plugin)
forall a b. (a -> b) -> a -> b
$ \Ptr Plugin
result' -> do
        Plugin
result'' <- ((ManagedPtr Plugin -> Plugin) -> Ptr Plugin -> IO Plugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Plugin -> Plugin
Plugin) Ptr Plugin
result'
        Plugin -> IO Plugin
forall (m :: * -> *) a. Monad m => a -> m a
return Plugin
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe Plugin -> IO (Maybe Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Plugin
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Plugin::load_file
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the plugin filename to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Plugin" })
-- throws : True
-- Skip return : False

foreign import ccall "gst_plugin_load_file" gst_plugin_load_file :: 
    CString ->                              -- filename : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Plugin)

-- | Loads the given plugin and refs it.  Caller needs to unref after use.
pluginLoadFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@filename@/: the plugin filename to load
    -> m Plugin
    -- ^ __Returns:__ a reference to the existing loaded GstPlugin, a
    -- reference to the newly-loaded GstPlugin, or 'P.Nothing' if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
pluginLoadFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Char] -> m Plugin
pluginLoadFile [Char]
filename = IO Plugin -> m Plugin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Plugin -> m Plugin) -> IO Plugin -> m Plugin
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- [Char] -> IO CString
stringToCString [Char]
filename
    IO Plugin -> IO () -> IO Plugin
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Plugin
result <- (Ptr (Ptr GError) -> IO (Ptr Plugin)) -> IO (Ptr Plugin)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Plugin)) -> IO (Ptr Plugin))
-> (Ptr (Ptr GError) -> IO (Ptr Plugin)) -> IO (Ptr Plugin)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr Plugin)
gst_plugin_load_file CString
filename'
        Text -> Ptr Plugin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pluginLoadFile" Ptr Plugin
result
        Plugin
result' <- ((ManagedPtr Plugin -> Plugin) -> Ptr Plugin -> IO Plugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Plugin -> Plugin
Plugin) Ptr Plugin
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        Plugin -> IO Plugin
forall (m :: * -> *) a. Monad m => a -> m a
return Plugin
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Plugin::register_static
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "major_version"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the major version number of the GStreamer core that the\n    plugin was compiled for, you can just use GST_VERSION_MAJOR here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minor_version"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the minor version number of the GStreamer core that the\n    plugin was compiled for, you can just use GST_VERSION_MINOR here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a unique name of the plugin (ideally prefixed with an application- or\n    library-specific namespace prefix in order to avoid name conflicts in\n    case a similar plugin with the same name ever gets added to GStreamer)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "description of the plugin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "init_func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PluginInitFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer to the init function of this plugin."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "version"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "version string of the plugin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "license"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "effective license of plugin. Must be one of the approved licenses\n    (see #GstPluginDesc above) or the plugin will not be registered."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source module plugin belongs to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "package"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "shipped package plugin belongs to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "URL to provider of plugin"
--                 , 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_plugin_register_static" gst_plugin_register_static :: 
    Int32 ->                                -- major_version : TBasicType TInt
    Int32 ->                                -- minor_version : TBasicType TInt
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- description : TBasicType TUTF8
    FunPtr Gst.Callbacks.C_PluginInitFunc -> -- init_func : TInterface (Name {namespace = "Gst", name = "PluginInitFunc"})
    CString ->                              -- version : TBasicType TUTF8
    CString ->                              -- license : TBasicType TUTF8
    CString ->                              -- source : TBasicType TUTF8
    CString ->                              -- package : TBasicType TUTF8
    CString ->                              -- origin : TBasicType TUTF8
    IO CInt

-- | Registers a static plugin, ie. a plugin which is private to an application
-- or library and contained within the application or library (as opposed to
-- being shipped as a separate module file).
-- 
-- You must make sure that GStreamer has been initialised (with 'GI.Gst.Functions.init' or
-- via @/gst_init_get_option_group()/@) before calling this function.
pluginRegisterStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@majorVersion@/: the major version number of the GStreamer core that the
    --     plugin was compiled for, you can just use GST_VERSION_MAJOR here
    -> Int32
    -- ^ /@minorVersion@/: the minor version number of the GStreamer core that the
    --     plugin was compiled for, you can just use GST_VERSION_MINOR here
    -> T.Text
    -- ^ /@name@/: a unique name of the plugin (ideally prefixed with an application- or
    --     library-specific namespace prefix in order to avoid name conflicts in
    --     case a similar plugin with the same name ever gets added to GStreamer)
    -> T.Text
    -- ^ /@description@/: description of the plugin
    -> Gst.Callbacks.PluginInitFunc
    -- ^ /@initFunc@/: pointer to the init function of this plugin.
    -> T.Text
    -- ^ /@version@/: version string of the plugin
    -> T.Text
    -- ^ /@license@/: effective license of plugin. Must be one of the approved licenses
    --     (see t'GI.Gst.Structs.PluginDesc.PluginDesc' above) or the plugin will not be registered.
    -> T.Text
    -- ^ /@source@/: source module plugin belongs to
    -> T.Text
    -- ^ /@package@/: shipped package plugin belongs to
    -> T.Text
    -- ^ /@origin@/: URL to provider of plugin
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the plugin was registered correctly, otherwise 'P.False'.
pluginRegisterStatic :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32
-> Int32
-> Text
-> Text
-> PluginInitFunc
-> Text
-> Text
-> Text
-> Text
-> Text
-> m Bool
pluginRegisterStatic Int32
majorVersion Int32
minorVersion Text
name Text
description PluginInitFunc
initFunc Text
version Text
license Text
source Text
package Text
origin = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
description' <- Text -> IO CString
textToCString Text
description
    FunPtr (Ptr Plugin -> IO CInt)
initFunc' <- (Ptr Plugin -> IO CInt) -> IO (FunPtr (Ptr Plugin -> IO CInt))
Gst.Callbacks.mk_PluginInitFunc (Maybe (Ptr (FunPtr (Ptr Plugin -> IO CInt)))
-> PluginInitFunc -> Ptr Plugin -> IO CInt
Gst.Callbacks.wrap_PluginInitFunc Maybe (Ptr (FunPtr (Ptr Plugin -> IO CInt)))
forall a. Maybe a
Nothing PluginInitFunc
initFunc)
    CString
version' <- Text -> IO CString
textToCString Text
version
    CString
license' <- Text -> IO CString
textToCString Text
license
    CString
source' <- Text -> IO CString
textToCString Text
source
    CString
package' <- Text -> IO CString
textToCString Text
package
    CString
origin' <- Text -> IO CString
textToCString Text
origin
    CInt
result <- Int32
-> Int32
-> CString
-> CString
-> FunPtr (Ptr Plugin -> IO CInt)
-> CString
-> CString
-> CString
-> CString
-> CString
-> IO CInt
gst_plugin_register_static Int32
majorVersion Int32
minorVersion CString
name' CString
description' FunPtr (Ptr Plugin -> IO CInt)
initFunc' CString
version' CString
license' CString
source' CString
package' CString
origin'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr (Ptr Plugin -> IO CInt) -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (Ptr Plugin -> IO CInt)
initFunc'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
version'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
license'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
source'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
package'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
origin'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Plugin::register_static_full
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "major_version"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the major version number of the GStreamer core that the\n    plugin was compiled for, you can just use GST_VERSION_MAJOR here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minor_version"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the minor version number of the GStreamer core that the\n    plugin was compiled for, you can just use GST_VERSION_MINOR here"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a unique name of the plugin (ideally prefixed with an application- or\n    library-specific namespace prefix in order to avoid name conflicts in\n    case a similar plugin with the same name ever gets added to GStreamer)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "description of the plugin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "init_full_func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "PluginInitFullFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pointer to the init function with user data\n    of this plugin."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 10
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "version"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "version string of the plugin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "license"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "effective license of plugin. Must be one of the approved licenses\n    (see #GstPluginDesc above) or the plugin will not be registered."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "source module plugin belongs to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "package"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "shipped package plugin belongs to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "URL to provider of plugin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "gpointer to user data"
--                 , 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_plugin_register_static_full" gst_plugin_register_static_full :: 
    Int32 ->                                -- major_version : TBasicType TInt
    Int32 ->                                -- minor_version : TBasicType TInt
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- description : TBasicType TUTF8
    FunPtr Gst.Callbacks.C_PluginInitFullFunc -> -- init_full_func : TInterface (Name {namespace = "Gst", name = "PluginInitFullFunc"})
    CString ->                              -- version : TBasicType TUTF8
    CString ->                              -- license : TBasicType TUTF8
    CString ->                              -- source : TBasicType TUTF8
    CString ->                              -- package : TBasicType TUTF8
    CString ->                              -- origin : TBasicType TUTF8
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

-- | Registers a static plugin, ie. a plugin which is private to an application
-- or library and contained within the application or library (as opposed to
-- being shipped as a separate module file) with a t'GI.Gst.Callbacks.PluginInitFullFunc'
-- which allows user data to be passed to the callback function (useful
-- for bindings).
-- 
-- You must make sure that GStreamer has been initialised (with 'GI.Gst.Functions.init' or
-- via @/gst_init_get_option_group()/@) before calling this function.
pluginRegisterStaticFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@majorVersion@/: the major version number of the GStreamer core that the
    --     plugin was compiled for, you can just use GST_VERSION_MAJOR here
    -> Int32
    -- ^ /@minorVersion@/: the minor version number of the GStreamer core that the
    --     plugin was compiled for, you can just use GST_VERSION_MINOR here
    -> T.Text
    -- ^ /@name@/: a unique name of the plugin (ideally prefixed with an application- or
    --     library-specific namespace prefix in order to avoid name conflicts in
    --     case a similar plugin with the same name ever gets added to GStreamer)
    -> T.Text
    -- ^ /@description@/: description of the plugin
    -> Gst.Callbacks.PluginInitFullFunc
    -- ^ /@initFullFunc@/: pointer to the init function with user data
    --     of this plugin.
    -> T.Text
    -- ^ /@version@/: version string of the plugin
    -> T.Text
    -- ^ /@license@/: effective license of plugin. Must be one of the approved licenses
    --     (see t'GI.Gst.Structs.PluginDesc.PluginDesc' above) or the plugin will not be registered.
    -> T.Text
    -- ^ /@source@/: source module plugin belongs to
    -> T.Text
    -- ^ /@package@/: shipped package plugin belongs to
    -> T.Text
    -- ^ /@origin@/: URL to provider of plugin
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the plugin was registered correctly, otherwise 'P.False'.
pluginRegisterStaticFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32
-> Int32
-> Text
-> Text
-> PluginInitFunc
-> Text
-> Text
-> Text
-> Text
-> Text
-> m Bool
pluginRegisterStaticFull Int32
majorVersion Int32
minorVersion Text
name Text
description PluginInitFunc
initFullFunc Text
version Text
license Text
source Text
package Text
origin = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
description' <- Text -> IO CString
textToCString Text
description
    FunPtr C_PluginInitFullFunc
initFullFunc' <- C_PluginInitFullFunc -> IO (FunPtr C_PluginInitFullFunc)
Gst.Callbacks.mk_PluginInitFullFunc (Maybe (Ptr (FunPtr C_PluginInitFullFunc))
-> PluginInitFullFunc_WithClosures -> C_PluginInitFullFunc
Gst.Callbacks.wrap_PluginInitFullFunc Maybe (Ptr (FunPtr C_PluginInitFullFunc))
forall a. Maybe a
Nothing (PluginInitFunc -> PluginInitFullFunc_WithClosures
Gst.Callbacks.drop_closures_PluginInitFullFunc PluginInitFunc
initFullFunc))
    CString
version' <- Text -> IO CString
textToCString Text
version
    CString
license' <- Text -> IO CString
textToCString Text
license
    CString
source' <- Text -> IO CString
textToCString Text
source
    CString
package' <- Text -> IO CString
textToCString Text
package
    CString
origin' <- Text -> IO CString
textToCString Text
origin
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CInt
result <- Int32
-> Int32
-> CString
-> CString
-> FunPtr C_PluginInitFullFunc
-> CString
-> CString
-> CString
-> CString
-> CString
-> Ptr ()
-> IO CInt
gst_plugin_register_static_full Int32
majorVersion Int32
minorVersion CString
name' CString
description' FunPtr C_PluginInitFullFunc
initFullFunc' CString
version' CString
license' CString
source' CString
package' CString
origin' Ptr ()
forall a. Ptr a
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_PluginInitFullFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PluginInitFullFunc
initFullFunc'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
version'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
license'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
source'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
package'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
origin'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif