{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gst.Structs.MiniObject.MiniObject' is a simple structure that can be used to implement refcounted
-- types.
-- 
-- Subclasses will include t'GI.Gst.Structs.MiniObject.MiniObject' as the first member in their structure
-- and then call @/gst_mini_object_init()/@ to initialize the t'GI.Gst.Structs.MiniObject.MiniObject' fields.
-- 
-- @/gst_mini_object_ref()/@ and @/gst_mini_object_unref()/@ increment and decrement the
-- refcount respectively. When the refcount of a mini-object reaches 0, the
-- dispose function is called first and when this returns 'P.True', the free
-- function of the miniobject is called.
-- 
-- A copy can be made with @/gst_mini_object_copy()/@.
-- 
-- 'GI.Gst.Structs.MiniObject.miniObjectIsWritable' will return 'P.True' when the refcount of the
-- object is exactly 1 and there is no parent or a single parent exists and is
-- writable itself, meaning the current caller has the only reference to the
-- object. @/gst_mini_object_make_writable()/@ will return a writable version of
-- the object, which might be a new copy when the refcount was not 1.
-- 
-- Opaque data can be associated with a t'GI.Gst.Structs.MiniObject.MiniObject' with
-- 'GI.Gst.Structs.MiniObject.miniObjectSetQdata' and 'GI.Gst.Structs.MiniObject.miniObjectGetQdata'. The data is
-- meant to be specific to the particular object and is not automatically copied
-- with @/gst_mini_object_copy()/@ or similar methods.
-- 
-- A weak reference can be added and remove with @/gst_mini_object_weak_ref()/@
-- and @/gst_mini_object_weak_unref()/@ respectively.

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

module GI.Gst.Structs.MiniObject
    ( 

-- * Exported types
    MiniObject(..)                          ,
    newZeroMiniObject                       ,
    noMiniObject                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMiniObjectMethod                 ,
#endif


-- ** addParent #method:addParent#

#if defined(ENABLE_OVERLOADING)
    MiniObjectAddParentMethodInfo           ,
#endif
    miniObjectAddParent                     ,


-- ** getQdata #method:getQdata#

#if defined(ENABLE_OVERLOADING)
    MiniObjectGetQdataMethodInfo            ,
#endif
    miniObjectGetQdata                      ,


-- ** isWritable #method:isWritable#

#if defined(ENABLE_OVERLOADING)
    MiniObjectIsWritableMethodInfo          ,
#endif
    miniObjectIsWritable                    ,


-- ** lock #method:lock#

#if defined(ENABLE_OVERLOADING)
    MiniObjectLockMethodInfo                ,
#endif
    miniObjectLock                          ,


-- ** removeParent #method:removeParent#

#if defined(ENABLE_OVERLOADING)
    MiniObjectRemoveParentMethodInfo        ,
#endif
    miniObjectRemoveParent                  ,


-- ** setQdata #method:setQdata#

#if defined(ENABLE_OVERLOADING)
    MiniObjectSetQdataMethodInfo            ,
#endif
    miniObjectSetQdata                      ,


-- ** stealQdata #method:stealQdata#

#if defined(ENABLE_OVERLOADING)
    MiniObjectStealQdataMethodInfo          ,
#endif
    miniObjectStealQdata                    ,


-- ** unlock #method:unlock#

#if defined(ENABLE_OVERLOADING)
    MiniObjectUnlockMethodInfo              ,
#endif
    miniObjectUnlock                        ,




 -- * Properties
-- ** dispose #attr:dispose#
-- | a dispose function

    clearMiniObjectDispose                  ,
    getMiniObjectDispose                    ,
#if defined(ENABLE_OVERLOADING)
    miniObject_dispose                      ,
#endif
    setMiniObjectDispose                    ,


-- ** flags #attr:flags#
-- | extra flags.

    getMiniObjectFlags                      ,
#if defined(ENABLE_OVERLOADING)
    miniObject_flags                        ,
#endif
    setMiniObjectFlags                      ,


-- ** free #attr:free#
-- | the free function

    clearMiniObjectFree                     ,
    getMiniObjectFree                       ,
#if defined(ENABLE_OVERLOADING)
    miniObject_free                         ,
#endif
    setMiniObjectFree                       ,


-- ** lockstate #attr:lockstate#
-- | atomic state of the locks

    getMiniObjectLockstate                  ,
#if defined(ENABLE_OVERLOADING)
    miniObject_lockstate                    ,
#endif
    setMiniObjectLockstate                  ,


-- ** refcount #attr:refcount#
-- | atomic refcount

    getMiniObjectRefcount                   ,
#if defined(ENABLE_OVERLOADING)
    miniObject_refcount                     ,
#endif
    setMiniObjectRefcount                   ,


-- ** type #attr:type#
-- | the GType of the object

    getMiniObjectType                       ,
#if defined(ENABLE_OVERLOADING)
    miniObject_type                         ,
#endif
    setMiniObjectType                       ,




    ) 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.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 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.Flags as Gst.Flags

-- | Memory-managed wrapper type.
newtype MiniObject = MiniObject (ManagedPtr MiniObject)
    deriving (MiniObject -> MiniObject -> Bool
(MiniObject -> MiniObject -> Bool)
-> (MiniObject -> MiniObject -> Bool) -> Eq MiniObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiniObject -> MiniObject -> Bool
$c/= :: MiniObject -> MiniObject -> Bool
== :: MiniObject -> MiniObject -> Bool
$c== :: MiniObject -> MiniObject -> Bool
Eq)
instance WrappedPtr MiniObject where
    wrappedPtrCalloc :: IO (Ptr MiniObject)
wrappedPtrCalloc = Int -> IO (Ptr MiniObject)
forall a. Int -> IO (Ptr a)
callocBytes 64
    wrappedPtrCopy :: MiniObject -> IO MiniObject
wrappedPtrCopy = \p :: MiniObject
p -> MiniObject -> (Ptr MiniObject -> IO MiniObject) -> IO MiniObject
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MiniObject
p (Int -> Ptr MiniObject -> IO (Ptr MiniObject)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 64 (Ptr MiniObject -> IO (Ptr MiniObject))
-> (Ptr MiniObject -> IO MiniObject)
-> Ptr MiniObject
-> IO MiniObject
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr MiniObject -> MiniObject)
-> Ptr MiniObject -> IO MiniObject
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr MiniObject -> MiniObject
MiniObject)
    wrappedPtrFree :: Maybe (GDestroyNotify MiniObject)
wrappedPtrFree = GDestroyNotify MiniObject -> Maybe (GDestroyNotify MiniObject)
forall a. a -> Maybe a
Just GDestroyNotify MiniObject
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `MiniObject` struct initialized to zero.
newZeroMiniObject :: MonadIO m => m MiniObject
newZeroMiniObject :: m MiniObject
newZeroMiniObject = IO MiniObject -> m MiniObject
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MiniObject -> m MiniObject) -> IO MiniObject -> m MiniObject
forall a b. (a -> b) -> a -> b
$ IO (Ptr MiniObject)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr MiniObject)
-> (Ptr MiniObject -> IO MiniObject) -> IO MiniObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr MiniObject -> MiniObject)
-> Ptr MiniObject -> IO MiniObject
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr MiniObject -> MiniObject
MiniObject

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


-- | A convenience alias for `Nothing` :: `Maybe` `MiniObject`.
noMiniObject :: Maybe MiniObject
noMiniObject :: Maybe MiniObject
noMiniObject = Maybe MiniObject
forall a. Maybe a
Nothing

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

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

#if defined(ENABLE_OVERLOADING)
data MiniObjectTypeFieldInfo
instance AttrInfo MiniObjectTypeFieldInfo where
    type AttrBaseTypeConstraint MiniObjectTypeFieldInfo = (~) MiniObject
    type AttrAllowedOps MiniObjectTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MiniObjectTypeFieldInfo = (~) GType
    type AttrTransferTypeConstraint MiniObjectTypeFieldInfo = (~)GType
    type AttrTransferType MiniObjectTypeFieldInfo = GType
    type AttrGetType MiniObjectTypeFieldInfo = GType
    type AttrLabel MiniObjectTypeFieldInfo = "type"
    type AttrOrigin MiniObjectTypeFieldInfo = MiniObject
    attrGet = getMiniObjectType
    attrSet = setMiniObjectType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

miniObject_type :: AttrLabelProxy "type"
miniObject_type = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MiniObjectRefcountFieldInfo
instance AttrInfo MiniObjectRefcountFieldInfo where
    type AttrBaseTypeConstraint MiniObjectRefcountFieldInfo = (~) MiniObject
    type AttrAllowedOps MiniObjectRefcountFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MiniObjectRefcountFieldInfo = (~) Int32
    type AttrTransferTypeConstraint MiniObjectRefcountFieldInfo = (~)Int32
    type AttrTransferType MiniObjectRefcountFieldInfo = Int32
    type AttrGetType MiniObjectRefcountFieldInfo = Int32
    type AttrLabel MiniObjectRefcountFieldInfo = "refcount"
    type AttrOrigin MiniObjectRefcountFieldInfo = MiniObject
    attrGet = getMiniObjectRefcount
    attrSet = setMiniObjectRefcount
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

miniObject_refcount :: AttrLabelProxy "refcount"
miniObject_refcount = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MiniObjectLockstateFieldInfo
instance AttrInfo MiniObjectLockstateFieldInfo where
    type AttrBaseTypeConstraint MiniObjectLockstateFieldInfo = (~) MiniObject
    type AttrAllowedOps MiniObjectLockstateFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MiniObjectLockstateFieldInfo = (~) Int32
    type AttrTransferTypeConstraint MiniObjectLockstateFieldInfo = (~)Int32
    type AttrTransferType MiniObjectLockstateFieldInfo = Int32
    type AttrGetType MiniObjectLockstateFieldInfo = Int32
    type AttrLabel MiniObjectLockstateFieldInfo = "lockstate"
    type AttrOrigin MiniObjectLockstateFieldInfo = MiniObject
    attrGet = getMiniObjectLockstate
    attrSet = setMiniObjectLockstate
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

miniObject_lockstate :: AttrLabelProxy "lockstate"
miniObject_lockstate = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MiniObjectFlagsFieldInfo
instance AttrInfo MiniObjectFlagsFieldInfo where
    type AttrBaseTypeConstraint MiniObjectFlagsFieldInfo = (~) MiniObject
    type AttrAllowedOps MiniObjectFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MiniObjectFlagsFieldInfo = (~) Word32
    type AttrTransferTypeConstraint MiniObjectFlagsFieldInfo = (~)Word32
    type AttrTransferType MiniObjectFlagsFieldInfo = Word32
    type AttrGetType MiniObjectFlagsFieldInfo = Word32
    type AttrLabel MiniObjectFlagsFieldInfo = "flags"
    type AttrOrigin MiniObjectFlagsFieldInfo = MiniObject
    attrGet = getMiniObjectFlags
    attrSet = setMiniObjectFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

miniObject_flags :: AttrLabelProxy "flags"
miniObject_flags = AttrLabelProxy

#endif


-- | Get the value of the “@dispose@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' miniObject #dispose
-- @
getMiniObjectDispose :: MonadIO m => MiniObject -> m (Maybe Gst.Callbacks.MiniObjectDisposeFunction)
getMiniObjectDispose :: MiniObject -> m (Maybe MiniObjectDisposeFunction)
getMiniObjectDispose s :: MiniObject
s = IO (Maybe MiniObjectDisposeFunction)
-> m (Maybe MiniObjectDisposeFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MiniObjectDisposeFunction)
 -> m (Maybe MiniObjectDisposeFunction))
-> IO (Maybe MiniObjectDisposeFunction)
-> m (Maybe MiniObjectDisposeFunction)
forall a b. (a -> b) -> a -> b
$ MiniObject
-> (Ptr MiniObject -> IO (Maybe MiniObjectDisposeFunction))
-> IO (Maybe MiniObjectDisposeFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MiniObject
s ((Ptr MiniObject -> IO (Maybe MiniObjectDisposeFunction))
 -> IO (Maybe MiniObjectDisposeFunction))
-> (Ptr MiniObject -> IO (Maybe MiniObjectDisposeFunction))
-> IO (Maybe MiniObjectDisposeFunction)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MiniObject
ptr -> do
    FunPtr C_MiniObjectDisposeFunction
val <- Ptr (FunPtr C_MiniObjectDisposeFunction)
-> IO (FunPtr C_MiniObjectDisposeFunction)
forall a. Storable a => Ptr a -> IO a
peek (Ptr MiniObject
ptr Ptr MiniObject -> Int -> Ptr (FunPtr C_MiniObjectDisposeFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) :: IO (FunPtr Gst.Callbacks.C_MiniObjectDisposeFunction)
    Maybe MiniObjectDisposeFunction
result <- FunPtr C_MiniObjectDisposeFunction
-> (FunPtr C_MiniObjectDisposeFunction
    -> IO MiniObjectDisposeFunction)
-> IO (Maybe MiniObjectDisposeFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_MiniObjectDisposeFunction
val ((FunPtr C_MiniObjectDisposeFunction
  -> IO MiniObjectDisposeFunction)
 -> IO (Maybe MiniObjectDisposeFunction))
-> (FunPtr C_MiniObjectDisposeFunction
    -> IO MiniObjectDisposeFunction)
-> IO (Maybe MiniObjectDisposeFunction)
forall a b. (a -> b) -> a -> b
$ \val' :: FunPtr C_MiniObjectDisposeFunction
val' -> do
        let val'' :: MiniObjectDisposeFunction
val'' = FunPtr C_MiniObjectDisposeFunction -> MiniObjectDisposeFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_MiniObjectDisposeFunction -> MiniObject -> m Bool
Gst.Callbacks.dynamic_MiniObjectDisposeFunction FunPtr C_MiniObjectDisposeFunction
val'
        MiniObjectDisposeFunction -> IO MiniObjectDisposeFunction
forall (m :: * -> *) a. Monad m => a -> m a
return MiniObjectDisposeFunction
val''
    Maybe MiniObjectDisposeFunction
-> IO (Maybe MiniObjectDisposeFunction)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MiniObjectDisposeFunction
result

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

-- | Set the value of the “@dispose@” 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' #dispose
-- @
clearMiniObjectDispose :: MonadIO m => MiniObject -> m ()
clearMiniObjectDispose :: MiniObject -> m ()
clearMiniObjectDispose s :: MiniObject
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MiniObject -> (Ptr MiniObject -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MiniObject
s ((Ptr MiniObject -> IO ()) -> IO ())
-> (Ptr MiniObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MiniObject
ptr -> do
    Ptr (FunPtr C_MiniObjectDisposeFunction)
-> FunPtr C_MiniObjectDisposeFunction -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MiniObject
ptr Ptr MiniObject -> Int -> Ptr (FunPtr C_MiniObjectDisposeFunction)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) (FunPtr C_MiniObjectDisposeFunction
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_MiniObjectDisposeFunction)

#if defined(ENABLE_OVERLOADING)
data MiniObjectDisposeFieldInfo
instance AttrInfo MiniObjectDisposeFieldInfo where
    type AttrBaseTypeConstraint MiniObjectDisposeFieldInfo = (~) MiniObject
    type AttrAllowedOps MiniObjectDisposeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MiniObjectDisposeFieldInfo = (~) (FunPtr Gst.Callbacks.C_MiniObjectDisposeFunction)
    type AttrTransferTypeConstraint MiniObjectDisposeFieldInfo = (~)Gst.Callbacks.MiniObjectDisposeFunction
    type AttrTransferType MiniObjectDisposeFieldInfo = (FunPtr Gst.Callbacks.C_MiniObjectDisposeFunction)
    type AttrGetType MiniObjectDisposeFieldInfo = Maybe Gst.Callbacks.MiniObjectDisposeFunction
    type AttrLabel MiniObjectDisposeFieldInfo = "dispose"
    type AttrOrigin MiniObjectDisposeFieldInfo = MiniObject
    attrGet = getMiniObjectDispose
    attrSet = setMiniObjectDispose
    attrConstruct = undefined
    attrClear = clearMiniObjectDispose
    attrTransfer _ v = do
        Gst.Callbacks.mk_MiniObjectDisposeFunction (Gst.Callbacks.wrap_MiniObjectDisposeFunction Nothing v)

miniObject_dispose :: AttrLabelProxy "dispose"
miniObject_dispose = AttrLabelProxy

#endif


-- | Get the value of the “@free@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' miniObject #free
-- @
getMiniObjectFree :: MonadIO m => MiniObject -> m (Maybe Gst.Callbacks.MiniObjectFreeFunction)
getMiniObjectFree :: MiniObject -> m (Maybe MiniObjectFreeFunction)
getMiniObjectFree s :: MiniObject
s = IO (Maybe MiniObjectFreeFunction)
-> m (Maybe MiniObjectFreeFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MiniObjectFreeFunction)
 -> m (Maybe MiniObjectFreeFunction))
-> IO (Maybe MiniObjectFreeFunction)
-> m (Maybe MiniObjectFreeFunction)
forall a b. (a -> b) -> a -> b
$ MiniObject
-> (Ptr MiniObject -> IO (Maybe MiniObjectFreeFunction))
-> IO (Maybe MiniObjectFreeFunction)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MiniObject
s ((Ptr MiniObject -> IO (Maybe MiniObjectFreeFunction))
 -> IO (Maybe MiniObjectFreeFunction))
-> (Ptr MiniObject -> IO (Maybe MiniObjectFreeFunction))
-> IO (Maybe MiniObjectFreeFunction)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MiniObject
ptr -> do
    GDestroyNotify MiniObject
val <- Ptr (GDestroyNotify MiniObject) -> IO (GDestroyNotify MiniObject)
forall a. Storable a => Ptr a -> IO a
peek (Ptr MiniObject
ptr Ptr MiniObject -> Int -> Ptr (GDestroyNotify MiniObject)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) :: IO (FunPtr Gst.Callbacks.C_MiniObjectFreeFunction)
    Maybe MiniObjectFreeFunction
result <- GDestroyNotify MiniObject
-> (GDestroyNotify MiniObject -> IO MiniObjectFreeFunction)
-> IO (Maybe MiniObjectFreeFunction)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull GDestroyNotify MiniObject
val ((GDestroyNotify MiniObject -> IO MiniObjectFreeFunction)
 -> IO (Maybe MiniObjectFreeFunction))
-> (GDestroyNotify MiniObject -> IO MiniObjectFreeFunction)
-> IO (Maybe MiniObjectFreeFunction)
forall a b. (a -> b) -> a -> b
$ \val' :: GDestroyNotify MiniObject
val' -> do
        let val'' :: MiniObjectFreeFunction
val'' = GDestroyNotify MiniObject -> MiniObjectFreeFunction
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GDestroyNotify MiniObject -> MiniObject -> m ()
Gst.Callbacks.dynamic_MiniObjectFreeFunction GDestroyNotify MiniObject
val'
        MiniObjectFreeFunction -> IO MiniObjectFreeFunction
forall (m :: * -> *) a. Monad m => a -> m a
return MiniObjectFreeFunction
val''
    Maybe MiniObjectFreeFunction -> IO (Maybe MiniObjectFreeFunction)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MiniObjectFreeFunction
result

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

-- | Set the value of the “@free@” 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' #free
-- @
clearMiniObjectFree :: MonadIO m => MiniObject -> m ()
clearMiniObjectFree :: MiniObject -> m ()
clearMiniObjectFree s :: MiniObject
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MiniObject -> (Ptr MiniObject -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MiniObject
s ((Ptr MiniObject -> IO ()) -> IO ())
-> (Ptr MiniObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MiniObject
ptr -> do
    Ptr (GDestroyNotify MiniObject)
-> GDestroyNotify MiniObject -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MiniObject
ptr Ptr MiniObject -> Int -> Ptr (GDestroyNotify MiniObject)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40) (GDestroyNotify MiniObject
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_MiniObjectFreeFunction)

#if defined(ENABLE_OVERLOADING)
data MiniObjectFreeFieldInfo
instance AttrInfo MiniObjectFreeFieldInfo where
    type AttrBaseTypeConstraint MiniObjectFreeFieldInfo = (~) MiniObject
    type AttrAllowedOps MiniObjectFreeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MiniObjectFreeFieldInfo = (~) (FunPtr Gst.Callbacks.C_MiniObjectFreeFunction)
    type AttrTransferTypeConstraint MiniObjectFreeFieldInfo = (~)Gst.Callbacks.MiniObjectFreeFunction
    type AttrTransferType MiniObjectFreeFieldInfo = (FunPtr Gst.Callbacks.C_MiniObjectFreeFunction)
    type AttrGetType MiniObjectFreeFieldInfo = Maybe Gst.Callbacks.MiniObjectFreeFunction
    type AttrLabel MiniObjectFreeFieldInfo = "free"
    type AttrOrigin MiniObjectFreeFieldInfo = MiniObject
    attrGet = getMiniObjectFree
    attrSet = setMiniObjectFree
    attrConstruct = undefined
    attrClear = clearMiniObjectFree
    attrTransfer _ v = do
        Gst.Callbacks.mk_MiniObjectFreeFunction (Gst.Callbacks.wrap_MiniObjectFreeFunction Nothing v)

miniObject_free :: AttrLabelProxy "free"
miniObject_free = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MiniObject
type instance O.AttributeList MiniObject = MiniObjectAttributeList
type MiniObjectAttributeList = ('[ '("type", MiniObjectTypeFieldInfo), '("refcount", MiniObjectRefcountFieldInfo), '("lockstate", MiniObjectLockstateFieldInfo), '("flags", MiniObjectFlagsFieldInfo), '("dispose", MiniObjectDisposeFieldInfo), '("free", MiniObjectFreeFieldInfo)] :: [(Symbol, *)])
#endif

-- method MiniObject::add_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMiniObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a parent #GstMiniObject"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_mini_object_add_parent" gst_mini_object_add_parent :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    Ptr MiniObject ->                       -- parent : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    IO ()

-- | This adds /@parent@/ as a parent for /@object@/. Having one ore more parents affects the
-- writability of /@object@/: if a /@parent@/ is not writable, /@object@/ is also not
-- writable, regardless of its refcount. /@object@/ is only writable if all
-- the parents are writable and its own refcount is exactly 1.
-- 
-- Note: This function does not take ownership of /@parent@/ and also does not
-- take an additional reference. It is the responsibility of the caller to
-- remove the parent again at a later time.
-- 
-- /Since: 1.16/
miniObjectAddParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: a t'GI.Gst.Structs.MiniObject.MiniObject'
    -> MiniObject
    -- ^ /@parent@/: a parent t'GI.Gst.Structs.MiniObject.MiniObject'
    -> m ()
miniObjectAddParent :: MiniObject -> MiniObject -> m ()
miniObjectAddParent object :: MiniObject
object parent :: MiniObject
parent = 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 MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    Ptr MiniObject
parent' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
parent
    Ptr MiniObject -> Ptr MiniObject -> IO ()
gst_mini_object_add_parent Ptr MiniObject
object' Ptr MiniObject
parent'
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
parent
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MiniObjectAddParentMethodInfo
instance (signature ~ (MiniObject -> m ()), MonadIO m) => O.MethodInfo MiniObjectAddParentMethodInfo MiniObject signature where
    overloadedMethod = miniObjectAddParent

#endif

-- method MiniObject::get_qdata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The GstMiniObject to get a stored user data pointer from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "quark"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GQuark, naming the user data pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gst_mini_object_get_qdata" gst_mini_object_get_qdata :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    Word32 ->                               -- quark : TBasicType TUInt32
    IO (Ptr ())

-- | This function gets back user data pointers stored via
-- 'GI.Gst.Structs.MiniObject.miniObjectSetQdata'.
miniObjectGetQdata ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: The GstMiniObject to get a stored user data pointer from
    -> Word32
    -- ^ /@quark@/: A @/GQuark/@, naming the user data pointer
    -> m (Ptr ())
    -- ^ __Returns:__ The user data pointer set, or
    -- 'P.Nothing'
miniObjectGetQdata :: MiniObject -> Word32 -> m (Ptr ())
miniObjectGetQdata object :: MiniObject
object quark :: Word32
quark = 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
$ do
    Ptr MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    Ptr ()
result <- Ptr MiniObject -> Word32 -> IO (Ptr ())
gst_mini_object_get_qdata Ptr MiniObject
object' Word32
quark
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data MiniObjectGetQdataMethodInfo
instance (signature ~ (Word32 -> m (Ptr ())), MonadIO m) => O.MethodInfo MiniObjectGetQdataMethodInfo MiniObject signature where
    overloadedMethod = miniObjectGetQdata

#endif

-- method MiniObject::is_writable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mini_object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mini-object to check"
--                 , 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_mini_object_is_writable" gst_mini_object_is_writable :: 
    Ptr MiniObject ->                       -- mini_object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    IO CInt

-- | If /@miniObject@/ has the LOCKABLE flag set, check if the current EXCLUSIVE
-- lock on /@object@/ is the only one, this means that changes to the object will
-- not be visible to any other object.
-- 
-- If the LOCKABLE flag is not set, check if the refcount of /@miniObject@/ is
-- exactly 1, meaning that no other reference exists to the object and that the
-- object is therefore writable.
-- 
-- Modification of a mini-object should only be done after verifying that it
-- is writable.
miniObjectIsWritable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@miniObject@/: the mini-object to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the object is writable.
miniObjectIsWritable :: MiniObject -> m Bool
miniObjectIsWritable miniObject :: MiniObject
miniObject = 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 MiniObject
miniObject' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
miniObject
    CInt
result <- C_MiniObjectDisposeFunction
gst_mini_object_is_writable Ptr MiniObject
miniObject'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
miniObject
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MiniObjectIsWritableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo MiniObjectIsWritableMethodInfo MiniObject signature where
    overloadedMethod = miniObjectIsWritable

#endif

-- method MiniObject::lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mini-object to lock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "LockFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstLockFlags" , 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_mini_object_lock" gst_mini_object_lock :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "LockFlags"})
    IO CInt

-- | Lock the mini-object with the specified access mode in /@flags@/.
miniObjectLock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: the mini-object to lock
    -> [Gst.Flags.LockFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.LockFlags'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@object@/ could be locked.
miniObjectLock :: MiniObject -> [LockFlags] -> m Bool
miniObjectLock object :: MiniObject
object flags :: [LockFlags]
flags = 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 MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    let flags' :: CUInt
flags' = [LockFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [LockFlags]
flags
    CInt
result <- Ptr MiniObject -> CUInt -> IO CInt
gst_mini_object_lock Ptr MiniObject
object' CUInt
flags'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MiniObjectLockMethodInfo
instance (signature ~ ([Gst.Flags.LockFlags] -> m Bool), MonadIO m) => O.MethodInfo MiniObjectLockMethodInfo MiniObject signature where
    overloadedMethod = miniObjectLock

#endif

-- method MiniObject::remove_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMiniObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a parent #GstMiniObject"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_mini_object_remove_parent" gst_mini_object_remove_parent :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    Ptr MiniObject ->                       -- parent : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    IO ()

-- | This removes /@parent@/ as a parent for /@object@/. See
-- 'GI.Gst.Structs.MiniObject.miniObjectAddParent'.
-- 
-- /Since: 1.16/
miniObjectRemoveParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: a t'GI.Gst.Structs.MiniObject.MiniObject'
    -> MiniObject
    -- ^ /@parent@/: a parent t'GI.Gst.Structs.MiniObject.MiniObject'
    -> m ()
miniObjectRemoveParent :: MiniObject -> MiniObject -> m ()
miniObjectRemoveParent object :: MiniObject
object parent :: MiniObject
parent = 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 MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    Ptr MiniObject
parent' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
parent
    Ptr MiniObject -> Ptr MiniObject -> IO ()
gst_mini_object_remove_parent Ptr MiniObject
object' Ptr MiniObject
parent'
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
parent
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MiniObjectRemoveParentMethodInfo
instance (signature ~ (MiniObject -> m ()), MonadIO m) => O.MethodInfo MiniObjectRemoveParentMethodInfo MiniObject signature where
    overloadedMethod = miniObjectRemoveParent

#endif

-- method MiniObject::set_qdata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstMiniObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "quark"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GQuark, naming the user data pointer"
--                 , 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 "An opaque user data pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Function to invoke with @data as argument, when @data\n          needs to be freed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_mini_object_set_qdata" gst_mini_object_set_qdata :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    Word32 ->                               -- quark : TBasicType TUInt32
    Ptr () ->                               -- data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | This sets an opaque, named pointer on a miniobject.
-- The name is specified through a @/GQuark/@ (retrieved e.g. via
-- 'GI.GLib.Functions.quarkFromStaticString'), and the pointer
-- can be gotten back from the /@object@/ with 'GI.Gst.Structs.MiniObject.miniObjectGetQdata'
-- until the /@object@/ is disposed.
-- Setting a previously set user data pointer, overrides (frees)
-- the old pointer set, using 'P.Nothing' as pointer essentially
-- removes the data stored.
-- 
-- /@destroy@/ may be specified which is called with /@data@/ as argument
-- when the /@object@/ is disposed, or the data is being overwritten by
-- a call to 'GI.Gst.Structs.MiniObject.miniObjectSetQdata' with the same /@quark@/.
miniObjectSetQdata ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: a t'GI.Gst.Structs.MiniObject.MiniObject'
    -> Word32
    -- ^ /@quark@/: A @/GQuark/@, naming the user data pointer
    -> Ptr ()
    -- ^ /@data@/: An opaque user data pointer
    -> GLib.Callbacks.DestroyNotify
    -- ^ /@destroy@/: Function to invoke with /@data@/ as argument, when /@data@/
    --           needs to be freed
    -> m ()
miniObjectSetQdata :: MiniObject -> Word32 -> Ptr () -> DestroyNotify -> m ()
miniObjectSetQdata object :: MiniObject
object quark :: Word32
quark data_ :: Ptr ()
data_ destroy :: DestroyNotify
destroy = 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 MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    Ptr (FunPtr DestroyNotify)
ptrdestroy <- IO (Ptr (FunPtr DestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
    FunPtr DestroyNotify
destroy' <- DestroyNotify -> IO (FunPtr DestroyNotify)
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr DestroyNotify))
-> DestroyNotify -> DestroyNotify
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr DestroyNotify) -> Maybe (Ptr (FunPtr DestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr DestroyNotify)
ptrdestroy) DestroyNotify
destroy)
    Ptr (FunPtr DestroyNotify) -> FunPtr DestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr DestroyNotify)
ptrdestroy FunPtr DestroyNotify
destroy'
    Ptr MiniObject -> Word32 -> Ptr () -> FunPtr DestroyNotify -> IO ()
gst_mini_object_set_qdata Ptr MiniObject
object' Word32
quark Ptr ()
data_ FunPtr DestroyNotify
destroy'
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MiniObjectSetQdataMethodInfo
instance (signature ~ (Word32 -> Ptr () -> GLib.Callbacks.DestroyNotify -> m ()), MonadIO m) => O.MethodInfo MiniObjectSetQdataMethodInfo MiniObject signature where
    overloadedMethod = miniObjectSetQdata

#endif

-- method MiniObject::steal_qdata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The GstMiniObject to get a stored user data pointer from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "quark"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GQuark, naming the user data pointer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gst_mini_object_steal_qdata" gst_mini_object_steal_qdata :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    Word32 ->                               -- quark : TBasicType TUInt32
    IO (Ptr ())

-- | This function gets back user data pointers stored via 'GI.Gst.Structs.MiniObject.miniObjectSetQdata'
-- and removes the data from /@object@/ without invoking its @/destroy()/@ function (if
-- any was set).
miniObjectStealQdata ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: The GstMiniObject to get a stored user data pointer from
    -> Word32
    -- ^ /@quark@/: A @/GQuark/@, naming the user data pointer
    -> m (Ptr ())
    -- ^ __Returns:__ The user data pointer set, or
    -- 'P.Nothing'
miniObjectStealQdata :: MiniObject -> Word32 -> m (Ptr ())
miniObjectStealQdata object :: MiniObject
object quark :: Word32
quark = 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
$ do
    Ptr MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    Ptr ()
result <- Ptr MiniObject -> Word32 -> IO (Ptr ())
gst_mini_object_steal_qdata Ptr MiniObject
object' Word32
quark
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data MiniObjectStealQdataMethodInfo
instance (signature ~ (Word32 -> m (Ptr ())), MonadIO m) => O.MethodInfo MiniObjectStealQdataMethodInfo MiniObject signature where
    overloadedMethod = miniObjectStealQdata

#endif

-- method MiniObject::unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "MiniObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mini-object to unlock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "LockFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstLockFlags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_mini_object_unlock" gst_mini_object_unlock :: 
    Ptr MiniObject ->                       -- object : TInterface (Name {namespace = "Gst", name = "MiniObject"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gst", name = "LockFlags"})
    IO ()

-- | Unlock the mini-object with the specified access mode in /@flags@/.
miniObjectUnlock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MiniObject
    -- ^ /@object@/: the mini-object to unlock
    -> [Gst.Flags.LockFlags]
    -- ^ /@flags@/: t'GI.Gst.Flags.LockFlags'
    -> m ()
miniObjectUnlock :: MiniObject -> [LockFlags] -> m ()
miniObjectUnlock object :: MiniObject
object flags :: [LockFlags]
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 MiniObject
object' <- MiniObject -> IO (Ptr MiniObject)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MiniObject
object
    let flags' :: CUInt
flags' = [LockFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [LockFlags]
flags
    Ptr MiniObject -> CUInt -> IO ()
gst_mini_object_unlock Ptr MiniObject
object' CUInt
flags'
    MiniObjectFreeFunction
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MiniObject
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MiniObjectUnlockMethodInfo
instance (signature ~ ([Gst.Flags.LockFlags] -> m ()), MonadIO m) => O.MethodInfo MiniObjectUnlockMethodInfo MiniObject signature where
    overloadedMethod = miniObjectUnlock

#endif

-- XXX Could not generate method MiniObject::replace
-- Error was : Not implemented: "Nullable inout structs not supported"
#if defined(ENABLE_OVERLOADING)
type family ResolveMiniObjectMethod (t :: Symbol) (o :: *) :: * where
    ResolveMiniObjectMethod "addParent" o = MiniObjectAddParentMethodInfo
    ResolveMiniObjectMethod "isWritable" o = MiniObjectIsWritableMethodInfo
    ResolveMiniObjectMethod "lock" o = MiniObjectLockMethodInfo
    ResolveMiniObjectMethod "removeParent" o = MiniObjectRemoveParentMethodInfo
    ResolveMiniObjectMethod "stealQdata" o = MiniObjectStealQdataMethodInfo
    ResolveMiniObjectMethod "unlock" o = MiniObjectUnlockMethodInfo
    ResolveMiniObjectMethod "getQdata" o = MiniObjectGetQdataMethodInfo
    ResolveMiniObjectMethod "setQdata" o = MiniObjectSetQdataMethodInfo
    ResolveMiniObjectMethod l o = O.MethodResolutionFailed l o

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

#endif