{-# 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.Objects.Object.Object' provides a root for the object hierarchy tree filed in by the
-- GStreamer library.  It is currently a thin wrapper on top of
-- t'GI.GObject.Objects.InitiallyUnowned.InitiallyUnowned'. It is an abstract class that is not very usable on its own.
-- 
-- t'GI.Gst.Objects.Object.Object' gives us basic refcounting, parenting functionality and locking.
-- Most of the functions are just extended for special GStreamer needs and can be
-- found under the same name in the base class of t'GI.Gst.Objects.Object.Object' which is t'GI.GObject.Objects.Object.Object'
-- (e.g. 'GI.GObject.Objects.Object.objectRef' becomes 'GI.Gst.Objects.Object.objectRef').
-- 
-- Since t'GI.Gst.Objects.Object.Object' derives from t'GI.GObject.Objects.InitiallyUnowned.InitiallyUnowned', it also inherits the
-- floating reference. Be aware that functions such as 'GI.Gst.Objects.Bin.binAdd' and
-- 'GI.Gst.Objects.Element.elementAddPad' take ownership of the floating reference.
-- 
-- In contrast to t'GI.GObject.Objects.Object.Object' instances, t'GI.Gst.Objects.Object.Object' adds a name property. The functions
-- 'GI.Gst.Objects.Object.objectSetName' and 'GI.Gst.Objects.Object.objectGetName' are used to set\/get the name
-- of the object.
-- 
-- == controlled properties
-- 
-- Controlled properties offers a lightweight way to adjust gobject properties
-- over stream-time. It works by using time-stamped value pairs that are queued
-- for element-properties. At run-time the elements continuously pull value
-- changes for the current stream-time.
-- 
-- What needs to be changed in a t'GI.Gst.Objects.Element.Element'?
-- Very little - it is just two steps to make a plugin controllable!
-- 
--   * mark gobject-properties paramspecs that make sense to be controlled,
--     by GST_PARAM_CONTROLLABLE.
-- 
--   * when processing data (get, chain, loop function) at the beginning call
--     gst_object_sync_values(element,timestamp).
--     This will make the controller update all GObject properties that are
--     under its control with the current values based on the timestamp.
-- 
-- What needs to be done in applications? Again it\'s not a lot to change.
-- 
--   * create a t'GI.Gst.Objects.ControlSource.ControlSource'.
--     csource = gst_interpolation_control_source_new ();
--     g_object_set (csource, \"mode\", GST_INTERPOLATION_MODE_LINEAR, NULL);
-- 
--   * Attach the t'GI.Gst.Objects.ControlSource.ControlSource' on the controller to a property.
--     gst_object_add_control_binding (object, gst_direct_control_binding_new (object, \"prop1\", csource));
-- 
--   * Set the control values
--     gst_timed_value_control_source_set ((GstTimedValueControlSource *)csource,0 * GST_SECOND, value1);
--     gst_timed_value_control_source_set ((GstTimedValueControlSource *)csource,1 * GST_SECOND, value2);
-- 
--   * start your pipeline

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

module GI.Gst.Objects.Object
    ( 

-- * Exported types
    Object(..)                              ,
    IsObject                                ,
    toObject                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveObjectMethod                     ,
#endif


-- ** addControlBinding #method:addControlBinding#

#if defined(ENABLE_OVERLOADING)
    ObjectAddControlBindingMethodInfo       ,
#endif
    objectAddControlBinding                 ,


-- ** checkUniqueness #method:checkUniqueness#

    objectCheckUniqueness                   ,


-- ** defaultDeepNotify #method:defaultDeepNotify#

    objectDefaultDeepNotify                 ,


-- ** defaultError #method:defaultError#

#if defined(ENABLE_OVERLOADING)
    ObjectDefaultErrorMethodInfo            ,
#endif
    objectDefaultError                      ,


-- ** getControlBinding #method:getControlBinding#

#if defined(ENABLE_OVERLOADING)
    ObjectGetControlBindingMethodInfo       ,
#endif
    objectGetControlBinding                 ,


-- ** getControlRate #method:getControlRate#

#if defined(ENABLE_OVERLOADING)
    ObjectGetControlRateMethodInfo          ,
#endif
    objectGetControlRate                    ,


-- ** getGValueArray #method:getGValueArray#

#if defined(ENABLE_OVERLOADING)
    ObjectGetGValueArrayMethodInfo          ,
#endif
    objectGetGValueArray                    ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ObjectGetNameMethodInfo                 ,
#endif
    objectGetName                           ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    ObjectGetParentMethodInfo               ,
#endif
    objectGetParent                         ,


-- ** getPathString #method:getPathString#

#if defined(ENABLE_OVERLOADING)
    ObjectGetPathStringMethodInfo           ,
#endif
    objectGetPathString                     ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    ObjectGetValueMethodInfo                ,
#endif
    objectGetValue                          ,


-- ** hasActiveControlBindings #method:hasActiveControlBindings#

#if defined(ENABLE_OVERLOADING)
    ObjectHasActiveControlBindingsMethodInfo,
#endif
    objectHasActiveControlBindings          ,


-- ** hasAncestor #method:hasAncestor#

#if defined(ENABLE_OVERLOADING)
    ObjectHasAncestorMethodInfo             ,
#endif
    objectHasAncestor                       ,


-- ** hasAsAncestor #method:hasAsAncestor#

#if defined(ENABLE_OVERLOADING)
    ObjectHasAsAncestorMethodInfo           ,
#endif
    objectHasAsAncestor                     ,


-- ** hasAsParent #method:hasAsParent#

#if defined(ENABLE_OVERLOADING)
    ObjectHasAsParentMethodInfo             ,
#endif
    objectHasAsParent                       ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ObjectRefMethodInfo                     ,
#endif
    objectRef                               ,


-- ** removeControlBinding #method:removeControlBinding#

#if defined(ENABLE_OVERLOADING)
    ObjectRemoveControlBindingMethodInfo    ,
#endif
    objectRemoveControlBinding              ,


-- ** replace #method:replace#

    objectReplace                           ,


-- ** setControlBindingDisabled #method:setControlBindingDisabled#

#if defined(ENABLE_OVERLOADING)
    ObjectSetControlBindingDisabledMethodInfo,
#endif
    objectSetControlBindingDisabled         ,


-- ** setControlBindingsDisabled #method:setControlBindingsDisabled#

#if defined(ENABLE_OVERLOADING)
    ObjectSetControlBindingsDisabledMethodInfo,
#endif
    objectSetControlBindingsDisabled        ,


-- ** setControlRate #method:setControlRate#

#if defined(ENABLE_OVERLOADING)
    ObjectSetControlRateMethodInfo          ,
#endif
    objectSetControlRate                    ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    ObjectSetNameMethodInfo                 ,
#endif
    objectSetName                           ,


-- ** setParent #method:setParent#

#if defined(ENABLE_OVERLOADING)
    ObjectSetParentMethodInfo               ,
#endif
    objectSetParent                         ,


-- ** suggestNextSync #method:suggestNextSync#

#if defined(ENABLE_OVERLOADING)
    ObjectSuggestNextSyncMethodInfo         ,
#endif
    objectSuggestNextSync                   ,


-- ** syncValues #method:syncValues#

#if defined(ENABLE_OVERLOADING)
    ObjectSyncValuesMethodInfo              ,
#endif
    objectSyncValues                        ,


-- ** unparent #method:unparent#

#if defined(ENABLE_OVERLOADING)
    ObjectUnparentMethodInfo                ,
#endif
    objectUnparent                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ObjectUnrefMethodInfo                   ,
#endif
    objectUnref                             ,




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

#if defined(ENABLE_OVERLOADING)
    ObjectNamePropertyInfo                  ,
#endif
    clearObjectName                         ,
    constructObjectName                     ,
    getObjectName                           ,
#if defined(ENABLE_OVERLOADING)
    objectName                              ,
#endif
    setObjectName                           ,


-- ** parent #attr:parent#
-- | The parent of the object. Please note, that when changing the \'parent\'
-- property, we don\'t emit [notify]("GI.GObject.Objects.Object#g:signal:notify") and [deepNotify]("GI.Gst.Objects.Object#g:signal:deepNotify")
-- signals due to locking issues. In some cases one can use
-- [elementAdded]("GI.Gst.Objects.Bin#g:signal:elementAdded") or [elementRemoved]("GI.Gst.Objects.Bin#g:signal:elementRemoved") signals on the parent to
-- achieve a similar effect.

#if defined(ENABLE_OVERLOADING)
    ObjectParentPropertyInfo                ,
#endif
    clearObjectParent                       ,
    constructObjectParent                   ,
    getObjectParent                         ,
#if defined(ENABLE_OVERLOADING)
    objectParent                            ,
#endif
    setObjectParent                         ,




 -- * Signals
-- ** deepNotify #signal:deepNotify#

    C_ObjectDeepNotifyCallback              ,
    ObjectDeepNotifyCallback                ,
#if defined(ENABLE_OVERLOADING)
    ObjectDeepNotifySignalInfo              ,
#endif
    afterObjectDeepNotify                   ,
    genClosure_ObjectDeepNotify             ,
    mk_ObjectDeepNotifyCallback             ,
    noObjectDeepNotifyCallback              ,
    onObjectDeepNotify                      ,
    wrap_ObjectDeepNotifyCallback           ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gst.Objects.ControlBinding as Gst.ControlBinding

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

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

foreign import ccall "gst_object_get_type"
    c_gst_object_get_type :: IO B.Types.GType

instance B.Types.TypedObject Object where
    glibType :: IO GType
glibType = IO GType
c_gst_object_get_type

instance B.Types.GObject Object

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

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

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

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

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

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

#endif

-- signal Object::deep-notify
-- | The deep notify signal is used to be notified of property changes. It is
-- typically attached to the toplevel bin to receive notifications from all
-- the elements contained in that bin.
type ObjectDeepNotifyCallback =
    Object
    -- ^ /@propObject@/: the object that originated the signal
    -> GParamSpec
    -- ^ /@prop@/: the property that changed
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ObjectDeepNotifyCallback`@.
noObjectDeepNotifyCallback :: Maybe ObjectDeepNotifyCallback
noObjectDeepNotifyCallback :: Maybe ObjectDeepNotifyCallback
noObjectDeepNotifyCallback = Maybe ObjectDeepNotifyCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ObjectDeepNotifyCallback =
    Ptr () ->                               -- object
    Ptr Object ->
    Ptr GParamSpec ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ObjectDeepNotifyCallback`.
foreign import ccall "wrapper"
    mk_ObjectDeepNotifyCallback :: C_ObjectDeepNotifyCallback -> IO (FunPtr C_ObjectDeepNotifyCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ObjectDeepNotify :: MonadIO m => ObjectDeepNotifyCallback -> m (GClosure C_ObjectDeepNotifyCallback)
genClosure_ObjectDeepNotify :: ObjectDeepNotifyCallback -> m (GClosure C_ObjectDeepNotifyCallback)
genClosure_ObjectDeepNotify ObjectDeepNotifyCallback
cb = IO (GClosure C_ObjectDeepNotifyCallback)
-> m (GClosure C_ObjectDeepNotifyCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ObjectDeepNotifyCallback)
 -> m (GClosure C_ObjectDeepNotifyCallback))
-> IO (GClosure C_ObjectDeepNotifyCallback)
-> m (GClosure C_ObjectDeepNotifyCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ObjectDeepNotifyCallback
cb' = ObjectDeepNotifyCallback -> C_ObjectDeepNotifyCallback
wrap_ObjectDeepNotifyCallback ObjectDeepNotifyCallback
cb
    C_ObjectDeepNotifyCallback
-> IO (FunPtr C_ObjectDeepNotifyCallback)
mk_ObjectDeepNotifyCallback C_ObjectDeepNotifyCallback
cb' IO (FunPtr C_ObjectDeepNotifyCallback)
-> (FunPtr C_ObjectDeepNotifyCallback
    -> IO (GClosure C_ObjectDeepNotifyCallback))
-> IO (GClosure C_ObjectDeepNotifyCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ObjectDeepNotifyCallback
-> IO (GClosure C_ObjectDeepNotifyCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ObjectDeepNotifyCallback` into a `C_ObjectDeepNotifyCallback`.
wrap_ObjectDeepNotifyCallback ::
    ObjectDeepNotifyCallback ->
    C_ObjectDeepNotifyCallback
wrap_ObjectDeepNotifyCallback :: ObjectDeepNotifyCallback -> C_ObjectDeepNotifyCallback
wrap_ObjectDeepNotifyCallback ObjectDeepNotifyCallback
_cb Ptr ()
_ Ptr Object
propObject Ptr GParamSpec
prop Ptr ()
_ = do
    Object
propObject' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Object) Ptr Object
propObject
    GParamSpec
prop' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
prop
    ObjectDeepNotifyCallback
_cb  Object
propObject' GParamSpec
prop'


-- | Connect a signal handler for the [deepNotify](#signal:deepNotify) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' object #deepNotify callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@deep-notify::detail@” instead.
-- 
onObjectDeepNotify :: (IsObject a, MonadIO m) => a -> P.Maybe T.Text -> ObjectDeepNotifyCallback -> m SignalHandlerId
onObjectDeepNotify :: a -> Maybe Text -> ObjectDeepNotifyCallback -> m SignalHandlerId
onObjectDeepNotify a
obj Maybe Text
detail ObjectDeepNotifyCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ObjectDeepNotifyCallback
cb' = ObjectDeepNotifyCallback -> C_ObjectDeepNotifyCallback
wrap_ObjectDeepNotifyCallback ObjectDeepNotifyCallback
cb
    FunPtr C_ObjectDeepNotifyCallback
cb'' <- C_ObjectDeepNotifyCallback
-> IO (FunPtr C_ObjectDeepNotifyCallback)
mk_ObjectDeepNotifyCallback C_ObjectDeepNotifyCallback
cb'
    a
-> Text
-> FunPtr C_ObjectDeepNotifyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"deep-notify" FunPtr C_ObjectDeepNotifyCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
detail

-- | Connect a signal handler for the [deepNotify](#signal:deepNotify) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' object #deepNotify callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@deep-notify::detail@” instead.
-- 
afterObjectDeepNotify :: (IsObject a, MonadIO m) => a -> P.Maybe T.Text -> ObjectDeepNotifyCallback -> m SignalHandlerId
afterObjectDeepNotify :: a -> Maybe Text -> ObjectDeepNotifyCallback -> m SignalHandlerId
afterObjectDeepNotify a
obj Maybe Text
detail ObjectDeepNotifyCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ObjectDeepNotifyCallback
cb' = ObjectDeepNotifyCallback -> C_ObjectDeepNotifyCallback
wrap_ObjectDeepNotifyCallback ObjectDeepNotifyCallback
cb
    FunPtr C_ObjectDeepNotifyCallback
cb'' <- C_ObjectDeepNotifyCallback
-> IO (FunPtr C_ObjectDeepNotifyCallback)
mk_ObjectDeepNotifyCallback C_ObjectDeepNotifyCallback
cb'
    a
-> Text
-> FunPtr C_ObjectDeepNotifyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"deep-notify" FunPtr C_ObjectDeepNotifyCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
detail


#if defined(ENABLE_OVERLOADING)
data ObjectDeepNotifySignalInfo
instance SignalInfo ObjectDeepNotifySignalInfo where
    type HaskellCallbackType ObjectDeepNotifySignalInfo = ObjectDeepNotifyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ObjectDeepNotifyCallback cb
        cb'' <- mk_ObjectDeepNotifyCallback cb'
        connectSignalFunPtr obj "deep-notify" cb'' connectMode detail

#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' object #name
-- @
getObjectName :: (MonadIO m, IsObject o) => o -> m (Maybe T.Text)
getObjectName :: o -> m (Maybe Text)
getObjectName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"

-- | Set the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' object [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setObjectName :: (MonadIO m, IsObject o) => o -> T.Text -> m ()
setObjectName :: o -> Text -> m ()
setObjectName o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructObjectName :: (IsObject o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructObjectName :: Text -> m (GValueConstruct o)
constructObjectName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@name@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearObjectName :: (MonadIO m, IsObject o) => o -> m ()
clearObjectName :: o -> m ()
clearObjectName o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ObjectNamePropertyInfo
instance AttrInfo ObjectNamePropertyInfo where
    type AttrAllowedOps ObjectNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ObjectNamePropertyInfo = IsObject
    type AttrSetTypeConstraint ObjectNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ObjectNamePropertyInfo = (~) T.Text
    type AttrTransferType ObjectNamePropertyInfo = T.Text
    type AttrGetType ObjectNamePropertyInfo = (Maybe T.Text)
    type AttrLabel ObjectNamePropertyInfo = "name"
    type AttrOrigin ObjectNamePropertyInfo = Object
    attrGet = getObjectName
    attrSet = setObjectName
    attrTransfer _ v = do
        return v
    attrConstruct = constructObjectName
    attrClear = clearObjectName
#endif

-- VVV Prop "parent"
   -- Type: TInterface (Name {namespace = "Gst", name = "Object"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@parent@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' object #parent
-- @
getObjectParent :: (MonadIO m, IsObject o) => o -> m (Maybe Object)
getObjectParent :: o -> m (Maybe Object)
getObjectParent o
obj = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Object -> Object) -> IO (Maybe Object)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"parent" ManagedPtr Object -> Object
Object

-- | Set the value of the “@parent@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' object [ #parent 'Data.GI.Base.Attributes.:=' value ]
-- @
setObjectParent :: (MonadIO m, IsObject o, IsObject a) => o -> a -> m ()
setObjectParent :: o -> a -> m ()
setObjectParent o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"parent" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@parent@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructObjectParent :: (IsObject o, MIO.MonadIO m, IsObject a) => a -> m (GValueConstruct o)
constructObjectParent :: a -> m (GValueConstruct o)
constructObjectParent a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"parent" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@parent@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #parent
-- @
clearObjectParent :: (MonadIO m, IsObject o) => o -> m ()
clearObjectParent :: o -> m ()
clearObjectParent o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Object -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"parent" (Maybe Object
forall a. Maybe a
Nothing :: Maybe Object)

#if defined(ENABLE_OVERLOADING)
data ObjectParentPropertyInfo
instance AttrInfo ObjectParentPropertyInfo where
    type AttrAllowedOps ObjectParentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ObjectParentPropertyInfo = IsObject
    type AttrSetTypeConstraint ObjectParentPropertyInfo = IsObject
    type AttrTransferTypeConstraint ObjectParentPropertyInfo = IsObject
    type AttrTransferType ObjectParentPropertyInfo = Object
    type AttrGetType ObjectParentPropertyInfo = (Maybe Object)
    type AttrLabel ObjectParentPropertyInfo = "parent"
    type AttrOrigin ObjectParentPropertyInfo = Object
    attrGet = getObjectParent
    attrSet = setObjectParent
    attrTransfer _ v = do
        unsafeCastTo Object v
    attrConstruct = constructObjectParent
    attrClear = clearObjectParent
#endif

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

#if defined(ENABLE_OVERLOADING)
objectName :: AttrLabelProxy "name"
objectName = AttrLabelProxy

objectParent :: AttrLabelProxy "parent"
objectParent = AttrLabelProxy

#endif

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

#endif

-- method Object::add_control_binding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the controller object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "binding"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ControlBinding" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstControlBinding that should be used"
--                 , 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_object_add_control_binding" gst_object_add_control_binding :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.ControlBinding.ControlBinding -> -- binding : TInterface (Name {namespace = "Gst", name = "ControlBinding"})
    IO CInt

-- | Attach the t'GI.Gst.Objects.ControlBinding.ControlBinding' to the object. If there already was a
-- t'GI.Gst.Objects.ControlBinding.ControlBinding' for this property it will be replaced.
-- 
-- The object\'s reference count will be incremented, and any floating
-- reference will be removed (see @/gst_object_ref_sink()/@)
objectAddControlBinding ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, Gst.ControlBinding.IsControlBinding b) =>
    a
    -- ^ /@object@/: the controller object
    -> b
    -- ^ /@binding@/: the t'GI.Gst.Objects.ControlBinding.ControlBinding' that should be used
    -> m Bool
    -- ^ __Returns:__ 'P.False' if the given /@binding@/ has not been setup for this object or
    -- has been setup for a non suitable property, 'P.True' otherwise.
objectAddControlBinding :: a -> b -> m Bool
objectAddControlBinding a
object b
binding = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr ControlBinding
binding' <- b -> IO (Ptr ControlBinding)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
binding
    CInt
result <- Ptr Object -> Ptr ControlBinding -> IO CInt
gst_object_add_control_binding Ptr Object
object' Ptr ControlBinding
binding'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
binding
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectAddControlBindingMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsObject a, Gst.ControlBinding.IsControlBinding b) => O.MethodInfo ObjectAddControlBindingMethodInfo a signature where
    overloadedMethod = objectAddControlBinding

#endif

-- method Object::default_error
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstObject that initiated the error."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error"
--           , argType = TError
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the GError." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "debug"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an additional debug information string, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_default_error" gst_object_default_error :: 
    Ptr Object ->                           -- source : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GError ->                           -- error : TError
    CString ->                              -- debug : TBasicType TUTF8
    IO ()

-- | A default error function that uses @/g_printerr()/@ to display the error message
-- and the optional debug string..
-- 
-- The default handler will simply print the error string using g_print.
objectDefaultError ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@source@/: the t'GI.Gst.Objects.Object.Object' that initiated the error.
    -> GError
    -- ^ /@error@/: the GError.
    -> Maybe (T.Text)
    -- ^ /@debug@/: an additional debug information string, or 'P.Nothing'
    -> m ()
objectDefaultError :: a -> GError -> Maybe Text -> m ()
objectDefaultError a
source GError
error_ Maybe Text
debug = 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 Object
source' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr GError
error_' <- GError -> IO (Ptr GError)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GError
error_
    Ptr CChar
maybeDebug <- case Maybe Text
debug of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDebug -> do
            Ptr CChar
jDebug' <- Text -> IO (Ptr CChar)
textToCString Text
jDebug
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDebug'
    Ptr Object -> Ptr GError -> Ptr CChar -> IO ()
gst_object_default_error Ptr Object
source' Ptr GError
error_' Ptr CChar
maybeDebug
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    GError -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GError
error_
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDebug
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectDefaultErrorMethodInfo
instance (signature ~ (GError -> Maybe (T.Text) -> m ()), MonadIO m, IsObject a) => O.MethodInfo ObjectDefaultErrorMethodInfo a signature where
    overloadedMethod = objectDefaultError

#endif

-- method Object::get_control_binding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gst" , name = "ControlBinding" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_get_control_binding" gst_object_get_control_binding :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO (Ptr Gst.ControlBinding.ControlBinding)

-- | Gets the corresponding t'GI.Gst.Objects.ControlBinding.ControlBinding' for the property. This should be
-- unreferenced again after use.
objectGetControlBinding ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object
    -> T.Text
    -- ^ /@propertyName@/: name of the property
    -> m (Maybe Gst.ControlBinding.ControlBinding)
    -- ^ __Returns:__ the t'GI.Gst.Objects.ControlBinding.ControlBinding' for
    -- /@propertyName@/ or 'P.Nothing' if the property is not controlled.
objectGetControlBinding :: a -> Text -> m (Maybe ControlBinding)
objectGetControlBinding a
object Text
propertyName = IO (Maybe ControlBinding) -> m (Maybe ControlBinding)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ControlBinding) -> m (Maybe ControlBinding))
-> IO (Maybe ControlBinding) -> m (Maybe ControlBinding)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
propertyName' <- Text -> IO (Ptr CChar)
textToCString Text
propertyName
    Ptr ControlBinding
result <- Ptr Object -> Ptr CChar -> IO (Ptr ControlBinding)
gst_object_get_control_binding Ptr Object
object' Ptr CChar
propertyName'
    Maybe ControlBinding
maybeResult <- Ptr ControlBinding
-> (Ptr ControlBinding -> IO ControlBinding)
-> IO (Maybe ControlBinding)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ControlBinding
result ((Ptr ControlBinding -> IO ControlBinding)
 -> IO (Maybe ControlBinding))
-> (Ptr ControlBinding -> IO ControlBinding)
-> IO (Maybe ControlBinding)
forall a b. (a -> b) -> a -> b
$ \Ptr ControlBinding
result' -> do
        ControlBinding
result'' <- ((ManagedPtr ControlBinding -> ControlBinding)
-> Ptr ControlBinding -> IO ControlBinding
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ControlBinding -> ControlBinding
Gst.ControlBinding.ControlBinding) Ptr ControlBinding
result'
        ControlBinding -> IO ControlBinding
forall (m :: * -> *) a. Monad m => a -> m a
return ControlBinding
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
propertyName'
    Maybe ControlBinding -> IO (Maybe ControlBinding)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ControlBinding
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetControlBindingMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gst.ControlBinding.ControlBinding)), MonadIO m, IsObject a) => O.MethodInfo ObjectGetControlBindingMethodInfo a signature where
    overloadedMethod = objectGetControlBinding

#endif

-- method Object::get_control_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , 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_object_get_control_rate" gst_object_get_control_rate :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    IO Word64

-- | Obtain the control-rate for this /@object@/. Audio processing t'GI.Gst.Objects.Element.Element'
-- objects will use this rate to sub-divide their processing loop and call
-- 'GI.Gst.Objects.Object.objectSyncValues' in between. The length of the processing segment
-- should be up to /@control@/-rate nanoseconds.
-- 
-- If the /@object@/ is not under property control, this will return
-- 'GI.Gst.Constants.CLOCK_TIME_NONE'. This allows the element to avoid the sub-dividing.
-- 
-- The control-rate is not expected to change if the element is in
-- 'GI.Gst.Enums.StatePaused' or 'GI.Gst.Enums.StatePlaying'.
objectGetControlRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> m Word64
    -- ^ __Returns:__ the control rate in nanoseconds
objectGetControlRate :: a -> m Word64
objectGetControlRate a
object = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Word64
result <- Ptr Object -> IO Word64
gst_object_get_control_rate Ptr Object
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ObjectGetControlRateMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsObject a) => O.MethodInfo ObjectGetControlRateMethodInfo a signature where
    overloadedMethod = objectGetControlRate

#endif

-- method Object::get_g_value_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the time that should be processed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the time spacing between subsequent values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_values"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 4 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "array to put control-values in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_values"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of values"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_get_g_value_array" gst_object_get_g_value_array :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    Word64 ->                               -- timestamp : TBasicType TUInt64
    Word64 ->                               -- interval : TBasicType TUInt64
    Word32 ->                               -- n_values : TBasicType TUInt
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 4 TGValue
    IO CInt

-- | Gets a number of @/GValues/@ for the given controlled property starting at the
-- requested time. The array /@values@/ need to hold enough space for /@nValues@/ of
-- t'GI.GObject.Structs.Value.Value'.
-- 
-- This function is useful if one wants to e.g. draw a graph of the control
-- curve or apply a control curve sample by sample.
objectGetGValueArray ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to get
    -> Word64
    -- ^ /@timestamp@/: the time that should be processed
    -> Word64
    -- ^ /@interval@/: the time spacing between subsequent values
    -> [GValue]
    -- ^ /@values@/: array to put control-values in
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the given array could be filled, 'P.False' otherwise
objectGetGValueArray :: a -> Text -> Word64 -> Word64 -> [GValue] -> m Bool
objectGetGValueArray a
object Text
propertyName Word64
timestamp Word64
interval [GValue]
values = 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
    let nValues :: Word32
nValues = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
propertyName' <- Text -> IO (Ptr CChar)
textToCString Text
propertyName
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    CInt
result <- Ptr Object
-> Ptr CChar -> Word64 -> Word64 -> Word32 -> Ptr GValue -> IO CInt
gst_object_get_g_value_array Ptr Object
object' Ptr CChar
propertyName' Word64
timestamp Word64
interval Word32
nValues Ptr GValue
values'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
propertyName'
    (Word32 -> (Ptr GValue -> IO ()) -> Ptr GValue -> IO ()
forall a c.
Integral a =>
a -> (Ptr GValue -> IO c) -> Ptr GValue -> IO ()
B.GValue.mapGValueArrayWithLength Word32
nValues) Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
values'
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectGetGValueArrayMethodInfo
instance (signature ~ (T.Text -> Word64 -> Word64 -> [GValue] -> m Bool), MonadIO m, IsObject a) => O.MethodInfo ObjectGetGValueArrayMethodInfo a signature where
    overloadedMethod = objectGetGValueArray

#endif

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

foreign import ccall "gst_object_get_name" gst_object_get_name :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CString

-- | Returns a copy of the name of /@object@/.
-- Caller should 'GI.GLib.Functions.free' the return value after usage.
-- For a nameless object, this returns 'P.Nothing', which you can safely 'GI.GLib.Functions.free'
-- as well.
-- 
-- Free-function: g_free
objectGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of /@object@/. 'GI.GLib.Functions.free'
    -- after usage.
    -- 
    -- MT safe. This function grabs and releases /@object@/\'s LOCK.
objectGetName :: a -> m (Maybe Text)
objectGetName a
object = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
result <- Ptr Object -> IO (Ptr CChar)
gst_object_get_name Ptr Object
object'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsObject a) => O.MethodInfo ObjectGetNameMethodInfo a signature where
    overloadedMethod = objectGetName

#endif

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

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

-- | Returns the parent of /@object@/. This function increases the refcount
-- of the parent object so you should 'GI.Gst.Objects.Object.objectUnref' it after usage.
objectGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object'
    -> m (Maybe Object)
    -- ^ __Returns:__ parent of /@object@/, this can be
    --   'P.Nothing' if /@object@/ has no parent. unref after usage.
    -- 
    -- MT safe. Grabs and releases /@object@/\'s LOCK.
objectGetParent :: a -> m (Maybe Object)
objectGetParent a
object = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
result <- Ptr Object -> IO (Ptr Object)
gst_object_get_parent Ptr Object
object'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetParentMethodInfo
instance (signature ~ (m (Maybe Object)), MonadIO m, IsObject a) => O.MethodInfo ObjectGetParentMethodInfo a signature where
    overloadedMethod = objectGetParent

#endif

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

foreign import ccall "gst_object_get_path_string" gst_object_get_path_string :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CString

-- | Generates a string describing the path of /@object@/ in
-- the object hierarchy. Only useful (or used) for debugging.
-- 
-- Free-function: g_free
objectGetPathString ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object'
    -> m T.Text
    -- ^ __Returns:__ a string describing the path of /@object@/. You must
    --          'GI.GLib.Functions.free' the string after usage.
    -- 
    -- MT safe. Grabs and releases the t'GI.Gst.Objects.Object.Object'\'s LOCK for all objects
    --          in the hierarchy.
objectGetPathString :: a -> m Text
objectGetPathString a
object = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
result <- Ptr Object -> IO (Ptr CChar)
gst_object_get_path_string Ptr Object
object'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectGetPathString" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ObjectGetPathStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsObject a) => O.MethodInfo ObjectGetPathStringMethodInfo a signature where
    overloadedMethod = objectGetPathString

#endif

-- method Object::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to get"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the time the control-change should be read from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_get_value" gst_object_get_value :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    Word64 ->                               -- timestamp : TBasicType TUInt64
    IO (Ptr GValue)

-- | Gets the value for the given controlled property at the requested time.
objectGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to get
    -> Word64
    -- ^ /@timestamp@/: the time the control-change should be read from
    -> m (Maybe GValue)
    -- ^ __Returns:__ the GValue of the property at the given time,
    -- or 'P.Nothing' if the property isn\'t controlled.
objectGetValue :: a -> Text -> Word64 -> m (Maybe GValue)
objectGetValue a
object Text
propertyName Word64
timestamp = IO (Maybe GValue) -> m (Maybe GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
propertyName' <- Text -> IO (Ptr CChar)
textToCString Text
propertyName
    Ptr GValue
result <- Ptr Object -> Ptr CChar -> Word64 -> IO (Ptr GValue)
gst_object_get_value Ptr Object
object' Ptr CChar
propertyName' Word64
timestamp
    Maybe GValue
maybeResult <- Ptr GValue -> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GValue
result ((Ptr GValue -> IO GValue) -> IO (Maybe GValue))
-> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
result' -> do
        GValue
result'' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
result'
        Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
result'
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
propertyName'
    Maybe GValue -> IO (Maybe GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetValueMethodInfo
instance (signature ~ (T.Text -> Word64 -> m (Maybe GValue)), MonadIO m, IsObject a) => O.MethodInfo ObjectGetValueMethodInfo a signature where
    overloadedMethod = objectGetValue

#endif

-- method Object::has_active_control_bindings
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , 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_object_has_active_control_bindings" gst_object_has_active_control_bindings :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CInt

-- | Check if the /@object@/ has active controlled properties.
objectHasActiveControlBindings ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the object has active controlled properties
objectHasActiveControlBindings :: a -> m Bool
objectHasActiveControlBindings a
object = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    CInt
result <- Ptr Object -> IO CInt
gst_object_has_active_control_bindings Ptr Object
object'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectHasActiveControlBindingsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsObject a) => O.MethodInfo ObjectHasActiveControlBindingsMethodInfo a signature where
    overloadedMethod = objectHasActiveControlBindings

#endif

-- method Object::has_ancestor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ancestor"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject to check as ancestor"
--                 , 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_object_has_ancestor" gst_object_has_ancestor :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Object ->                           -- ancestor : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CInt

{-# DEPRECATED objectHasAncestor ["Use 'GI.Gst.Objects.Object.objectHasAsAncestor' instead.","","MT safe. Grabs and releases /@object@/\\'s locks."] #-}
-- | Check if /@object@/ has an ancestor /@ancestor@/ somewhere up in
-- the hierarchy. One can e.g. check if a t'GI.Gst.Objects.Element.Element' is inside a t'GI.Gst.Objects.Pipeline.Pipeline'.
objectHasAncestor ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, IsObject b) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object' to check
    -> b
    -- ^ /@ancestor@/: a t'GI.Gst.Objects.Object.Object' to check as ancestor
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@ancestor@/ is an ancestor of /@object@/.
objectHasAncestor :: a -> b -> m Bool
objectHasAncestor a
object b
ancestor = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
ancestor' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
ancestor
    CInt
result <- Ptr Object -> Ptr Object -> IO CInt
gst_object_has_ancestor Ptr Object
object' Ptr Object
ancestor'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
ancestor
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectHasAncestorMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsObject a, IsObject b) => O.MethodInfo ObjectHasAncestorMethodInfo a signature where
    overloadedMethod = objectHasAncestor

#endif

-- method Object::has_as_ancestor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ancestor"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject to check as ancestor"
--                 , 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_object_has_as_ancestor" gst_object_has_as_ancestor :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Object ->                           -- ancestor : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CInt

-- | Check if /@object@/ has an ancestor /@ancestor@/ somewhere up in
-- the hierarchy. One can e.g. check if a t'GI.Gst.Objects.Element.Element' is inside a t'GI.Gst.Objects.Pipeline.Pipeline'.
objectHasAsAncestor ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, IsObject b) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object' to check
    -> b
    -- ^ /@ancestor@/: a t'GI.Gst.Objects.Object.Object' to check as ancestor
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@ancestor@/ is an ancestor of /@object@/.
    -- 
    -- MT safe. Grabs and releases /@object@/\'s locks.
objectHasAsAncestor :: a -> b -> m Bool
objectHasAsAncestor a
object b
ancestor = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
ancestor' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
ancestor
    CInt
result <- Ptr Object -> Ptr Object -> IO CInt
gst_object_has_as_ancestor Ptr Object
object' Ptr Object
ancestor'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
ancestor
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectHasAsAncestorMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsObject a, IsObject b) => O.MethodInfo ObjectHasAsAncestorMethodInfo a signature where
    overloadedMethod = objectHasAsAncestor

#endif

-- method Object::has_as_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject to check as parent"
--                 , 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_object_has_as_parent" gst_object_has_as_parent :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Object ->                           -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CInt

-- | Check if /@parent@/ is the parent of /@object@/.
-- E.g. a t'GI.Gst.Objects.Element.Element' can check if it owns a given t'GI.Gst.Objects.Pad.Pad'.
-- 
-- /Since: 1.6/
objectHasAsParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, IsObject b) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object' to check
    -> b
    -- ^ /@parent@/: a t'GI.Gst.Objects.Object.Object' to check as parent
    -> m Bool
    -- ^ __Returns:__ 'P.False' if either /@object@/ or /@parent@/ is 'P.Nothing'. 'P.True' if /@parent@/ is
    --          the parent of /@object@/. Otherwise 'P.False'.
    -- 
    -- MT safe. Grabs and releases /@object@/\'s locks.
objectHasAsParent :: a -> b -> m Bool
objectHasAsParent a
object b
parent = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
parent' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    CInt
result <- Ptr Object -> Ptr Object -> IO CInt
gst_object_has_as_parent Ptr Object
object' Ptr Object
parent'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectHasAsParentMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsObject a, IsObject b) => O.MethodInfo ObjectHasAsParentMethodInfo a signature where
    overloadedMethod = objectHasAsParent

#endif

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

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

-- | Increments the reference count on /@object@/. This function
-- does not take the lock on /@object@/ because it relies on
-- atomic refcounting.
-- 
-- This object returns the input parameter to ease writing
-- constructs like :
--  result = gst_object_ref (object->parent);
objectRef ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object' to reference
    -> m Object
    -- ^ __Returns:__ A pointer to /@object@/
objectRef :: a -> m Object
objectRef a
object = IO Object -> m Object
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
result <- Ptr Object -> IO (Ptr Object)
gst_object_ref Ptr Object
object'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectRef" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data ObjectRefMethodInfo
instance (signature ~ (m Object), MonadIO m, IsObject a) => O.MethodInfo ObjectRefMethodInfo a signature where
    overloadedMethod = objectRef

#endif

-- method Object::remove_control_binding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "binding"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ControlBinding" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the binding" , 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_object_remove_control_binding" gst_object_remove_control_binding :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Gst.ControlBinding.ControlBinding -> -- binding : TInterface (Name {namespace = "Gst", name = "ControlBinding"})
    IO CInt

-- | Removes the corresponding t'GI.Gst.Objects.ControlBinding.ControlBinding'. If it was the
-- last ref of the binding, it will be disposed.
objectRemoveControlBinding ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, Gst.ControlBinding.IsControlBinding b) =>
    a
    -- ^ /@object@/: the object
    -> b
    -- ^ /@binding@/: the binding
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the binding could be removed.
objectRemoveControlBinding :: a -> b -> m Bool
objectRemoveControlBinding a
object b
binding = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr ControlBinding
binding' <- b -> IO (Ptr ControlBinding)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
binding
    CInt
result <- Ptr Object -> Ptr ControlBinding -> IO CInt
gst_object_remove_control_binding Ptr Object
object' Ptr ControlBinding
binding'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
binding
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectRemoveControlBindingMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsObject a, Gst.ControlBinding.IsControlBinding b) => O.MethodInfo ObjectRemoveControlBindingMethodInfo a signature where
    overloadedMethod = objectRemoveControlBinding

#endif

-- method Object::set_control_binding_disabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "property to disable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "disabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "boolean that specifies whether to disable the controller\nor not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_set_control_binding_disabled" gst_object_set_control_binding_disabled :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- property_name : TBasicType TUTF8
    CInt ->                                 -- disabled : TBasicType TBoolean
    IO ()

-- | This function is used to disable the control bindings on a property for
-- some time, i.e. 'GI.Gst.Objects.Object.objectSyncValues' will do nothing for the
-- property.
objectSetControlBindingDisabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> T.Text
    -- ^ /@propertyName@/: property to disable
    -> Bool
    -- ^ /@disabled@/: boolean that specifies whether to disable the controller
    -- or not.
    -> m ()
objectSetControlBindingDisabled :: a -> Text -> Bool -> m ()
objectSetControlBindingDisabled a
object Text
propertyName Bool
disabled = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
propertyName' <- Text -> IO (Ptr CChar)
textToCString Text
propertyName
    let disabled' :: CInt
disabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
disabled
    Ptr Object -> Ptr CChar -> CInt -> IO ()
gst_object_set_control_binding_disabled Ptr Object
object' Ptr CChar
propertyName' CInt
disabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetControlBindingDisabledMethodInfo
instance (signature ~ (T.Text -> Bool -> m ()), MonadIO m, IsObject a) => O.MethodInfo ObjectSetControlBindingDisabledMethodInfo a signature where
    overloadedMethod = objectSetControlBindingDisabled

#endif

-- method Object::set_control_bindings_disabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "disabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "boolean that specifies whether to disable the controller\nor not."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_set_control_bindings_disabled" gst_object_set_control_bindings_disabled :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    CInt ->                                 -- disabled : TBasicType TBoolean
    IO ()

-- | This function is used to disable all controlled properties of the /@object@/ for
-- some time, i.e. 'GI.Gst.Objects.Object.objectSyncValues' will do nothing.
objectSetControlBindingsDisabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> Bool
    -- ^ /@disabled@/: boolean that specifies whether to disable the controller
    -- or not.
    -> m ()
objectSetControlBindingsDisabled :: a -> Bool -> m ()
objectSetControlBindingsDisabled a
object Bool
disabled = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    let disabled' :: CInt
disabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
disabled
    Ptr Object -> CInt -> IO ()
gst_object_set_control_bindings_disabled Ptr Object
object' CInt
disabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetControlBindingsDisabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsObject a) => O.MethodInfo ObjectSetControlBindingsDisabledMethodInfo a signature where
    overloadedMethod = objectSetControlBindingsDisabled

#endif

-- method Object::set_control_rate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "control_rate"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new control-rate in nanoseconds."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_set_control_rate" gst_object_set_control_rate :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Word64 ->                               -- control_rate : TBasicType TUInt64
    IO ()

-- | Change the control-rate for this /@object@/. Audio processing t'GI.Gst.Objects.Element.Element'
-- objects will use this rate to sub-divide their processing loop and call
-- 'GI.Gst.Objects.Object.objectSyncValues' in between. The length of the processing segment
-- should be up to /@control@/-rate nanoseconds.
-- 
-- The control-rate should not change if the element is in 'GI.Gst.Enums.StatePaused' or
-- 'GI.Gst.Enums.StatePlaying'.
objectSetControlRate ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> Word64
    -- ^ /@controlRate@/: the new control-rate in nanoseconds.
    -> m ()
objectSetControlRate :: a -> Word64 -> m ()
objectSetControlRate a
object Word64
controlRate = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object -> Word64 -> IO ()
gst_object_set_control_rate Ptr Object
object' Word64
controlRate
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetControlRateMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsObject a) => O.MethodInfo ObjectSetControlRateMethodInfo a signature where
    overloadedMethod = objectSetControlRate

#endif

-- method Object::set_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new name of object" , 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_object_set_name" gst_object_set_name :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Sets the name of /@object@/, or gives /@object@/ a guaranteed unique
-- name (if /@name@/ is 'P.Nothing').
-- This function makes a copy of the provided name, so the caller
-- retains ownership of the name it sent.
objectSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object'
    -> Maybe (T.Text)
    -- ^ /@name@/: new name of object
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the name could be set. Since Objects that have
    -- a parent cannot be renamed, this function returns 'P.False' in those
    -- cases.
    -- 
    -- MT safe.  This function grabs and releases /@object@/\'s LOCK.
objectSetName :: a -> Maybe Text -> m Bool
objectSetName a
object Maybe Text
name = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    CInt
result <- Ptr Object -> Ptr CChar -> IO CInt
gst_object_set_name Ptr Object
object' Ptr CChar
maybeName
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectSetNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m Bool), MonadIO m, IsObject a) => O.MethodInfo ObjectSetNameMethodInfo a signature where
    overloadedMethod = objectSetName

#endif

-- method Object::set_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new parent of object"
--                 , 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_object_set_parent" gst_object_set_parent :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Object ->                           -- parent : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CInt

-- | Sets the parent of /@object@/ to /@parent@/. The object\'s reference count will
-- be incremented, and any floating reference will be removed (see @/gst_object_ref_sink()/@).
objectSetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, IsObject b) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object'
    -> b
    -- ^ /@parent@/: new parent of object
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@parent@/ could be set or 'P.False' when /@object@/
    -- already had a parent or /@object@/ and /@parent@/ are the same.
    -- 
    -- MT safe. Grabs and releases /@object@/\'s LOCK.
objectSetParent :: a -> b -> m Bool
objectSetParent a
object b
parent = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
parent' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
parent
    CInt
result <- Ptr Object -> Ptr Object -> IO CInt
gst_object_set_parent Ptr Object
object' Ptr Object
parent'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
parent
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectSetParentMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsObject a, IsObject b) => O.MethodInfo ObjectSetParentMethodInfo a signature where
    overloadedMethod = objectSetParent

#endif

-- method Object::suggest_next_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , 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_object_suggest_next_sync" gst_object_suggest_next_sync :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    IO Word64

-- | Returns a suggestion for timestamps where buffers should be split
-- to get best controller results.
objectSuggestNextSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> m Word64
    -- ^ __Returns:__ Returns the suggested timestamp or 'GI.Gst.Constants.CLOCK_TIME_NONE'
    -- if no control-rate was set.
objectSuggestNextSync :: a -> m Word64
objectSuggestNextSync a
object = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Word64
result <- Ptr Object -> IO Word64
gst_object_suggest_next_sync Ptr Object
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ObjectSuggestNextSyncMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsObject a) => O.MethodInfo ObjectSuggestNextSyncMethodInfo a signature where
    overloadedMethod = objectSuggestNextSync

#endif

-- method Object::sync_values
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object that has controlled properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timestamp"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the time that should be processed"
--                 , 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_object_sync_values" gst_object_sync_values :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Gst", name = "Object"})
    Word64 ->                               -- timestamp : TBasicType TUInt64
    IO CInt

-- | Sets the properties of the object, according to the @/GstControlSources/@ that
-- (maybe) handle them and for the given timestamp.
-- 
-- If this function fails, it is most likely the application developers fault.
-- Most probably the control sources are not setup correctly.
objectSyncValues ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: the object that has controlled properties
    -> Word64
    -- ^ /@timestamp@/: the time that should be processed
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the controller values could be applied to the object
    -- properties, 'P.False' otherwise
objectSyncValues :: a -> Word64 -> m Bool
objectSyncValues a
object Word64
timestamp = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    CInt
result <- Ptr Object -> Word64 -> IO CInt
gst_object_sync_values Ptr Object
object' Word64
timestamp
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectSyncValuesMethodInfo
instance (signature ~ (Word64 -> m Bool), MonadIO m, IsObject a) => O.MethodInfo ObjectSyncValuesMethodInfo a signature where
    overloadedMethod = objectSyncValues

#endif

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

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

-- | Clear the parent of /@object@/, removing the associated reference.
-- This function decreases the refcount of /@object@/.
-- 
-- MT safe. Grabs and releases /@object@/\'s lock.
objectUnparent ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object' to unparent
    -> m ()
objectUnparent :: a -> m ()
objectUnparent a
object = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object -> IO ()
gst_object_unparent Ptr Object
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectUnparentMethodInfo
instance (signature ~ (m ()), MonadIO m, IsObject a) => O.MethodInfo ObjectUnparentMethodInfo a signature where
    overloadedMethod = objectUnparent

#endif

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

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

-- | Decrements the reference count on /@object@/.  If reference count hits
-- zero, destroy /@object@/. This function does not take the lock
-- on /@object@/ as it relies on atomic refcounting.
-- 
-- The unref method should never be called with the LOCK held since
-- this might deadlock the dispose function.
objectUnref ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    a
    -- ^ /@object@/: a t'GI.Gst.Objects.Object.Object' to unreference
    -> m ()
objectUnref :: a -> m ()
objectUnref a
object = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object -> IO ()
gst_object_unref Ptr Object
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m, IsObject a) => O.MethodInfo ObjectUnrefMethodInfo a signature where
    overloadedMethod = objectUnref

#endif

-- method Object::check_uniqueness
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGList (TInterface Name { namespace = "Gst" , name = "Object" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a list of #GstObject to\n     check through"
--                 , 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 to search for"
--                 , 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_object_check_uniqueness" gst_object_check_uniqueness :: 
    Ptr (GList (Ptr Object)) ->             -- list : TGList (TInterface (Name {namespace = "Gst", name = "Object"}))
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks to see if there is any object named /@name@/ in /@list@/. This function
-- does not do any locking of any kind. You might want to protect the
-- provided list with the lock of the owner of the list. This function
-- will lock each t'GI.Gst.Objects.Object.Object' in the list to compare the name, so be
-- careful when passing a list with a locked object.
objectCheckUniqueness ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a) =>
    [a]
    -- ^ /@list@/: a list of t'GI.Gst.Objects.Object.Object' to
    --      check through
    -> T.Text
    -- ^ /@name@/: the name to search for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a t'GI.Gst.Objects.Object.Object' named /@name@/ does not appear in /@list@/,
    -- 'P.False' if it does.
    -- 
    -- MT safe. Grabs and releases the LOCK of each object in the list.
objectCheckUniqueness :: [a] -> Text -> m Bool
objectCheckUniqueness [a]
list Text
name = 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 Object]
list' <- (a -> IO (Ptr Object)) -> [a] -> IO [Ptr Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GList (Ptr Object))
list'' <- [Ptr Object] -> IO (Ptr (GList (Ptr Object)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr Object]
list'
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    CInt
result <- Ptr (GList (Ptr Object)) -> Ptr CChar -> IO CInt
gst_object_check_uniqueness Ptr (GList (Ptr Object))
list'' Ptr CChar
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    Ptr (GList (Ptr Object)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Object))
list''
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Object::default_deep_notify
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GObject that signalled the notify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "orig"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstObject that initiated the notify."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GParamSpec of the property."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "excluded_props"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "\n    a set of user-specified properties to exclude or %NULL to show\n    all changes."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_object_default_deep_notify" gst_object_default_deep_notify :: 
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    Ptr Object ->                           -- orig : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr CString ->                          -- excluded_props : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | A default deep_notify signal callback for an object. The user data
-- should contain a pointer to an array of strings that should be excluded
-- from the notify. The default handler will print the new value of the property
-- using g_print.
-- 
-- MT safe. This function grabs and releases /@object@/\'s LOCK for getting its
--          path string.
objectDefaultDeepNotify ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a, IsObject b) =>
    a
    -- ^ /@object@/: the t'GI.GObject.Objects.Object.Object' that signalled the notify.
    -> b
    -- ^ /@orig@/: a t'GI.Gst.Objects.Object.Object' that initiated the notify.
    -> GParamSpec
    -- ^ /@pspec@/: a t'GI.GObject.Objects.ParamSpec.ParamSpec' of the property.
    -> Maybe ([T.Text])
    -- ^ /@excludedProps@/: 
    --     a set of user-specified properties to exclude or 'P.Nothing' to show
    --     all changes.
    -> m ()
objectDefaultDeepNotify :: a -> b -> GParamSpec -> Maybe [Text] -> m ()
objectDefaultDeepNotify a
object b
orig GParamSpec
pspec Maybe [Text]
excludedProps = 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 Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr Object
orig' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
orig
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr (Ptr CChar)
maybeExcludedProps <- case Maybe [Text]
excludedProps of
        Maybe [Text]
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
nullPtr
        Just [Text]
jExcludedProps -> do
            Ptr (Ptr CChar)
jExcludedProps' <- [Text] -> IO (Ptr (Ptr CChar))
packZeroTerminatedUTF8CArray [Text]
jExcludedProps
            Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
jExcludedProps'
    Ptr Object
-> Ptr Object -> Ptr GParamSpec -> Ptr (Ptr CChar) -> IO ()
gst_object_default_deep_notify Ptr Object
object' Ptr Object
orig' Ptr GParamSpec
pspec' Ptr (Ptr CChar)
maybeExcludedProps
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
orig
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
maybeExcludedProps
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
maybeExcludedProps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Object::replace
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "oldobj"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionInout
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "pointer to a place of\n    a #GstObject to replace"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "newobj"
--           , argType = TInterface Name { namespace = "Gst" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a new #GstObject" , 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_object_replace" gst_object_replace :: 
    Ptr (Ptr Object) ->                     -- oldobj : TInterface (Name {namespace = "Gst", name = "Object"})
    Ptr Object ->                           -- newobj : TInterface (Name {namespace = "Gst", name = "Object"})
    IO CInt

-- | Atomically modifies a pointer to point to a new object.
-- The reference count of /@oldobj@/ is decreased and the reference count of
-- /@newobj@/ is increased.
-- 
-- Either /@newobj@/ and the value pointed to by /@oldobj@/ may be 'P.Nothing'.
objectReplace ::
    (B.CallStack.HasCallStack, MonadIO m, IsObject a, IsObject b) =>
    Maybe (a)
    -- ^ /@oldobj@/: pointer to a place of
    --     a t'GI.Gst.Objects.Object.Object' to replace
    -> Maybe (b)
    -- ^ /@newobj@/: a new t'GI.Gst.Objects.Object.Object'
    -> m ((Bool, Maybe Object))
    -- ^ __Returns:__ 'P.True' if /@newobj@/ was different from /@oldobj@/
objectReplace :: Maybe a -> Maybe b -> m (Bool, Maybe Object)
objectReplace Maybe a
oldobj Maybe b
newobj = IO (Bool, Maybe Object) -> m (Bool, Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Maybe Object) -> m (Bool, Maybe Object))
-> IO (Bool, Maybe Object) -> m (Bool, Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
maybeOldobj <- case Maybe a
oldobj of
        Maybe a
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just a
jOldobj -> do
            Ptr Object
jOldobj' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject a
jOldobj
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jOldobj'
    Ptr (Ptr Object)
maybeOldobj' <- IO (Ptr (Ptr Object))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Object))
    Ptr (Ptr Object) -> Ptr Object -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Object)
maybeOldobj' Ptr Object
maybeOldobj
    Ptr Object
maybeNewobj <- case Maybe b
newobj of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jNewobj -> do
            Ptr Object
jNewobj' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jNewobj
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jNewobj'
    CInt
result <- Ptr (Ptr Object) -> Ptr Object -> IO CInt
gst_object_replace Ptr (Ptr Object)
maybeOldobj' Ptr Object
maybeNewobj
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Object
maybeOldobj'' <- Ptr (Ptr Object) -> IO (Ptr Object)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Object)
maybeOldobj'
    Maybe Object
maybeMaybeOldobj'' <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
maybeOldobj'' ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
maybeOldobj''' -> do
        Object
maybeOldobj'''' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
Object) Ptr Object
maybeOldobj'''
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
maybeOldobj''''
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
oldobj a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
newobj b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (Ptr Object) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Object)
maybeOldobj'
    (Bool, Maybe Object) -> IO (Bool, Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Maybe Object
maybeMaybeOldobj'')

#if defined(ENABLE_OVERLOADING)
#endif