{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The following functions allow you to detect the media type of an unknown
-- stream.

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

module GI.Gst.Structs.TypeFind
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveTypeFindMethod                   ,
#endif


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    TypeFindGetLengthMethodInfo             ,
#endif
    typeFindGetLength                       ,


-- ** peek #method:peek#

#if defined(ENABLE_OVERLOADING)
    TypeFindPeekMethodInfo                  ,
#endif
    typeFindPeek                            ,


-- ** register #method:register#

    typeFindRegister                        ,


-- ** suggest #method:suggest#

#if defined(ENABLE_OVERLOADING)
    TypeFindSuggestMethodInfo               ,
#endif
    typeFindSuggest                         ,




 -- * Properties
-- ** data #attr:data#
-- | The data used by the caller of the typefinding function.

    clearTypeFindData                       ,
    getTypeFindData                         ,
    setTypeFindData                         ,
#if defined(ENABLE_OVERLOADING)
    typeFind_data                           ,
#endif


-- ** getLength #attr:getLength#
-- | /No description available in the introspection data./

    clearTypeFindGetLength                  ,
    getTypeFindGetLength                    ,
    setTypeFindGetLength                    ,
#if defined(ENABLE_OVERLOADING)
    typeFind_getLength                      ,
#endif


-- ** peek #attr:peek#
-- | /No description available in the introspection data./

    clearTypeFindPeek                       ,
    getTypeFindPeek                         ,
    setTypeFindPeek                         ,
#if defined(ENABLE_OVERLOADING)
    typeFind_peek                           ,
#endif


-- ** suggest #attr:suggest#
-- | /No description available in the introspection data./

    clearTypeFindSuggest                    ,
    getTypeFindSuggest                      ,
    setTypeFindSuggest                      ,
#if defined(ENABLE_OVERLOADING)
    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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.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

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

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

instance BoxedPtr TypeFind where
    boxedPtrCopy :: TypeFind -> IO TypeFind
boxedPtrCopy = \TypeFind
p -> TypeFind -> (Ptr TypeFind -> IO TypeFind) -> IO TypeFind
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TypeFind
p (Int -> Ptr TypeFind -> IO (Ptr TypeFind)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
64 (Ptr TypeFind -> IO (Ptr TypeFind))
-> (Ptr TypeFind -> IO TypeFind) -> Ptr TypeFind -> IO TypeFind
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr TypeFind -> TypeFind) -> Ptr TypeFind -> IO TypeFind
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr TypeFind -> TypeFind
TypeFind)
    boxedPtrFree :: TypeFind -> IO ()
boxedPtrFree = \TypeFind
x -> TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr TypeFind
x Ptr TypeFind -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr TypeFind where
    boxedPtrCalloc :: IO (Ptr TypeFind)
boxedPtrCalloc = Int -> IO (Ptr TypeFind)
forall a. Int -> IO (Ptr a)
callocBytes Int
64


-- | Construct a `TypeFind` struct initialized to zero.
newZeroTypeFind :: MonadIO m => m TypeFind
newZeroTypeFind :: m TypeFind
newZeroTypeFind = IO TypeFind -> m TypeFind
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeFind -> m TypeFind) -> IO TypeFind -> m TypeFind
forall a b. (a -> b) -> a -> b
$ IO (Ptr TypeFind)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr TypeFind) -> (Ptr TypeFind -> IO TypeFind) -> IO TypeFind
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr TypeFind -> TypeFind) -> Ptr TypeFind -> IO TypeFind
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr TypeFind -> TypeFind
TypeFind

instance tag ~ 'AttrSet => Constructible TypeFind tag where
    new :: (ManagedPtr TypeFind -> TypeFind)
-> [AttrOp TypeFind tag] -> m TypeFind
new ManagedPtr TypeFind -> TypeFind
_ [AttrOp TypeFind tag]
attrs = do
        TypeFind
o <- m TypeFind
forall (m :: * -> *). MonadIO m => m TypeFind
newZeroTypeFind
        TypeFind -> [AttrOp TypeFind 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set TypeFind
o [AttrOp TypeFind tag]
[AttrOp TypeFind 'AttrSet]
attrs
        TypeFind -> m TypeFind
forall (m :: * -> *) a. Monad m => a -> m a
return TypeFind
o


-- | Get the value of the “@peek@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' typeFind #peek
-- @
getTypeFindPeek :: MonadIO m => TypeFind -> m (Maybe Gst.Callbacks.TypeFindPeekFieldCallback)
getTypeFindPeek :: TypeFind -> m (Maybe TypeFindPeekFieldCallback)
getTypeFindPeek TypeFind
s = IO (Maybe TypeFindPeekFieldCallback)
-> m (Maybe TypeFindPeekFieldCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TypeFindPeekFieldCallback)
 -> m (Maybe TypeFindPeekFieldCallback))
-> IO (Maybe TypeFindPeekFieldCallback)
-> m (Maybe TypeFindPeekFieldCallback)
forall a b. (a -> b) -> a -> b
$ TypeFind
-> (Ptr TypeFind -> IO (Maybe TypeFindPeekFieldCallback))
-> IO (Maybe TypeFindPeekFieldCallback)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO (Maybe TypeFindPeekFieldCallback))
 -> IO (Maybe TypeFindPeekFieldCallback))
-> (Ptr TypeFind -> IO (Maybe TypeFindPeekFieldCallback))
-> IO (Maybe TypeFindPeekFieldCallback)
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    FunPtr TypeFindPeekFieldCallback
val <- Ptr (FunPtr TypeFindPeekFieldCallback)
-> IO (FunPtr TypeFindPeekFieldCallback)
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr TypeFindPeekFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)
    Maybe TypeFindPeekFieldCallback
result <- FunPtr TypeFindPeekFieldCallback
-> (FunPtr TypeFindPeekFieldCallback
    -> IO TypeFindPeekFieldCallback)
-> IO (Maybe TypeFindPeekFieldCallback)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr TypeFindPeekFieldCallback
val ((FunPtr TypeFindPeekFieldCallback -> IO TypeFindPeekFieldCallback)
 -> IO (Maybe TypeFindPeekFieldCallback))
-> (FunPtr TypeFindPeekFieldCallback
    -> IO TypeFindPeekFieldCallback)
-> IO (Maybe TypeFindPeekFieldCallback)
forall a b. (a -> b) -> a -> b
$ \FunPtr TypeFindPeekFieldCallback
val' -> do
        let val'' :: TypeFindPeekFieldCallback
val'' = FunPtr TypeFindPeekFieldCallback -> TypeFindPeekFieldCallback
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr TypeFindPeekFieldCallback
-> Ptr () -> Int64 -> Word32 -> m Word8
Gst.Callbacks.dynamic_TypeFindPeekFieldCallback FunPtr TypeFindPeekFieldCallback
val'
        TypeFindPeekFieldCallback -> IO TypeFindPeekFieldCallback
forall (m :: * -> *) a. Monad m => a -> m a
return TypeFindPeekFieldCallback
val''
    Maybe TypeFindPeekFieldCallback
-> IO (Maybe TypeFindPeekFieldCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeFindPeekFieldCallback
result

-- | Set the value of the “@peek@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' typeFind [ #peek 'Data.GI.Base.Attributes.:=' value ]
-- @
setTypeFindPeek :: MonadIO m => TypeFind -> FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback -> m ()
setTypeFindPeek :: TypeFind -> FunPtr TypeFindPeekFieldCallback -> m ()
setTypeFindPeek TypeFind
s FunPtr TypeFindPeekFieldCallback
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (FunPtr TypeFindPeekFieldCallback)
-> FunPtr TypeFindPeekFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr TypeFindPeekFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (FunPtr TypeFindPeekFieldCallback
val :: FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)

-- | Set the value of the “@peek@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #peek
-- @
clearTypeFindPeek :: MonadIO m => TypeFind -> m ()
clearTypeFindPeek :: TypeFind -> m ()
clearTypeFindPeek TypeFind
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (FunPtr TypeFindPeekFieldCallback)
-> FunPtr TypeFindPeekFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr TypeFindPeekFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (FunPtr TypeFindPeekFieldCallback
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_TypeFindPeekFieldCallback)

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

typeFind_peek :: AttrLabelProxy "peek"
typeFind_peek = AttrLabelProxy

#endif


-- | Get the value of the “@suggest@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' typeFind #suggest
-- @
getTypeFindSuggest :: MonadIO m => TypeFind -> m (Maybe Gst.Callbacks.TypeFindSuggestFieldCallback)
getTypeFindSuggest :: TypeFind -> m (Maybe TypeFindSuggestFieldCallback)
getTypeFindSuggest TypeFind
s = IO (Maybe TypeFindSuggestFieldCallback)
-> m (Maybe TypeFindSuggestFieldCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TypeFindSuggestFieldCallback)
 -> m (Maybe TypeFindSuggestFieldCallback))
-> IO (Maybe TypeFindSuggestFieldCallback)
-> m (Maybe TypeFindSuggestFieldCallback)
forall a b. (a -> b) -> a -> b
$ TypeFind
-> (Ptr TypeFind -> IO (Maybe TypeFindSuggestFieldCallback))
-> IO (Maybe TypeFindSuggestFieldCallback)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO (Maybe TypeFindSuggestFieldCallback))
 -> IO (Maybe TypeFindSuggestFieldCallback))
-> (Ptr TypeFind -> IO (Maybe TypeFindSuggestFieldCallback))
-> IO (Maybe TypeFindSuggestFieldCallback)
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    FunPtr C_TypeFindSuggestFieldCallback
val <- Ptr (FunPtr C_TypeFindSuggestFieldCallback)
-> IO (FunPtr C_TypeFindSuggestFieldCallback)
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr C_TypeFindSuggestFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)
    Maybe TypeFindSuggestFieldCallback
result <- FunPtr C_TypeFindSuggestFieldCallback
-> (FunPtr C_TypeFindSuggestFieldCallback
    -> IO TypeFindSuggestFieldCallback)
-> IO (Maybe TypeFindSuggestFieldCallback)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_TypeFindSuggestFieldCallback
val ((FunPtr C_TypeFindSuggestFieldCallback
  -> IO TypeFindSuggestFieldCallback)
 -> IO (Maybe TypeFindSuggestFieldCallback))
-> (FunPtr C_TypeFindSuggestFieldCallback
    -> IO TypeFindSuggestFieldCallback)
-> IO (Maybe TypeFindSuggestFieldCallback)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_TypeFindSuggestFieldCallback
val' -> do
        let val'' :: TypeFindSuggestFieldCallback
val'' = FunPtr C_TypeFindSuggestFieldCallback
-> TypeFindSuggestFieldCallback
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_TypeFindSuggestFieldCallback
-> Ptr () -> Word32 -> Caps -> m ()
Gst.Callbacks.dynamic_TypeFindSuggestFieldCallback FunPtr C_TypeFindSuggestFieldCallback
val'
        TypeFindSuggestFieldCallback -> IO TypeFindSuggestFieldCallback
forall (m :: * -> *) a. Monad m => a -> m a
return TypeFindSuggestFieldCallback
val''
    Maybe TypeFindSuggestFieldCallback
-> IO (Maybe TypeFindSuggestFieldCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeFindSuggestFieldCallback
result

-- | Set the value of the “@suggest@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' typeFind [ #suggest 'Data.GI.Base.Attributes.:=' value ]
-- @
setTypeFindSuggest :: MonadIO m => TypeFind -> FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback -> m ()
setTypeFindSuggest :: TypeFind -> FunPtr C_TypeFindSuggestFieldCallback -> m ()
setTypeFindSuggest TypeFind
s FunPtr C_TypeFindSuggestFieldCallback
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (FunPtr C_TypeFindSuggestFieldCallback)
-> FunPtr C_TypeFindSuggestFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr C_TypeFindSuggestFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (FunPtr C_TypeFindSuggestFieldCallback
val :: FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)

-- | Set the value of the “@suggest@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #suggest
-- @
clearTypeFindSuggest :: MonadIO m => TypeFind -> m ()
clearTypeFindSuggest :: TypeFind -> m ()
clearTypeFindSuggest TypeFind
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (FunPtr C_TypeFindSuggestFieldCallback)
-> FunPtr C_TypeFindSuggestFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr C_TypeFindSuggestFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (FunPtr C_TypeFindSuggestFieldCallback
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_TypeFindSuggestFieldCallback)

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

typeFind_suggest :: AttrLabelProxy "suggest"
typeFind_suggest = AttrLabelProxy

#endif


-- | Get the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' typeFind #data
-- @
getTypeFindData :: MonadIO m => TypeFind -> m (Ptr ())
getTypeFindData :: TypeFind -> m (Ptr ())
getTypeFindData TypeFind
s = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO (Ptr ())) -> IO (Ptr ())
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr TypeFind -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr ()
val <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr ())
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
val

-- | Set the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' typeFind [ #data 'Data.GI.Base.Attributes.:=' value ]
-- @
setTypeFindData :: MonadIO m => TypeFind -> Ptr () -> m ()
setTypeFindData :: TypeFind -> Ptr () -> m ()
setTypeFindData TypeFind
s Ptr ()
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr ()
val :: Ptr ())

-- | Set the value of the “@data@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #data
-- @
clearTypeFindData :: MonadIO m => TypeFind -> m ()
clearTypeFindData :: TypeFind -> m ()
clearTypeFindData TypeFind
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

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

typeFind_data :: AttrLabelProxy "data"
typeFind_data = AttrLabelProxy

#endif


-- | Get the value of the “@get_length@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' typeFind #getLength
-- @
getTypeFindGetLength :: MonadIO m => TypeFind -> m (Maybe Gst.Callbacks.TypeFindGetLengthFieldCallback)
getTypeFindGetLength :: TypeFind -> m (Maybe TypeFindGetLengthFieldCallback)
getTypeFindGetLength TypeFind
s = IO (Maybe TypeFindGetLengthFieldCallback)
-> m (Maybe TypeFindGetLengthFieldCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TypeFindGetLengthFieldCallback)
 -> m (Maybe TypeFindGetLengthFieldCallback))
-> IO (Maybe TypeFindGetLengthFieldCallback)
-> m (Maybe TypeFindGetLengthFieldCallback)
forall a b. (a -> b) -> a -> b
$ TypeFind
-> (Ptr TypeFind -> IO (Maybe TypeFindGetLengthFieldCallback))
-> IO (Maybe TypeFindGetLengthFieldCallback)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO (Maybe TypeFindGetLengthFieldCallback))
 -> IO (Maybe TypeFindGetLengthFieldCallback))
-> (Ptr TypeFind -> IO (Maybe TypeFindGetLengthFieldCallback))
-> IO (Maybe TypeFindGetLengthFieldCallback)
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    FunPtr TypeFindGetLengthFieldCallback
val <- Ptr (FunPtr TypeFindGetLengthFieldCallback)
-> IO (FunPtr TypeFindGetLengthFieldCallback)
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr TypeFindGetLengthFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)
    Maybe TypeFindGetLengthFieldCallback
result <- FunPtr TypeFindGetLengthFieldCallback
-> (FunPtr TypeFindGetLengthFieldCallback
    -> IO TypeFindGetLengthFieldCallback)
-> IO (Maybe TypeFindGetLengthFieldCallback)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr TypeFindGetLengthFieldCallback
val ((FunPtr TypeFindGetLengthFieldCallback
  -> IO TypeFindGetLengthFieldCallback)
 -> IO (Maybe TypeFindGetLengthFieldCallback))
-> (FunPtr TypeFindGetLengthFieldCallback
    -> IO TypeFindGetLengthFieldCallback)
-> IO (Maybe TypeFindGetLengthFieldCallback)
forall a b. (a -> b) -> a -> b
$ \FunPtr TypeFindGetLengthFieldCallback
val' -> do
        let val'' :: TypeFindGetLengthFieldCallback
val'' = FunPtr TypeFindGetLengthFieldCallback
-> TypeFindGetLengthFieldCallback
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr TypeFindGetLengthFieldCallback -> Ptr () -> m Word64
Gst.Callbacks.dynamic_TypeFindGetLengthFieldCallback FunPtr TypeFindGetLengthFieldCallback
val'
        TypeFindGetLengthFieldCallback -> IO TypeFindGetLengthFieldCallback
forall (m :: * -> *) a. Monad m => a -> m a
return TypeFindGetLengthFieldCallback
val''
    Maybe TypeFindGetLengthFieldCallback
-> IO (Maybe TypeFindGetLengthFieldCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TypeFindGetLengthFieldCallback
result

-- | Set the value of the “@get_length@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' typeFind [ #getLength 'Data.GI.Base.Attributes.:=' value ]
-- @
setTypeFindGetLength :: MonadIO m => TypeFind -> FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback -> m ()
setTypeFindGetLength :: TypeFind -> FunPtr TypeFindGetLengthFieldCallback -> m ()
setTypeFindGetLength TypeFind
s FunPtr TypeFindGetLengthFieldCallback
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (FunPtr TypeFindGetLengthFieldCallback)
-> FunPtr TypeFindGetLengthFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr TypeFindGetLengthFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (FunPtr TypeFindGetLengthFieldCallback
val :: FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)

-- | Set the value of the “@get_length@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #getLength
-- @
clearTypeFindGetLength :: MonadIO m => TypeFind -> m ()
clearTypeFindGetLength :: TypeFind -> m ()
clearTypeFindGetLength TypeFind
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeFind -> (Ptr TypeFind -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeFind
s ((Ptr TypeFind -> IO ()) -> IO ())
-> (Ptr TypeFind -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeFind
ptr -> do
    Ptr (FunPtr TypeFindGetLengthFieldCallback)
-> FunPtr TypeFindGetLengthFieldCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeFind
ptr Ptr TypeFind -> Int -> Ptr (FunPtr TypeFindGetLengthFieldCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (FunPtr TypeFindGetLengthFieldCallback
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_TypeFindGetLengthFieldCallback)

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

typeFind_getLength :: AttrLabelProxy "getLength"
typeFind_getLength = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
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 t'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 :: TypeFind -> m Word64
typeFindGetLength TypeFind
find = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeFind
find' <- TypeFind -> IO (Ptr TypeFind)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeFind
find
    Word64
result <- Ptr TypeFind -> IO Word64
gst_type_find_get_length Ptr TypeFind
find'
    TypeFind -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeFind
find
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
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 t'GI.Gst.Structs.TypeFind.TypeFind' object the function was called with
    -> Int64
    -- ^ /@offset@/: The offset
    -> m (Maybe ByteString)
    -- ^ __Returns:__ the
    --     requested data, or 'P.Nothing' if that data is not available.
typeFindPeek :: TypeFind -> Int64 -> m (Maybe ByteString)
typeFindPeek TypeFind
find Int64
offset = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeFind
find' <- TypeFind -> IO (Ptr TypeFind)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeFind
find
    Ptr Word32
size <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word8
result <- Ptr TypeFind -> Int64 -> Ptr Word32 -> IO (Ptr Word8)
gst_type_find_peek Ptr TypeFind
find' Int64
offset Ptr Word32
size
    Word32
size' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
size
    Maybe ByteString
maybeResult <- Ptr Word8 -> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Word8
result ((Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr Word8 -> IO ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
result' -> do
        ByteString
result'' <- (Word32 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word32
size') Ptr Word8
result'
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result''
    TypeFind -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeFind
find
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
size
    Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
maybeResult

#if defined(ENABLE_OVERLOADING)
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 t'GI.Gst.Callbacks.TypeFindFunction' calls this function it suggests the caps with the
-- given probability. A t'GI.Gst.Callbacks.TypeFindFunction' may supply different suggestions
-- in one call.
-- It is up to the caller of the t'GI.Gst.Callbacks.TypeFindFunction' to interpret these values.
typeFindSuggest ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeFind
    -- ^ /@find@/: The t'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 t'GI.Gst.Structs.Caps.Caps' to suggest
    -> m ()
typeFindSuggest :: TypeFind -> Word32 -> Caps -> m ()
typeFindSuggest TypeFind
find Word32
probability Caps
caps = 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 TypeFind
find' <- TypeFind -> IO (Ptr TypeFind)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeFind
find
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr TypeFind -> Word32 -> Ptr Caps -> IO ()
gst_type_find_suggest Ptr TypeFind
find' Word32
probability Ptr Caps
caps'
    TypeFind -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeFind
find
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
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 t'GI.Gst.Objects.Plugin.Plugin', or 'P.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 t'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:__ 'P.True' on success, 'P.False' otherwise
typeFindRegister :: Maybe a
-> Text
-> Word32
-> (TypeFind -> IO ())
-> Maybe Text
-> Caps
-> m Bool
typeFindRegister Maybe a
plugin Text
name Word32
rank TypeFind -> IO ()
func Maybe Text
extensions Caps
possibleCaps = 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
maybePlugin <- case Maybe a
plugin of
        Maybe a
Nothing -> Ptr Plugin -> IO (Ptr Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Plugin
forall a. Ptr a
nullPtr
        Just a
jPlugin -> do
            Ptr Plugin
jPlugin' <- a -> IO (Ptr Plugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPlugin
            Ptr Plugin -> IO (Ptr Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Plugin
jPlugin'
    CString
name' <- Text -> IO CString
textToCString Text
name
    FunPtr C_TypeFindFunction
func' <- C_TypeFindFunction -> IO (FunPtr C_TypeFindFunction)
Gst.Callbacks.mk_TypeFindFunction (Maybe (Ptr (FunPtr C_TypeFindFunction))
-> TypeFindFunction_WithClosures -> C_TypeFindFunction
Gst.Callbacks.wrap_TypeFindFunction Maybe (Ptr (FunPtr C_TypeFindFunction))
forall a. Maybe a
Nothing ((TypeFind -> IO ()) -> TypeFindFunction_WithClosures
Gst.Callbacks.drop_closures_TypeFindFunction TypeFind -> IO ()
func))
    CString
maybeExtensions <- case Maybe Text
extensions of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jExtensions -> do
            CString
jExtensions' <- Text -> IO CString
textToCString Text
jExtensions
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jExtensions'
    Ptr Caps
possibleCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
possibleCaps
    let data_ :: Ptr ()
data_ = FunPtr C_TypeFindFunction -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TypeFindFunction
func'
    let dataNotify :: FunPtr (Ptr a -> IO ())
dataNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    CInt
result <- Ptr Plugin
-> CString
-> Word32
-> FunPtr C_TypeFindFunction
-> CString
-> Ptr Caps
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO CInt
gst_type_find_register Ptr Plugin
maybePlugin CString
name' Word32
rank FunPtr C_TypeFindFunction
func' CString
maybeExtensions Ptr Caps
possibleCaps' Ptr ()
data_ FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
dataNotify
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
plugin a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
possibleCaps
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExtensions
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
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) => OL.IsLabel t (TypeFind -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif