{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Interfaces.Container.Container' is an opaque structure whose members cannot be directly
-- accessed
-- 
-- /Since: 0.4/

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

module GI.Clutter.Interfaces.Container
    ( 
#if defined(ENABLE_OVERLOADING)
    ContainerClassListChildPropertiesMethodInfo,
#endif

-- * Exported types
    Container(..)                           ,
    IsContainer                             ,
    toContainer                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addActor]("GI.Clutter.Interfaces.Container#g:method:addActor"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childGetProperty]("GI.Clutter.Interfaces.Container#g:method:childGetProperty"), [childNotify]("GI.Clutter.Interfaces.Container#g:method:childNotify"), [childSetProperty]("GI.Clutter.Interfaces.Container#g:method:childSetProperty"), [createChildMeta]("GI.Clutter.Interfaces.Container#g:method:createChildMeta"), [destroyChildMeta]("GI.Clutter.Interfaces.Container#g:method:destroyChildMeta"), [findChildByName]("GI.Clutter.Interfaces.Container#g:method:findChildByName"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.Clutter.Interfaces.Container#g:method:foreach"), [foreachWithInternals]("GI.Clutter.Interfaces.Container#g:method:foreachWithInternals"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [lowerChild]("GI.Clutter.Interfaces.Container#g:method:lowerChild"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [raiseChild]("GI.Clutter.Interfaces.Container#g:method:raiseChild"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeActor]("GI.Clutter.Interfaces.Container#g:method:removeActor"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sortDepthOrder]("GI.Clutter.Interfaces.Container#g:method:sortDepthOrder"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getChildMeta]("GI.Clutter.Interfaces.Container#g:method:getChildMeta"), [getChildren]("GI.Clutter.Interfaces.Container#g:method:getChildren"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveContainerMethod                  ,
#endif

-- ** addActor #method:addActor#

#if defined(ENABLE_OVERLOADING)
    ContainerAddActorMethodInfo             ,
#endif
    containerAddActor                       ,


-- ** childGetProperty #method:childGetProperty#

#if defined(ENABLE_OVERLOADING)
    ContainerChildGetPropertyMethodInfo     ,
#endif
    containerChildGetProperty               ,


-- ** childNotify #method:childNotify#

#if defined(ENABLE_OVERLOADING)
    ContainerChildNotifyMethodInfo          ,
#endif
    containerChildNotify                    ,


-- ** childSetProperty #method:childSetProperty#

#if defined(ENABLE_OVERLOADING)
    ContainerChildSetPropertyMethodInfo     ,
#endif
    containerChildSetProperty               ,


-- ** classFindChildProperty #method:classFindChildProperty#

    containerClassFindChildProperty         ,


-- ** createChildMeta #method:createChildMeta#

#if defined(ENABLE_OVERLOADING)
    ContainerCreateChildMetaMethodInfo      ,
#endif
    containerCreateChildMeta                ,


-- ** destroyChildMeta #method:destroyChildMeta#

#if defined(ENABLE_OVERLOADING)
    ContainerDestroyChildMetaMethodInfo     ,
#endif
    containerDestroyChildMeta               ,


-- ** findChildByName #method:findChildByName#

#if defined(ENABLE_OVERLOADING)
    ContainerFindChildByNameMethodInfo      ,
#endif
    containerFindChildByName                ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    ContainerForeachMethodInfo              ,
#endif
    containerForeach                        ,


-- ** foreachWithInternals #method:foreachWithInternals#

#if defined(ENABLE_OVERLOADING)
    ContainerForeachWithInternalsMethodInfo ,
#endif
    containerForeachWithInternals           ,


-- ** getChildMeta #method:getChildMeta#

#if defined(ENABLE_OVERLOADING)
    ContainerGetChildMetaMethodInfo         ,
#endif
    containerGetChildMeta                   ,


-- ** getChildren #method:getChildren#

#if defined(ENABLE_OVERLOADING)
    ContainerGetChildrenMethodInfo          ,
#endif
    containerGetChildren                    ,


-- ** lowerChild #method:lowerChild#

#if defined(ENABLE_OVERLOADING)
    ContainerLowerChildMethodInfo           ,
#endif
    containerLowerChild                     ,


-- ** raiseChild #method:raiseChild#

#if defined(ENABLE_OVERLOADING)
    ContainerRaiseChildMethodInfo           ,
#endif
    containerRaiseChild                     ,


-- ** removeActor #method:removeActor#

#if defined(ENABLE_OVERLOADING)
    ContainerRemoveActorMethodInfo          ,
#endif
    containerRemoveActor                    ,


-- ** sortDepthOrder #method:sortDepthOrder#

#if defined(ENABLE_OVERLOADING)
    ContainerSortDepthOrderMethodInfo       ,
#endif
    containerSortDepthOrder                 ,




 -- * Signals


-- ** actorAdded #signal:actorAdded#

    ContainerActorAddedCallback             ,
#if defined(ENABLE_OVERLOADING)
    ContainerActorAddedSignalInfo           ,
#endif
    afterContainerActorAdded                ,
    onContainerActorAdded                   ,


-- ** actorRemoved #signal:actorRemoved#

    ContainerActorRemovedCallback           ,
#if defined(ENABLE_OVERLOADING)
    ContainerActorRemovedSignalInfo         ,
#endif
    afterContainerActorRemoved              ,
    onContainerActorRemoved                 ,


-- ** childNotify #signal:childNotify#

    ContainerChildNotifyCallback            ,
#if defined(ENABLE_OVERLOADING)
    ContainerChildNotifySignalInfo          ,
#endif
    afterContainerChildNotify               ,
    onContainerChildNotify                  ,




    ) where

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

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

import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ChildMeta as Clutter.ChildMeta
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass

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

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

foreign import ccall "clutter_container_get_type"
    c_clutter_container_get_type :: IO B.Types.GType

instance B.Types.TypedObject Container where
    glibType :: IO GType
glibType = IO GType
c_clutter_container_get_type

instance B.Types.GObject Container

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

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

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

-- | Convert 'Container' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Container) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_container_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Container -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Container
P.Nothing = Ptr GValue -> Ptr Container -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Container
forall a. Ptr a
FP.nullPtr :: FP.Ptr Container)
    gvalueSet_ Ptr GValue
gv (P.Just Container
obj) = Container -> (Ptr Container -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Container
obj (Ptr GValue -> Ptr Container -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Container)
gvalueGet_ Ptr GValue
gv = do
        Ptr Container
ptr <- Ptr GValue -> IO (Ptr Container)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Container)
        if Ptr Container
ptr Ptr Container -> Ptr Container -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Container
forall a. Ptr a
FP.nullPtr
        then Container -> Maybe Container
forall a. a -> Maybe a
P.Just (Container -> Maybe Container)
-> IO Container -> IO (Maybe Container)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Container -> Container)
-> Ptr Container -> IO Container
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Container -> Container
Container Ptr Container
ptr
        else Maybe Container -> IO (Maybe Container)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Container
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Container
type instance O.AttributeList Container = ContainerAttributeList
type ContainerAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveContainerMethod (t :: Symbol) (o :: *) :: * where
    ResolveContainerMethod "addActor" o = ContainerAddActorMethodInfo
    ResolveContainerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContainerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContainerMethod "childGetProperty" o = ContainerChildGetPropertyMethodInfo
    ResolveContainerMethod "childNotify" o = ContainerChildNotifyMethodInfo
    ResolveContainerMethod "childSetProperty" o = ContainerChildSetPropertyMethodInfo
    ResolveContainerMethod "createChildMeta" o = ContainerCreateChildMetaMethodInfo
    ResolveContainerMethod "destroyChildMeta" o = ContainerDestroyChildMetaMethodInfo
    ResolveContainerMethod "findChildByName" o = ContainerFindChildByNameMethodInfo
    ResolveContainerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContainerMethod "foreach" o = ContainerForeachMethodInfo
    ResolveContainerMethod "foreachWithInternals" o = ContainerForeachWithInternalsMethodInfo
    ResolveContainerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContainerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContainerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContainerMethod "lowerChild" o = ContainerLowerChildMethodInfo
    ResolveContainerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContainerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContainerMethod "raiseChild" o = ContainerRaiseChildMethodInfo
    ResolveContainerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContainerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContainerMethod "removeActor" o = ContainerRemoveActorMethodInfo
    ResolveContainerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContainerMethod "sortDepthOrder" o = ContainerSortDepthOrderMethodInfo
    ResolveContainerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContainerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContainerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContainerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContainerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContainerMethod "getChildMeta" o = ContainerGetChildMetaMethodInfo
    ResolveContainerMethod "getChildren" o = ContainerGetChildrenMethodInfo
    ResolveContainerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContainerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContainerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContainerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContainerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContainerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContainerMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveContainerMethod t Container, O.OverloadedMethod info Container p, R.HasField t Container p) => R.HasField t Container p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- method Container::add_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first #ClutterActor to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_add_actor" clutter_container_add_actor :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

{-# DEPRECATED containerAddActor ["(Since version 1.10)","Use 'GI.Clutter.Objects.Actor.actorAddChild' instead."] #-}
-- | Adds a t'GI.Clutter.Objects.Actor.Actor' to /@container@/. This function will emit the
-- \"actor-added\" signal. The actor should be parented to
-- /@container@/. You cannot add a t'GI.Clutter.Objects.Actor.Actor' to more than one
-- t'GI.Clutter.Interfaces.Container.Container'.
-- 
-- This function will call t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/add/@(), which is a
-- deprecated virtual function. The default implementation will
-- call 'GI.Clutter.Objects.Actor.actorAddChild'.
-- 
-- /Since: 0.4/
containerAddActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: the first t'GI.Clutter.Objects.Actor.Actor' to add
    -> m ()
containerAddActor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> m ()
containerAddActor a
container b
actor = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Container -> Ptr Actor -> IO ()
clutter_container_add_actor Ptr Container
container' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerAddActorMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerAddActorMethodInfo a signature where
    overloadedMethod = containerAddActor

instance O.OverloadedMethodInfo ContainerAddActorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerAddActor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerAddActor"
        })


#endif

-- method Container::child_get_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterActor that is a child of @container."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_child_get_property" clutter_container_child_get_property :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CString ->                              -- property : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Gets a container specific property of a child of /@container@/, In general,
-- a copy is made of the property contents and the caller is responsible for
-- freeing the memory by calling 'GI.GObject.Structs.Value.valueUnset'.
-- 
-- Note that 'GI.Clutter.Interfaces.Container.containerChildSetProperty' is really intended for
-- language bindings, @/clutter_container_child_set()/@ is much more convenient
-- for C programming.
-- 
-- /Since: 0.8/
containerChildGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@child@/: a t'GI.Clutter.Objects.Actor.Actor' that is a child of /@container@/.
    -> T.Text
    -- ^ /@property@/: the name of the property to set.
    -> GValue
    -- ^ /@value@/: the value.
    -> m ()
containerChildGetProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> Text -> GValue -> m ()
containerChildGetProperty a
container b
child Text
property GValue
value = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
child' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Container -> Ptr Actor -> CString -> Ptr GValue -> IO ()
clutter_container_child_get_property Ptr Container
container' Ptr Actor
child' CString
property' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerChildGetPropertyMethodInfo
instance (signature ~ (b -> T.Text -> GValue -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerChildGetPropertyMethodInfo a signature where
    overloadedMethod = containerChildGetProperty

instance O.OverloadedMethodInfo ContainerChildGetPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerChildGetProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerChildGetProperty"
        })


#endif

-- method Container::child_notify
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_child_notify" clutter_container_child_notify :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    IO ()

-- | Calls the t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/child_notify/@() virtual function
-- of t'GI.Clutter.Interfaces.Container.Container'. The default implementation will emit the
-- [childNotify]("GI.Clutter.Interfaces.Container#g:signal:childNotify") signal.
-- 
-- /Since: 1.6/
containerChildNotify ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@child@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> GParamSpec
    -- ^ /@pspec@/: a t'GI.GObject.Objects.ParamSpec.ParamSpec'
    -> m ()
containerChildNotify :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> GParamSpec -> m ()
containerChildNotify a
container b
child GParamSpec
pspec = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
child' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr Container -> Ptr Actor -> Ptr GParamSpec -> IO ()
clutter_container_child_notify Ptr Container
container' Ptr Actor
child' Ptr GParamSpec
pspec'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerChildNotifyMethodInfo
instance (signature ~ (b -> GParamSpec -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerChildNotifyMethodInfo a signature where
    overloadedMethod = containerChildNotify

instance O.OverloadedMethodInfo ContainerChildNotifyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerChildNotify",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerChildNotify"
        })


#endif

-- method Container::child_set_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterActor that is a child of @container."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_child_set_property" clutter_container_child_set_property :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CString ->                              -- property : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets a container-specific property on a child of /@container@/.
-- 
-- /Since: 0.8/
containerChildSetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@child@/: a t'GI.Clutter.Objects.Actor.Actor' that is a child of /@container@/.
    -> T.Text
    -- ^ /@property@/: the name of the property to set.
    -> GValue
    -- ^ /@value@/: the value.
    -> m ()
containerChildSetProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> Text -> GValue -> m ()
containerChildSetProperty a
container b
child Text
property GValue
value = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
child' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Container -> Ptr Actor -> CString -> Ptr GValue -> IO ()
clutter_container_child_set_property Ptr Container
container' Ptr Actor
child' CString
property' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerChildSetPropertyMethodInfo
instance (signature ~ (b -> T.Text -> GValue -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerChildSetPropertyMethodInfo a signature where
    overloadedMethod = containerChildSetProperty

instance O.OverloadedMethodInfo ContainerChildSetPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerChildSetProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerChildSetProperty"
        })


#endif

-- method Container::create_child_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_create_child_meta" clutter_container_create_child_meta :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Creates the t'GI.Clutter.Objects.ChildMeta.ChildMeta' wrapping /@actor@/ inside the
-- /@container@/, if the t'GI.Clutter.Structs.ContainerIface.ContainerIface'::@/child_meta_type/@
-- class member is not set to @/G_TYPE_INVALID/@.
-- 
-- This function is only useful when adding a t'GI.Clutter.Objects.Actor.Actor' to
-- a t'GI.Clutter.Interfaces.Container.Container' implementation outside of the
-- t'GI.Clutter.Interfaces.Container.Container'::@/add/@() virtual function implementation.
-- 
-- Applications should not call this function.
-- 
-- /Since: 1.2/
containerCreateChildMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
containerCreateChildMeta :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> m ()
containerCreateChildMeta a
container b
actor = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Container -> Ptr Actor -> IO ()
clutter_container_create_child_meta Ptr Container
container' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerCreateChildMetaMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerCreateChildMetaMethodInfo a signature where
    overloadedMethod = containerCreateChildMeta

instance O.OverloadedMethodInfo ContainerCreateChildMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerCreateChildMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerCreateChildMeta"
        })


#endif

-- method Container::destroy_child_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_destroy_child_meta" clutter_container_destroy_child_meta :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Destroys the t'GI.Clutter.Objects.ChildMeta.ChildMeta' wrapping /@actor@/ inside the
-- /@container@/, if any.
-- 
-- This function is only useful when removing a t'GI.Clutter.Objects.Actor.Actor' to
-- a t'GI.Clutter.Interfaces.Container.Container' implementation outside of the
-- t'GI.Clutter.Interfaces.Container.Container'::@/add/@() virtual function implementation.
-- 
-- Applications should not call this function.
-- 
-- /Since: 1.2/
containerDestroyChildMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
containerDestroyChildMeta :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> m ()
containerDestroyChildMeta a
container b
actor = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Container -> Ptr Actor -> IO ()
clutter_container_destroy_child_meta Ptr Container
container' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerDestroyChildMetaMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerDestroyChildMetaMethodInfo a signature where
    overloadedMethod = containerDestroyChildMeta

instance O.OverloadedMethodInfo ContainerDestroyChildMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerDestroyChildMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerDestroyChildMeta"
        })


#endif

-- method Container::find_child_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the requested child."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_find_child_by_name" clutter_container_find_child_by_name :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    CString ->                              -- child_name : TBasicType TUTF8
    IO (Ptr Clutter.Actor.Actor)

-- | Finds a child actor of a container by its name. Search recurses
-- into any child container.
-- 
-- /Since: 0.6/
containerFindChildByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> T.Text
    -- ^ /@childName@/: the name of the requested child.
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ The child actor with the requested name,
    --   or 'P.Nothing' if no actor with that name was found.
containerFindChildByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContainer a) =>
a -> Text -> m Actor
containerFindChildByName a
container Text
childName = IO Actor -> m Actor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    CString
childName' <- Text -> IO CString
textToCString Text
childName
    Ptr Actor
result <- Ptr Container -> CString -> IO (Ptr Actor)
clutter_container_find_child_by_name Ptr Container
container' CString
childName'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"containerFindChildByName" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
childName'
    Actor -> IO Actor
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data ContainerFindChildByNameMethodInfo
instance (signature ~ (T.Text -> m Clutter.Actor.Actor), MonadIO m, IsContainer a) => O.OverloadedMethod ContainerFindChildByNameMethodInfo a signature where
    overloadedMethod = containerFindChildByName

instance O.OverloadedMethodInfo ContainerFindChildByNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerFindChildByName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerFindChildByName"
        })


#endif

-- method Container::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to be called for each child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the function, 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 "clutter_container_foreach" clutter_container_foreach :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    FunPtr Clutter.Callbacks.C_Callback ->  -- callback : TInterface (Name {namespace = "Clutter", name = "Callback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED containerForeach ["(Since version 1.10)","Use 'GI.Clutter.Objects.Actor.actorGetFirstChild' or","  'GI.Clutter.Objects.Actor.actorGetLastChild' to retrieve the beginning of","  the list of children, and 'GI.Clutter.Objects.Actor.actorGetNextSibling'","  and 'GI.Clutter.Objects.Actor.actorGetPreviousSibling' to iterate over it;","  alternatively, use the t'GI.Clutter.Structs.ActorIter.ActorIter' API."] #-}
-- | Calls /@callback@/ for each child of /@container@/ that was added
-- by the application (with 'GI.Clutter.Interfaces.Container.containerAddActor'). Does
-- not iterate over \"internal\" children that are part of the
-- container\'s own implementation, if any.
-- 
-- This function calls the t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/foreach/@()
-- virtual function, which has been deprecated.
-- 
-- /Since: 0.4/
containerForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> Clutter.Callbacks.Callback
    -- ^ /@callback@/: a function to be called for each child
    -> m ()
containerForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContainer a) =>
a -> Callback -> m ()
containerForeach a
container Callback
callback = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    FunPtr C_Callback
callback' <- C_Callback -> IO (FunPtr C_Callback)
Clutter.Callbacks.mk_Callback (Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
Clutter.Callbacks.wrap_Callback Maybe (Ptr (FunPtr C_Callback))
forall a. Maybe a
Nothing (Callback -> Callback_WithClosures
Clutter.Callbacks.drop_closures_Callback Callback
callback))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Container -> FunPtr C_Callback -> Ptr () -> IO ()
clutter_container_foreach Ptr Container
container' FunPtr C_Callback
callback' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_Callback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_Callback
callback'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerForeachMethodInfo
instance (signature ~ (Clutter.Callbacks.Callback -> m ()), MonadIO m, IsContainer a) => O.OverloadedMethod ContainerForeachMethodInfo a signature where
    overloadedMethod = containerForeach

instance O.OverloadedMethodInfo ContainerForeachMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerForeach"
        })


#endif

-- method Container::foreach_with_internals
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a function to be called for each child"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the function, 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 "clutter_container_foreach_with_internals" clutter_container_foreach_with_internals :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    FunPtr Clutter.Callbacks.C_Callback ->  -- callback : TInterface (Name {namespace = "Clutter", name = "Callback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED containerForeachWithInternals ["(Since version 1.10)","See 'GI.Clutter.Interfaces.Container.containerForeach'."] #-}
-- | Calls /@callback@/ for each child of /@container@/, including \"internal\"
-- children built in to the container itself that were never added
-- by the application.
-- 
-- This function calls the t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/foreach_with_internals/@()
-- virtual function, which has been deprecated.
-- 
-- /Since: 1.0/
containerForeachWithInternals ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> Clutter.Callbacks.Callback
    -- ^ /@callback@/: a function to be called for each child
    -> m ()
containerForeachWithInternals :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContainer a) =>
a -> Callback -> m ()
containerForeachWithInternals a
container Callback
callback = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    FunPtr C_Callback
callback' <- C_Callback -> IO (FunPtr C_Callback)
Clutter.Callbacks.mk_Callback (Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
Clutter.Callbacks.wrap_Callback Maybe (Ptr (FunPtr C_Callback))
forall a. Maybe a
Nothing (Callback -> Callback_WithClosures
Clutter.Callbacks.drop_closures_Callback Callback
callback))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Container -> FunPtr C_Callback -> Ptr () -> IO ()
clutter_container_foreach_with_internals Ptr Container
container' FunPtr C_Callback
callback' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_Callback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_Callback
callback'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerForeachWithInternalsMethodInfo
instance (signature ~ (Clutter.Callbacks.Callback -> m ()), MonadIO m, IsContainer a) => O.OverloadedMethod ContainerForeachWithInternalsMethodInfo a signature where
    overloadedMethod = containerForeachWithInternals

instance O.OverloadedMethodInfo ContainerForeachWithInternalsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerForeachWithInternals",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerForeachWithInternals"
        })


#endif

-- method Container::get_child_meta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #ClutterActor that is a child of @container."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "ChildMeta" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_get_child_meta" clutter_container_get_child_meta :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO (Ptr Clutter.ChildMeta.ChildMeta)

-- | Retrieves the t'GI.Clutter.Objects.ChildMeta.ChildMeta' which contains the data about the
-- /@container@/ specific state for /@actor@/.
-- 
-- /Since: 0.8/
containerGetChildMeta ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor' that is a child of /@container@/.
    -> m Clutter.ChildMeta.ChildMeta
    -- ^ __Returns:__ the t'GI.Clutter.Objects.ChildMeta.ChildMeta' for the /@actor@/ child
    --   of /@container@/ or 'P.Nothing' if the specifiec actor does not exist or the
    --   container is not configured to provide t'GI.Clutter.Objects.ChildMeta.ChildMeta's
containerGetChildMeta :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> m ChildMeta
containerGetChildMeta a
container b
actor = IO ChildMeta -> m ChildMeta
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChildMeta -> m ChildMeta) -> IO ChildMeta -> m ChildMeta
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr ChildMeta
result <- Ptr Container -> Ptr Actor -> IO (Ptr ChildMeta)
clutter_container_get_child_meta Ptr Container
container' Ptr Actor
actor'
    Text -> Ptr ChildMeta -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"containerGetChildMeta" Ptr ChildMeta
result
    ChildMeta
result' <- ((ManagedPtr ChildMeta -> ChildMeta)
-> Ptr ChildMeta -> IO ChildMeta
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ChildMeta -> ChildMeta
Clutter.ChildMeta.ChildMeta) Ptr ChildMeta
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    ChildMeta -> IO ChildMeta
forall (m :: * -> *) a. Monad m => a -> m a
return ChildMeta
result'

#if defined(ENABLE_OVERLOADING)
data ContainerGetChildMetaMethodInfo
instance (signature ~ (b -> m Clutter.ChildMeta.ChildMeta), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerGetChildMetaMethodInfo a signature where
    overloadedMethod = containerGetChildMeta

instance O.OverloadedMethodInfo ContainerGetChildMetaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerGetChildMeta",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerGetChildMeta"
        })


#endif

-- method Container::get_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Clutter" , name = "Actor" }))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_get_children" clutter_container_get_children :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    IO (Ptr (GList (Ptr Clutter.Actor.Actor)))

{-# DEPRECATED containerGetChildren ["(Since version 1.10)","Use 'GI.Clutter.Objects.Actor.actorGetChildren' instead."] #-}
-- | Retrieves all the children of /@container@/.
-- 
-- /Since: 0.4/
containerGetChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> m [Clutter.Actor.Actor]
    -- ^ __Returns:__ a list
    --   of t'GI.Clutter.Objects.Actor.Actor's. Use @/g_list_free()/@ on the returned
    --   list when done.
containerGetChildren :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContainer a) =>
a -> m [Actor]
containerGetChildren a
container = IO [Actor] -> m [Actor]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Actor] -> m [Actor]) -> IO [Actor] -> m [Actor]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr (GList (Ptr Actor))
result <- Ptr Container -> IO (Ptr (GList (Ptr Actor)))
clutter_container_get_children Ptr Container
container'
    [Ptr Actor]
result' <- Ptr (GList (Ptr Actor)) -> IO [Ptr Actor]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Actor))
result
    [Actor]
result'' <- (Ptr Actor -> IO Actor) -> [Ptr Actor] -> IO [Actor]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) [Ptr Actor]
result'
    Ptr (GList (Ptr Actor)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Actor))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    [Actor] -> IO [Actor]
forall (m :: * -> *) a. Monad m => a -> m a
return [Actor]
result''

#if defined(ENABLE_OVERLOADING)
data ContainerGetChildrenMethodInfo
instance (signature ~ (m [Clutter.Actor.Actor]), MonadIO m, IsContainer a) => O.OverloadedMethod ContainerGetChildrenMethodInfo a signature where
    overloadedMethod = containerGetChildren

instance O.OverloadedMethodInfo ContainerGetChildrenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerGetChildren",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerGetChildren"
        })


#endif

-- method Container::lower_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the actor to raise" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sibling"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the sibling to lower to, or %NULL to lower\n  to the bottom"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_lower_child" clutter_container_lower_child :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr Clutter.Actor.Actor ->              -- sibling : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

{-# DEPRECATED containerLowerChild ["(Since version 1.10)","Use 'GI.Clutter.Objects.Actor.actorSetChildBelowSibling' instead."] #-}
-- | Lowers /@actor@/ to /@sibling@/ level, in the depth ordering.
-- 
-- This function calls the t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/lower/@() virtual function,
-- which has been deprecated. The default implementation will call
-- 'GI.Clutter.Objects.Actor.actorSetChildBelowSibling'.
-- 
-- /Since: 0.6/
containerLowerChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b, Clutter.Actor.IsActor c) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: the actor to raise
    -> Maybe (c)
    -- ^ /@sibling@/: the sibling to lower to, or 'P.Nothing' to lower
    --   to the bottom
    -> m ()
containerLowerChild :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsContainer a, IsActor b, IsActor c) =>
a -> b -> Maybe c -> m ()
containerLowerChild a
container b
actor Maybe c
sibling = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Actor
maybeSibling <- case Maybe c
sibling of
        Maybe c
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just c
jSibling -> do
            Ptr Actor
jSibling' <- c -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jSibling
            Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jSibling'
    Ptr Container -> Ptr Actor -> Ptr Actor -> IO ()
clutter_container_lower_child Ptr Container
container' Ptr Actor
actor' Ptr Actor
maybeSibling
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
sibling c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerLowerChildMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b, Clutter.Actor.IsActor c) => O.OverloadedMethod ContainerLowerChildMethodInfo a signature where
    overloadedMethod = containerLowerChild

instance O.OverloadedMethodInfo ContainerLowerChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerLowerChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerLowerChild"
        })


#endif

-- method Container::raise_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the actor to raise" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sibling"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the sibling to raise to, or %NULL to raise\n  to the top"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_raise_child" clutter_container_raise_child :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    Ptr Clutter.Actor.Actor ->              -- sibling : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

{-# DEPRECATED containerRaiseChild ["(Since version 1.10)","Use 'GI.Clutter.Objects.Actor.actorSetChildAboveSibling' instead."] #-}
-- | Raises /@actor@/ to /@sibling@/ level, in the depth ordering.
-- 
-- This function calls the t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/raise/@() virtual function,
-- which has been deprecated. The default implementation will call
-- 'GI.Clutter.Objects.Actor.actorSetChildAboveSibling'.
-- 
-- /Since: 0.6/
containerRaiseChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b, Clutter.Actor.IsActor c) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: the actor to raise
    -> Maybe (c)
    -- ^ /@sibling@/: the sibling to raise to, or 'P.Nothing' to raise
    --   to the top
    -> m ()
containerRaiseChild :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsContainer a, IsActor b, IsActor c) =>
a -> b -> Maybe c -> m ()
containerRaiseChild a
container b
actor Maybe c
sibling = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Actor
maybeSibling <- case Maybe c
sibling of
        Maybe c
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just c
jSibling -> do
            Ptr Actor
jSibling' <- c -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jSibling
            Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jSibling'
    Ptr Container -> Ptr Actor -> Ptr Actor -> IO ()
clutter_container_raise_child Ptr Container
container' Ptr Actor
actor' Ptr Actor
maybeSibling
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
sibling c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerRaiseChildMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b, Clutter.Actor.IsActor c) => O.OverloadedMethod ContainerRaiseChildMethodInfo a signature where
    overloadedMethod = containerRaiseChild

instance O.OverloadedMethodInfo ContainerRaiseChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerRaiseChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerRaiseChild"
        })


#endif

-- method Container::remove_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContainer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_remove_actor" clutter_container_remove_actor :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    Ptr Clutter.Actor.Actor ->              -- actor : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

{-# DEPRECATED containerRemoveActor ["(Since version 1.10)","Use 'GI.Clutter.Objects.Actor.actorRemoveChild' instead."] #-}
-- | Removes /@actor@/ from /@container@/. The actor should be unparented, so
-- if you want to keep it around you must hold a reference to it
-- yourself, using 'GI.GObject.Objects.Object.objectRef'. When the actor has been removed,
-- the \"actor-removed\" signal is emitted by /@container@/.
-- 
-- This function will call t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/remove/@(), which is a
-- deprecated virtual function. The default implementation will call
-- 'GI.Clutter.Objects.Actor.actorRemoveChild'.
-- 
-- /Since: 0.4/
containerRemoveActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> b
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
containerRemoveActor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsActor b) =>
a -> b -> m ()
containerRemoveActor a
container b
actor = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    Ptr Container -> Ptr Actor -> IO ()
clutter_container_remove_actor Ptr Container
container' Ptr Actor
actor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerRemoveActorMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContainer a, Clutter.Actor.IsActor b) => O.OverloadedMethod ContainerRemoveActorMethodInfo a signature where
    overloadedMethod = containerRemoveActor

instance O.OverloadedMethodInfo ContainerRemoveActorMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerRemoveActor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerRemoveActor"
        })


#endif

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

foreign import ccall "clutter_container_sort_depth_order" clutter_container_sort_depth_order :: 
    Ptr Container ->                        -- container : TInterface (Name {namespace = "Clutter", name = "Container"})
    IO ()

{-# DEPRECATED containerSortDepthOrder ["(Since version 1.10)","The t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/sort_depth_order/@() virtual","  function should not be used any more; the default implementation in","  t'GI.Clutter.Interfaces.Container.Container' does not do anything."] #-}
-- | Sorts a container\'s children using their depth. This function should not
-- be normally used by applications.
-- 
-- /Since: 0.6/
containerSortDepthOrder ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainer a) =>
    a
    -- ^ /@container@/: a t'GI.Clutter.Interfaces.Container.Container'
    -> m ()
containerSortDepthOrder :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContainer a) =>
a -> m ()
containerSortDepthOrder a
container = 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 Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Container -> IO ()
clutter_container_sort_depth_order Ptr Container
container'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContainerSortDepthOrderMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContainer a) => O.OverloadedMethod ContainerSortDepthOrderMethodInfo a signature where
    overloadedMethod = containerSortDepthOrder

instance O.OverloadedMethodInfo ContainerSortDepthOrderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container.containerSortDepthOrder",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#v:containerSortDepthOrder"
        })


#endif

-- method Container::class_find_child_property
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "klass"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ObjectClass" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GObjectClass implementing the #ClutterContainer interface."
--                 , 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 "a property name." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TParamSpec
-- throws : False
-- Skip return : False

foreign import ccall "clutter_container_class_find_child_property" clutter_container_class_find_child_property :: 
    Ptr GObject.ObjectClass.ObjectClass ->  -- klass : TInterface (Name {namespace = "GObject", name = "ObjectClass"})
    CString ->                              -- property_name : TBasicType TUTF8
    IO (Ptr GParamSpec)

-- | Looks up the t'GI.GObject.Objects.ParamSpec.ParamSpec' for a child property of /@klass@/.
-- 
-- /Since: 0.8/
containerClassFindChildProperty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GObject.ObjectClass.ObjectClass
    -- ^ /@klass@/: a t'GI.GObject.Structs.ObjectClass.ObjectClass' implementing the t'GI.Clutter.Interfaces.Container.Container' interface.
    -> T.Text
    -- ^ /@propertyName@/: a property name.
    -> m GParamSpec
    -- ^ __Returns:__ The t'GI.GObject.Objects.ParamSpec.ParamSpec' for the property or 'P.Nothing'
    --   if no such property exist.
containerClassFindChildProperty :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ObjectClass -> Text -> m GParamSpec
containerClassFindChildProperty ObjectClass
klass Text
propertyName = IO GParamSpec -> m GParamSpec
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GParamSpec -> m GParamSpec) -> IO GParamSpec -> m GParamSpec
forall a b. (a -> b) -> a -> b
$ do
    Ptr ObjectClass
klass' <- ObjectClass -> IO (Ptr ObjectClass)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ObjectClass
klass
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GParamSpec
result <- Ptr ObjectClass -> CString -> IO (Ptr GParamSpec)
clutter_container_class_find_child_property Ptr ObjectClass
klass' CString
propertyName'
    Text -> Ptr GParamSpec -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"containerClassFindChildProperty" Ptr GParamSpec
result
    GParamSpec
result' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
result
    ObjectClass -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ObjectClass
klass
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    GParamSpec -> IO GParamSpec
forall (m :: * -> *) a. Monad m => a -> m a
return GParamSpec
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- XXX Could not generate method Container::class_list_child_properties
-- Not implemented: unpackCArray : Don't know how to unpack C Array of type TParamSpec
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data ContainerClassListChildPropertiesMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "classListChildProperties" Container) => O.OverloadedMethod ContainerClassListChildPropertiesMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "classListChildProperties" Container) => O.OverloadedMethodInfo ContainerClassListChildPropertiesMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- signal Container::actor-added
-- | The [actorAdded](#g:signal:actorAdded) signal is emitted each time an actor
-- has been added to /@container@/.
-- 
-- /Since: 0.4/
type ContainerActorAddedCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the new child that has been added to /@container@/
    -> IO ()

type C_ContainerActorAddedCallback =
    Ptr Container ->                        -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ContainerActorAddedCallback :: 
    GObject a => (a -> ContainerActorAddedCallback) ->
    C_ContainerActorAddedCallback
wrap_ContainerActorAddedCallback :: forall a.
GObject a =>
(a -> Callback) -> C_ContainerActorAddedCallback
wrap_ContainerActorAddedCallback a -> Callback
gi'cb Ptr Container
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    Ptr Container -> (Container -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Container
gi'selfPtr ((Container -> IO ()) -> IO ()) -> (Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Container
gi'self -> a -> Callback
gi'cb (Container -> a
Coerce.coerce Container
gi'self)  Actor
actor'


-- | Connect a signal handler for the [actorAdded](#signal:actorAdded) 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' container #actorAdded callback
-- @
-- 
-- 
onContainerActorAdded :: (IsContainer a, MonadIO m) => a -> ((?self :: a) => ContainerActorAddedCallback) -> m SignalHandlerId
onContainerActorAdded :: forall a (m :: * -> *).
(IsContainer a, MonadIO m) =>
a -> ((?self::a) => Callback) -> m SignalHandlerId
onContainerActorAdded a
obj (?self::a) => Callback
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 wrapped :: a -> Callback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => Callback
Callback
cb
    let wrapped' :: C_ContainerActorAddedCallback
wrapped' = (a -> Callback) -> C_ContainerActorAddedCallback
forall a.
GObject a =>
(a -> Callback) -> C_ContainerActorAddedCallback
wrap_ContainerActorAddedCallback a -> Callback
wrapped
    FunPtr C_ContainerActorAddedCallback
wrapped'' <- C_ContainerActorAddedCallback
-> IO (FunPtr C_ContainerActorAddedCallback)
mk_ContainerActorAddedCallback C_ContainerActorAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContainerActorAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"actor-added" FunPtr C_ContainerActorAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [actorAdded](#signal:actorAdded) 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' container #actorAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterContainerActorAdded :: (IsContainer a, MonadIO m) => a -> ((?self :: a) => ContainerActorAddedCallback) -> m SignalHandlerId
afterContainerActorAdded :: forall a (m :: * -> *).
(IsContainer a, MonadIO m) =>
a -> ((?self::a) => Callback) -> m SignalHandlerId
afterContainerActorAdded a
obj (?self::a) => Callback
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 wrapped :: a -> Callback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => Callback
Callback
cb
    let wrapped' :: C_ContainerActorAddedCallback
wrapped' = (a -> Callback) -> C_ContainerActorAddedCallback
forall a.
GObject a =>
(a -> Callback) -> C_ContainerActorAddedCallback
wrap_ContainerActorAddedCallback a -> Callback
wrapped
    FunPtr C_ContainerActorAddedCallback
wrapped'' <- C_ContainerActorAddedCallback
-> IO (FunPtr C_ContainerActorAddedCallback)
mk_ContainerActorAddedCallback C_ContainerActorAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContainerActorAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"actor-added" FunPtr C_ContainerActorAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContainerActorAddedSignalInfo
instance SignalInfo ContainerActorAddedSignalInfo where
    type HaskellCallbackType ContainerActorAddedSignalInfo = ContainerActorAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContainerActorAddedCallback cb
        cb'' <- mk_ContainerActorAddedCallback cb'
        connectSignalFunPtr obj "actor-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container::actor-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#g:signal:actorAdded"})

#endif

-- signal Container::actor-removed
-- | The [actorRemoved](#g:signal:actorRemoved) signal is emitted each time an actor
-- is removed from /@container@/.
-- 
-- /Since: 0.4/
type ContainerActorRemovedCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the child that has been removed from /@container@/
    -> IO ()

type C_ContainerActorRemovedCallback =
    Ptr Container ->                        -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ContainerActorRemovedCallback :: 
    GObject a => (a -> ContainerActorRemovedCallback) ->
    C_ContainerActorRemovedCallback
wrap_ContainerActorRemovedCallback :: forall a.
GObject a =>
(a -> Callback) -> C_ContainerActorAddedCallback
wrap_ContainerActorRemovedCallback a -> Callback
gi'cb Ptr Container
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    Ptr Container -> (Container -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Container
gi'selfPtr ((Container -> IO ()) -> IO ()) -> (Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Container
gi'self -> a -> Callback
gi'cb (Container -> a
Coerce.coerce Container
gi'self)  Actor
actor'


-- | Connect a signal handler for the [actorRemoved](#signal:actorRemoved) 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' container #actorRemoved callback
-- @
-- 
-- 
onContainerActorRemoved :: (IsContainer a, MonadIO m) => a -> ((?self :: a) => ContainerActorRemovedCallback) -> m SignalHandlerId
onContainerActorRemoved :: forall a (m :: * -> *).
(IsContainer a, MonadIO m) =>
a -> ((?self::a) => Callback) -> m SignalHandlerId
onContainerActorRemoved a
obj (?self::a) => Callback
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 wrapped :: a -> Callback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => Callback
Callback
cb
    let wrapped' :: C_ContainerActorAddedCallback
wrapped' = (a -> Callback) -> C_ContainerActorAddedCallback
forall a.
GObject a =>
(a -> Callback) -> C_ContainerActorAddedCallback
wrap_ContainerActorRemovedCallback a -> Callback
wrapped
    FunPtr C_ContainerActorAddedCallback
wrapped'' <- C_ContainerActorAddedCallback
-> IO (FunPtr C_ContainerActorAddedCallback)
mk_ContainerActorRemovedCallback C_ContainerActorAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContainerActorAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"actor-removed" FunPtr C_ContainerActorAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [actorRemoved](#signal:actorRemoved) 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' container #actorRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterContainerActorRemoved :: (IsContainer a, MonadIO m) => a -> ((?self :: a) => ContainerActorRemovedCallback) -> m SignalHandlerId
afterContainerActorRemoved :: forall a (m :: * -> *).
(IsContainer a, MonadIO m) =>
a -> ((?self::a) => Callback) -> m SignalHandlerId
afterContainerActorRemoved a
obj (?self::a) => Callback
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 wrapped :: a -> Callback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => Callback
Callback
cb
    let wrapped' :: C_ContainerActorAddedCallback
wrapped' = (a -> Callback) -> C_ContainerActorAddedCallback
forall a.
GObject a =>
(a -> Callback) -> C_ContainerActorAddedCallback
wrap_ContainerActorRemovedCallback a -> Callback
wrapped
    FunPtr C_ContainerActorAddedCallback
wrapped'' <- C_ContainerActorAddedCallback
-> IO (FunPtr C_ContainerActorAddedCallback)
mk_ContainerActorRemovedCallback C_ContainerActorAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContainerActorAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"actor-removed" FunPtr C_ContainerActorAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContainerActorRemovedSignalInfo
instance SignalInfo ContainerActorRemovedSignalInfo where
    type HaskellCallbackType ContainerActorRemovedSignalInfo = ContainerActorRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContainerActorRemovedCallback cb
        cb'' <- mk_ContainerActorRemovedCallback cb'
        connectSignalFunPtr obj "actor-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container::actor-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#g:signal:actorRemoved"})

#endif

-- signal Container::child-notify
-- | The [childNotify](#g:signal:childNotify) signal is emitted each time a property is
-- being set through the @/clutter_container_child_set()/@ and
-- 'GI.Clutter.Interfaces.Container.containerChildSetProperty' calls.
-- 
-- /Since: 0.8/
type ContainerChildNotifyCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the child that has had a property set
    -> GParamSpec
    -- ^ /@pspec@/: the t'GI.GObject.Objects.ParamSpec.ParamSpec' of the property set
    -> IO ()

type C_ContainerChildNotifyCallback =
    Ptr Container ->                        -- object
    Ptr Clutter.Actor.Actor ->
    Ptr GParamSpec ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ContainerChildNotifyCallback :: 
    GObject a => (a -> ContainerChildNotifyCallback) ->
    C_ContainerChildNotifyCallback
wrap_ContainerChildNotifyCallback :: forall a.
GObject a =>
(a -> ContainerChildNotifyCallback)
-> C_ContainerChildNotifyCallback
wrap_ContainerChildNotifyCallback a -> ContainerChildNotifyCallback
gi'cb Ptr Container
gi'selfPtr Ptr Actor
actor Ptr GParamSpec
pspec Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    GParamSpec
pspec' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
pspec
    Ptr Container -> (Container -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Container
gi'selfPtr ((Container -> IO ()) -> IO ()) -> (Container -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Container
gi'self -> a -> ContainerChildNotifyCallback
gi'cb (Container -> a
Coerce.coerce Container
gi'self)  Actor
actor' GParamSpec
pspec'


-- | Connect a signal handler for the [childNotify](#signal:childNotify) 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' container #childNotify callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@child-notify::detail@” instead.
-- 
onContainerChildNotify :: (IsContainer a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => ContainerChildNotifyCallback) -> m SignalHandlerId
onContainerChildNotify :: forall a (m :: * -> *).
(IsContainer a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => ContainerChildNotifyCallback)
-> m SignalHandlerId
onContainerChildNotify a
obj Maybe Text
detail (?self::a) => ContainerChildNotifyCallback
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 wrapped :: a -> ContainerChildNotifyCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ContainerChildNotifyCallback
ContainerChildNotifyCallback
cb
    let wrapped' :: C_ContainerChildNotifyCallback
wrapped' = (a -> ContainerChildNotifyCallback)
-> C_ContainerChildNotifyCallback
forall a.
GObject a =>
(a -> ContainerChildNotifyCallback)
-> C_ContainerChildNotifyCallback
wrap_ContainerChildNotifyCallback a -> ContainerChildNotifyCallback
wrapped
    FunPtr C_ContainerChildNotifyCallback
wrapped'' <- C_ContainerChildNotifyCallback
-> IO (FunPtr C_ContainerChildNotifyCallback)
mk_ContainerChildNotifyCallback C_ContainerChildNotifyCallback
wrapped'
    a
-> Text
-> FunPtr C_ContainerChildNotifyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-notify" FunPtr C_ContainerChildNotifyCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
detail

-- | Connect a signal handler for the [childNotify](#signal:childNotify) 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' container #childNotify callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@child-notify::detail@” instead.
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterContainerChildNotify :: (IsContainer a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => ContainerChildNotifyCallback) -> m SignalHandlerId
afterContainerChildNotify :: forall a (m :: * -> *).
(IsContainer a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => ContainerChildNotifyCallback)
-> m SignalHandlerId
afterContainerChildNotify a
obj Maybe Text
detail (?self::a) => ContainerChildNotifyCallback
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 wrapped :: a -> ContainerChildNotifyCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ContainerChildNotifyCallback
ContainerChildNotifyCallback
cb
    let wrapped' :: C_ContainerChildNotifyCallback
wrapped' = (a -> ContainerChildNotifyCallback)
-> C_ContainerChildNotifyCallback
forall a.
GObject a =>
(a -> ContainerChildNotifyCallback)
-> C_ContainerChildNotifyCallback
wrap_ContainerChildNotifyCallback a -> ContainerChildNotifyCallback
wrapped
    FunPtr C_ContainerChildNotifyCallback
wrapped'' <- C_ContainerChildNotifyCallback
-> IO (FunPtr C_ContainerChildNotifyCallback)
mk_ContainerChildNotifyCallback C_ContainerChildNotifyCallback
wrapped'
    a
-> Text
-> FunPtr C_ContainerChildNotifyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"child-notify" FunPtr C_ContainerChildNotifyCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
detail


#if defined(ENABLE_OVERLOADING)
data ContainerChildNotifySignalInfo
instance SignalInfo ContainerChildNotifySignalInfo where
    type HaskellCallbackType ContainerChildNotifySignalInfo = ContainerChildNotifyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContainerChildNotifyCallback cb
        cb'' <- mk_ContainerChildNotifyCallback cb'
        connectSignalFunPtr obj "child-notify" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Container::child-notify"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Interfaces-Container.html#g:signal:childNotify"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Container = ContainerSignalList
type ContainerSignalList = ('[ '("actorAdded", ContainerActorAddedSignalInfo), '("actorRemoved", ContainerActorRemovedSignalInfo), '("childNotify", ContainerChildNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif