{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

The following functions allow you to detect the media type of an unknown
stream.
-}

module GI.Gst.Structs.TypeFind
    ( 

-- * Exported types
    TypeFind(..)                            ,
    newZeroTypeFind                         ,
    noTypeFind                              ,


 -- * Methods
-- ** getLength #method:getLength#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    TypeFindGetLengthMethodInfo             ,
#endif
    typeFindGetLength                       ,


-- ** peek #method:peek#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    TypeFindPeekMethodInfo                  ,
#endif
    typeFindPeek                            ,


-- ** register #method:register#
    typeFindRegister                        ,


-- ** suggest #method:suggest#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    TypeFindSuggestMethodInfo               ,
#endif
    typeFindSuggest                         ,




 -- * Properties
-- ** data #attr:data#
    clearTypeFindData                       ,
    getTypeFindData                         ,
    setTypeFindData                         ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeFind_data                           ,
#endif


-- ** getLength #attr:getLength#
    clearTypeFindGetLength                  ,
    getTypeFindGetLength                    ,
    setTypeFindGetLength                    ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeFind_getLength                      ,
#endif


-- ** peek #attr:peek#
    clearTypeFindPeek                       ,
    getTypeFindPeek                         ,
    setTypeFindPeek                         ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeFind_peek                           ,
#endif


-- ** suggest #attr:suggest#
    clearTypeFindSuggest                    ,
    getTypeFindSuggest                      ,
    setTypeFindSuggest                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeFind_suggest                        ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Objects.Plugin as Gst.Plugin
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps

newtype TypeFind = TypeFind (ManagedPtr TypeFind)
instance WrappedPtr TypeFind where
    wrappedPtrCalloc = callocBytes 64
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 64 >=> wrapPtr TypeFind)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `TypeFind` struct initialized to zero.
newZeroTypeFind :: MonadIO m => m TypeFind
newZeroTypeFind = liftIO $ wrappedPtrCalloc >>= wrapPtr TypeFind

instance tag ~ 'AttrSet => Constructible TypeFind tag where
    new _ attrs = do
        o <- newZeroTypeFind
        GI.Attributes.set o attrs
        return o


noTypeFind :: Maybe TypeFind
noTypeFind = Nothing

getTypeFindPeek :: MonadIO m => TypeFind -> m (Maybe Gst.Callbacks.TypeFindPeekFieldCallback)
getTypeFindPeek s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = Gst.Callbacks.dynamic_TypeFindPeekFieldCallback val'
        return val''
    return result

setTypeFindPeek :: MonadIO m => TypeFind -> FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback -> m ()
setTypeFindPeek s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)

clearTypeFindPeek :: MonadIO m => TypeFind -> m ()
clearTypeFindPeek s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullFunPtr :: FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindPeekFieldInfo
instance AttrInfo TypeFindPeekFieldInfo where
    type AttrAllowedOps TypeFindPeekFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeFindPeekFieldInfo = (~) (FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)
    type AttrBaseTypeConstraint TypeFindPeekFieldInfo = (~) TypeFind
    type AttrGetType TypeFindPeekFieldInfo = Maybe Gst.Callbacks.TypeFindPeekFieldCallback
    type AttrLabel TypeFindPeekFieldInfo = "peek"
    type AttrOrigin TypeFindPeekFieldInfo = TypeFind
    attrGet _ = getTypeFindPeek
    attrSet _ = setTypeFindPeek
    attrConstruct = undefined
    attrClear _ = clearTypeFindPeek

typeFind_peek :: AttrLabelProxy "peek"
typeFind_peek = AttrLabelProxy

#endif


getTypeFindSuggest :: MonadIO m => TypeFind -> m (Maybe Gst.Callbacks.TypeFindSuggestFieldCallback)
getTypeFindSuggest s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO (FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = Gst.Callbacks.dynamic_TypeFindSuggestFieldCallback val'
        return val''
    return result

setTypeFindSuggest :: MonadIO m => TypeFind -> FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback -> m ()
setTypeFindSuggest s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)

clearTypeFindSuggest :: MonadIO m => TypeFind -> m ()
clearTypeFindSuggest s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullFunPtr :: FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindSuggestFieldInfo
instance AttrInfo TypeFindSuggestFieldInfo where
    type AttrAllowedOps TypeFindSuggestFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeFindSuggestFieldInfo = (~) (FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)
    type AttrBaseTypeConstraint TypeFindSuggestFieldInfo = (~) TypeFind
    type AttrGetType TypeFindSuggestFieldInfo = Maybe Gst.Callbacks.TypeFindSuggestFieldCallback
    type AttrLabel TypeFindSuggestFieldInfo = "suggest"
    type AttrOrigin TypeFindSuggestFieldInfo = TypeFind
    attrGet _ = getTypeFindSuggest
    attrSet _ = setTypeFindSuggest
    attrConstruct = undefined
    attrClear _ = clearTypeFindSuggest

typeFind_suggest :: AttrLabelProxy "suggest"
typeFind_suggest = AttrLabelProxy

#endif


getTypeFindData :: MonadIO m => TypeFind -> m (Ptr ())
getTypeFindData s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO (Ptr ())
    return val

setTypeFindData :: MonadIO m => TypeFind -> Ptr () -> m ()
setTypeFindData s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Ptr ())

clearTypeFindData :: MonadIO m => TypeFind -> m ()
clearTypeFindData s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindDataFieldInfo
instance AttrInfo TypeFindDataFieldInfo where
    type AttrAllowedOps TypeFindDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeFindDataFieldInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint TypeFindDataFieldInfo = (~) TypeFind
    type AttrGetType TypeFindDataFieldInfo = Ptr ()
    type AttrLabel TypeFindDataFieldInfo = "data"
    type AttrOrigin TypeFindDataFieldInfo = TypeFind
    attrGet _ = getTypeFindData
    attrSet _ = setTypeFindData
    attrConstruct = undefined
    attrClear _ = clearTypeFindData

typeFind_data :: AttrLabelProxy "data"
typeFind_data = AttrLabelProxy

#endif


getTypeFindGetLength :: MonadIO m => TypeFind -> m (Maybe Gst.Callbacks.TypeFindGetLengthFieldCallback)
getTypeFindGetLength s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO (FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = Gst.Callbacks.dynamic_TypeFindGetLengthFieldCallback val'
        return val''
    return result

setTypeFindGetLength :: MonadIO m => TypeFind -> FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback -> m ()
setTypeFindGetLength s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)

clearTypeFindGetLength :: MonadIO m => TypeFind -> m ()
clearTypeFindGetLength s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullFunPtr :: FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindGetLengthFieldInfo
instance AttrInfo TypeFindGetLengthFieldInfo where
    type AttrAllowedOps TypeFindGetLengthFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeFindGetLengthFieldInfo = (~) (FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)
    type AttrBaseTypeConstraint TypeFindGetLengthFieldInfo = (~) TypeFind
    type AttrGetType TypeFindGetLengthFieldInfo = Maybe Gst.Callbacks.TypeFindGetLengthFieldCallback
    type AttrLabel TypeFindGetLengthFieldInfo = "get_length"
    type AttrOrigin TypeFindGetLengthFieldInfo = TypeFind
    attrGet _ = getTypeFindGetLength
    attrSet _ = setTypeFindGetLength
    attrConstruct = undefined
    attrClear _ = clearTypeFindGetLength

typeFind_getLength :: AttrLabelProxy "getLength"
typeFind_getLength = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList TypeFind
type instance O.AttributeList TypeFind = TypeFindAttributeList
type TypeFindAttributeList = ('[ '("peek", TypeFindPeekFieldInfo), '("suggest", TypeFindSuggestFieldInfo), '("data", TypeFindDataFieldInfo), '("getLength", TypeFindGetLengthFieldInfo)] :: [(Symbol, *)])
#endif

-- method TypeFind::get_length
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "find", argType = TInterface (Name {namespace = "Gst", name = "TypeFind"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstTypeFind the function was called with", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUInt64)
-- throws : False
-- Skip return : False

foreign import ccall "gst_type_find_get_length" gst_type_find_get_length :: 
    Ptr TypeFind ->                         -- find : TInterface (Name {namespace = "Gst", name = "TypeFind"})
    IO Word64

{- |
Get the length of the data stream.
-}
typeFindGetLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeFind
    {- ^ /@find@/: The 'GI.Gst.Structs.TypeFind.TypeFind' the function was called with -}
    -> m Word64
    {- ^ __Returns:__ The length of the data stream, or 0 if it is not available. -}
typeFindGetLength find = liftIO $ do
    find' <- unsafeManagedPtrGetPtr find
    result <- gst_type_find_get_length find'
    touchManagedPtr find
    return result

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindGetLengthMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.MethodInfo TypeFindGetLengthMethodInfo TypeFind signature where
    overloadedMethod _ = typeFindGetLength

#endif

-- method TypeFind::peek
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "find", argType = TInterface (Name {namespace = "Gst", name = "TypeFind"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstTypeFind object the function was called with", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "offset", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The offset", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "size", argType = TBasicType TUInt, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The number of bytes to return", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : [Arg {argCName = "size", argType = TBasicType TUInt, direction = DirectionOut, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The number of bytes to return", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- returnType : Just (TCArray False (-1) 2 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_type_find_peek" gst_type_find_peek :: 
    Ptr TypeFind ->                         -- find : TInterface (Name {namespace = "Gst", name = "TypeFind"})
    Int64 ->                                -- offset : TBasicType TInt64
    Ptr Word32 ->                           -- size : TBasicType TUInt
    IO (Ptr Word8)

{- |
Returns the /@size@/ bytes of the stream to identify beginning at offset. If
offset is a positive number, the offset is relative to the beginning of the
stream, if offset is a negative number the offset is relative to the end of
the stream. The returned memory is valid until the typefinding function
returns and must not be freed.
-}
typeFindPeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeFind
    {- ^ /@find@/: The 'GI.Gst.Structs.TypeFind.TypeFind' object the function was called with -}
    -> Int64
    {- ^ /@offset@/: The offset -}
    -> m (Maybe ByteString)
    {- ^ __Returns:__ the
    requested data, or 'Nothing' if that data is not available. -}
typeFindPeek find offset = liftIO $ do
    find' <- unsafeManagedPtrGetPtr find
    size <- allocMem :: IO (Ptr Word32)
    result <- gst_type_find_peek find' offset size
    size' <- peek size
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (unpackByteStringWithLength size') result'
        return result''
    touchManagedPtr find
    freeMem size
    return maybeResult

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindPeekMethodInfo
instance (signature ~ (Int64 -> m (Maybe ByteString)), MonadIO m) => O.MethodInfo TypeFindPeekMethodInfo TypeFind signature where
    overloadedMethod _ = typeFindPeek

#endif

-- method TypeFind::suggest
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "find", argType = TInterface (Name {namespace = "Gst", name = "TypeFind"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstTypeFind object the function was called with", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "probability", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The probability in percent that the suggestion is right", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "caps", argType = TInterface (Name {namespace = "Gst", name = "Caps"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The fixed #GstCaps to suggest", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_type_find_suggest" gst_type_find_suggest :: 
    Ptr TypeFind ->                         -- find : TInterface (Name {namespace = "Gst", name = "TypeFind"})
    Word32 ->                               -- probability : TBasicType TUInt
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

{- |
If a 'GI.Gst.Callbacks.TypeFindFunction' calls this function it suggests the caps with the
given probability. A 'GI.Gst.Callbacks.TypeFindFunction' may supply different suggestions
in one call.
It is up to the caller of the 'GI.Gst.Callbacks.TypeFindFunction' to interpret these values.
-}
typeFindSuggest ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeFind
    {- ^ /@find@/: The 'GI.Gst.Structs.TypeFind.TypeFind' object the function was called with -}
    -> Word32
    {- ^ /@probability@/: The probability in percent that the suggestion is right -}
    -> Gst.Caps.Caps
    {- ^ /@caps@/: The fixed 'GI.Gst.Structs.Caps.Caps' to suggest -}
    -> m ()
typeFindSuggest find probability caps = liftIO $ do
    find' <- unsafeManagedPtrGetPtr find
    caps' <- unsafeManagedPtrGetPtr caps
    gst_type_find_suggest find' probability caps'
    touchManagedPtr find
    touchManagedPtr caps
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeFindSuggestMethodInfo
instance (signature ~ (Word32 -> Gst.Caps.Caps -> m ()), MonadIO m) => O.MethodInfo TypeFindSuggestMethodInfo TypeFind signature where
    overloadedMethod _ = typeFindSuggest

#endif

-- method TypeFind::register
-- method type : MemberFunction
-- Args : [Arg {argCName = "plugin", argType = TInterface (Name {namespace = "Gst", name = "Plugin"}), direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "A #GstPlugin, or %NULL for a static typefind function", 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 "The name for registering", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "rank", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The rank (or importance) of this typefind function", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "func", argType = TInterface (Name {namespace = "Gst", name = "TypeFindFunction"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "The #GstTypeFindFunction to use", sinceVersion = Nothing}, argScope = ScopeTypeNotified, argClosure = 6, argDestroy = 7, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "extensions", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "Optional comma-separated list of extensions\n    that could belong to this type", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "possible_caps", argType = TInterface (Name {namespace = "Gst", name = "Caps"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "Optionally the caps that could be returned when typefinding\n                succeeds", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "Optional user data. This user data must be available until the plugin\n       is unloaded.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "data_notify", argType = TInterface (Name {namespace = "GLib", name = "DestroyNotify"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GDestroyNotify that will be called on @data when the plugin\n       is unloaded.", sinceVersion = Nothing}, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_type_find_register" gst_type_find_register :: 
    Ptr Gst.Plugin.Plugin ->                -- plugin : TInterface (Name {namespace = "Gst", name = "Plugin"})
    CString ->                              -- name : TBasicType TUTF8
    Word32 ->                               -- rank : TBasicType TUInt
    FunPtr Gst.Callbacks.C_TypeFindFunction -> -- func : TInterface (Name {namespace = "Gst", name = "TypeFindFunction"})
    CString ->                              -- extensions : TBasicType TUTF8
    Ptr Gst.Caps.Caps ->                    -- possible_caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- data_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO CInt

{- |
Registers a new typefind function to be used for typefinding. After
registering this function will be available for typefinding.
This function is typically called during an element\'s plugin initialization.
-}
typeFindRegister ::
    (B.CallStack.HasCallStack, MonadIO m, Gst.Plugin.IsPlugin a) =>
    Maybe (a)
    {- ^ /@plugin@/: A 'GI.Gst.Objects.Plugin.Plugin', or 'Nothing' for a static typefind function -}
    -> T.Text
    {- ^ /@name@/: The name for registering -}
    -> Word32
    {- ^ /@rank@/: The rank (or importance) of this typefind function -}
    -> Gst.Callbacks.TypeFindFunction
    {- ^ /@func@/: The 'GI.Gst.Callbacks.TypeFindFunction' to use -}
    -> Maybe (T.Text)
    {- ^ /@extensions@/: Optional comma-separated list of extensions
    that could belong to this type -}
    -> Gst.Caps.Caps
    {- ^ /@possibleCaps@/: Optionally the caps that could be returned when typefinding
                succeeds -}
    -> m Bool
    {- ^ __Returns:__ 'True' on success, 'False' otherwise -}
typeFindRegister plugin name rank func extensions possibleCaps = liftIO $ do
    maybePlugin <- case plugin of
        Nothing -> return nullPtr
        Just jPlugin -> do
            jPlugin' <- unsafeManagedPtrCastPtr jPlugin
            return jPlugin'
    name' <- textToCString name
    func' <- Gst.Callbacks.mk_TypeFindFunction (Gst.Callbacks.wrap_TypeFindFunction Nothing (Gst.Callbacks.drop_closures_TypeFindFunction func))
    maybeExtensions <- case extensions of
        Nothing -> return nullPtr
        Just jExtensions -> do
            jExtensions' <- textToCString jExtensions
            return jExtensions'
    possibleCaps' <- unsafeManagedPtrGetPtr possibleCaps
    let data_ = castFunPtrToPtr func'
    let dataNotify = safeFreeFunPtrPtr
    result <- gst_type_find_register maybePlugin name' rank func' maybeExtensions possibleCaps' data_ dataNotify
    let result' = (/= 0) result
    whenJust plugin touchManagedPtr
    touchManagedPtr possibleCaps
    freeMem name'
    freeMem maybeExtensions
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveTypeFindMethod (t :: Symbol) (o :: *) :: * where
    ResolveTypeFindMethod "peek" o = TypeFindPeekMethodInfo
    ResolveTypeFindMethod "suggest" o = TypeFindSuggestMethodInfo
    ResolveTypeFindMethod "getLength" o = TypeFindGetLengthMethodInfo
    ResolveTypeFindMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTypeFindMethod t TypeFind, O.MethodInfo info TypeFind p) => O.IsLabelProxy t (TypeFind -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveTypeFindMethod t TypeFind, O.MethodInfo info TypeFind p) => O.IsLabel t (TypeFind -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif

#endif