{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Base interface for container specific state for child actors. A child
-- data is meant to be used when you need to keep track of information
-- about each individual child added to a container.
-- 
-- In order to use it you should create your own subclass of
-- t'GI.Clutter.Objects.ChildMeta.ChildMeta' and set the t'GI.Clutter.Structs.ContainerIface.ContainerIface' child_meta_type
-- interface member to your subclass type, like:
-- 
-- >
-- >static void
-- >my_container_iface_init (ClutterContainerIface *iface)
-- >{
-- >  // set the rest of the #ClutterContainer vtable
-- >
-- >  container_iface->child_meta_type  = MY_TYPE_CHILD_META;
-- >}
-- 
-- 
-- This will automatically create a t'GI.Clutter.Objects.ChildMeta.ChildMeta' of type
-- @MY_TYPE_CHILD_META@ for every actor that is added to the container.
-- 
-- The child data for an actor can be retrieved using the
-- 'GI.Clutter.Interfaces.Container.containerGetChildMeta' function.
-- 
-- The properties of the data and your subclass can be manipulated with
-- @/clutter_container_child_set()/@ and @/clutter_container_child_get()/@ which
-- act like @/g_object_set()/@ and @/g_object_get()/@.
-- 
-- You can provide hooks for your own storage as well as control the
-- instantiation by overriding the t'GI.Clutter.Structs.ContainerIface.ContainerIface' virtual functions
-- t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/create_child_meta/@(), t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/destroy_child_meta/@(),
-- and t'GI.Clutter.Structs.ContainerIface.ContainerIface'.@/get_child_meta/@().
-- 
-- /Since: 0.8/

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

module GI.Clutter.Objects.ChildMeta
    ( 

-- * Exported types
    ChildMeta(..)                           ,
    IsChildMeta                             ,
    toChildMeta                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [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
-- [getActor]("GI.Clutter.Objects.ChildMeta#g:method:getActor"), [getContainer]("GI.Clutter.Objects.ChildMeta#g:method:getContainer"), [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)
    ResolveChildMetaMethod                  ,
#endif

-- ** getActor #method:getActor#

#if defined(ENABLE_OVERLOADING)
    ChildMetaGetActorMethodInfo             ,
#endif
    childMetaGetActor                       ,


-- ** getContainer #method:getContainer#

#if defined(ENABLE_OVERLOADING)
    ChildMetaGetContainerMethodInfo         ,
#endif
    childMetaGetContainer                   ,




 -- * Properties


-- ** actor #attr:actor#
-- | The t'GI.Clutter.Objects.Actor.Actor' being wrapped by this t'GI.Clutter.Objects.ChildMeta.ChildMeta'
-- 
-- /Since: 0.8/

#if defined(ENABLE_OVERLOADING)
    ChildMetaActorPropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    childMetaActor                          ,
#endif
    constructChildMetaActor                 ,
    getChildMetaActor                       ,


-- ** container #attr:container#
-- | The t'GI.Clutter.Interfaces.Container.Container' that created this t'GI.Clutter.Objects.ChildMeta.ChildMeta'.
-- 
-- /Since: 0.8/

#if defined(ENABLE_OVERLOADING)
    ChildMetaContainerPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    childMetaContainer                      ,
#endif
    constructChildMetaContainer             ,
    getChildMetaContainer                   ,




    ) 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 {-# SOURCE #-} qualified GI.Clutter.Interfaces.Container as Clutter.Container
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_child_meta_get_type"
    c_clutter_child_meta_get_type :: IO B.Types.GType

instance B.Types.TypedObject ChildMeta where
    glibType :: IO GType
glibType = IO GType
c_clutter_child_meta_get_type

instance B.Types.GObject ChildMeta

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

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

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

-- | Convert 'ChildMeta' 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 ChildMeta) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_child_meta_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ChildMeta -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ChildMeta
P.Nothing = Ptr GValue -> Ptr ChildMeta -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ChildMeta
forall a. Ptr a
FP.nullPtr :: FP.Ptr ChildMeta)
    gvalueSet_ Ptr GValue
gv (P.Just ChildMeta
obj) = ChildMeta -> (Ptr ChildMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ChildMeta
obj (Ptr GValue -> Ptr ChildMeta -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ChildMeta)
gvalueGet_ Ptr GValue
gv = do
        Ptr ChildMeta
ptr <- Ptr GValue -> IO (Ptr ChildMeta)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ChildMeta)
        if Ptr ChildMeta
ptr Ptr ChildMeta -> Ptr ChildMeta -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ChildMeta
forall a. Ptr a
FP.nullPtr
        then ChildMeta -> Maybe ChildMeta
forall a. a -> Maybe a
P.Just (ChildMeta -> Maybe ChildMeta)
-> IO ChildMeta -> IO (Maybe ChildMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ChildMeta -> ChildMeta)
-> Ptr ChildMeta -> IO ChildMeta
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ChildMeta -> ChildMeta
ChildMeta Ptr ChildMeta
ptr
        else Maybe ChildMeta -> IO (Maybe ChildMeta)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChildMeta
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveChildMetaMethod (t :: Symbol) (o :: *) :: * where
    ResolveChildMetaMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveChildMetaMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveChildMetaMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveChildMetaMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveChildMetaMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveChildMetaMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveChildMetaMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveChildMetaMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveChildMetaMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveChildMetaMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveChildMetaMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveChildMetaMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveChildMetaMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveChildMetaMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveChildMetaMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveChildMetaMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveChildMetaMethod "getActor" o = ChildMetaGetActorMethodInfo
    ResolveChildMetaMethod "getContainer" o = ChildMetaGetContainerMethodInfo
    ResolveChildMetaMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveChildMetaMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveChildMetaMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveChildMetaMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveChildMetaMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveChildMetaMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveChildMetaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveChildMetaMethod t ChildMeta, O.OverloadedMethod info ChildMeta p) => OL.IsLabel t (ChildMeta -> 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 ~ ResolveChildMetaMethod t ChildMeta, O.OverloadedMethod info ChildMeta p, R.HasField t ChildMeta p) => R.HasField t ChildMeta p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- VVV Prop "actor"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Actor"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@actor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' childMeta #actor
-- @
getChildMetaActor :: (MonadIO m, IsChildMeta o) => o -> m Clutter.Actor.Actor
getChildMetaActor :: forall (m :: * -> *) o. (MonadIO m, IsChildMeta o) => o -> m Actor
getChildMetaActor o
obj = IO Actor -> m Actor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Actor) -> IO Actor
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getChildMetaActor" (IO (Maybe Actor) -> IO Actor) -> IO (Maybe Actor) -> IO Actor
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Actor -> Actor) -> IO (Maybe Actor)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"actor" ManagedPtr Actor -> Actor
Clutter.Actor.Actor

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

#if defined(ENABLE_OVERLOADING)
data ChildMetaActorPropertyInfo
instance AttrInfo ChildMetaActorPropertyInfo where
    type AttrAllowedOps ChildMetaActorPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ChildMetaActorPropertyInfo = IsChildMeta
    type AttrSetTypeConstraint ChildMetaActorPropertyInfo = Clutter.Actor.IsActor
    type AttrTransferTypeConstraint ChildMetaActorPropertyInfo = Clutter.Actor.IsActor
    type AttrTransferType ChildMetaActorPropertyInfo = Clutter.Actor.Actor
    type AttrGetType ChildMetaActorPropertyInfo = Clutter.Actor.Actor
    type AttrLabel ChildMetaActorPropertyInfo = "actor"
    type AttrOrigin ChildMetaActorPropertyInfo = ChildMeta
    attrGet = getChildMetaActor
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Clutter.Actor.Actor v
    attrConstruct = constructChildMetaActor
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ChildMeta.actor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-ChildMeta.html#g:attr:actor"
        })
#endif

-- VVV Prop "container"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Container"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@container@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' childMeta #container
-- @
getChildMetaContainer :: (MonadIO m, IsChildMeta o) => o -> m Clutter.Container.Container
getChildMetaContainer :: forall (m :: * -> *) o.
(MonadIO m, IsChildMeta o) =>
o -> m Container
getChildMetaContainer o
obj = IO Container -> m Container
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Container -> m Container) -> IO Container -> m Container
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Container) -> IO Container
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getChildMetaContainer" (IO (Maybe Container) -> IO Container)
-> IO (Maybe Container) -> IO Container
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Container -> Container)
-> IO (Maybe Container)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"container" ManagedPtr Container -> Container
Clutter.Container.Container

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

#if defined(ENABLE_OVERLOADING)
data ChildMetaContainerPropertyInfo
instance AttrInfo ChildMetaContainerPropertyInfo where
    type AttrAllowedOps ChildMetaContainerPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ChildMetaContainerPropertyInfo = IsChildMeta
    type AttrSetTypeConstraint ChildMetaContainerPropertyInfo = Clutter.Container.IsContainer
    type AttrTransferTypeConstraint ChildMetaContainerPropertyInfo = Clutter.Container.IsContainer
    type AttrTransferType ChildMetaContainerPropertyInfo = Clutter.Container.Container
    type AttrGetType ChildMetaContainerPropertyInfo = Clutter.Container.Container
    type AttrLabel ChildMetaContainerPropertyInfo = "container"
    type AttrOrigin ChildMetaContainerPropertyInfo = ChildMeta
    attrGet = getChildMetaContainer
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Clutter.Container.Container v
    attrConstruct = constructChildMetaContainer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ChildMeta.container"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-ChildMeta.html#g:attr:container"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ChildMeta
type instance O.AttributeList ChildMeta = ChildMetaAttributeList
type ChildMetaAttributeList = ('[ '("actor", ChildMetaActorPropertyInfo), '("container", ChildMetaContainerPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
childMetaActor :: AttrLabelProxy "actor"
childMetaActor = AttrLabelProxy

childMetaContainer :: AttrLabelProxy "container"
childMetaContainer = AttrLabelProxy

#endif

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

#endif

-- method ChildMeta::get_actor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "data"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ChildMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterChildMeta"
--                 , 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_child_meta_get_actor" clutter_child_meta_get_actor :: 
    Ptr ChildMeta ->                        -- data : TInterface (Name {namespace = "Clutter", name = "ChildMeta"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves the actor wrapped by /@data@/
-- 
-- /Since: 0.8/
childMetaGetActor ::
    (B.CallStack.HasCallStack, MonadIO m, IsChildMeta a) =>
    a
    -- ^ /@data@/: a t'GI.Clutter.Objects.ChildMeta.ChildMeta'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Actor.Actor'
childMetaGetActor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsChildMeta a) =>
a -> m Actor
childMetaGetActor a
data_ = 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 ChildMeta
data_' <- a -> IO (Ptr ChildMeta)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
data_
    Ptr Actor
result <- Ptr ChildMeta -> IO (Ptr Actor)
clutter_child_meta_get_actor Ptr ChildMeta
data_'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"childMetaGetActor" 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
data_
    Actor -> IO Actor
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data ChildMetaGetActorMethodInfo
instance (signature ~ (m Clutter.Actor.Actor), MonadIO m, IsChildMeta a) => O.OverloadedMethod ChildMetaGetActorMethodInfo a signature where
    overloadedMethod = childMetaGetActor

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


#endif

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

foreign import ccall "clutter_child_meta_get_container" clutter_child_meta_get_container :: 
    Ptr ChildMeta ->                        -- data : TInterface (Name {namespace = "Clutter", name = "ChildMeta"})
    IO (Ptr Clutter.Container.Container)

-- | Retrieves the container using /@data@/
-- 
-- /Since: 0.8/
childMetaGetContainer ::
    (B.CallStack.HasCallStack, MonadIO m, IsChildMeta a) =>
    a
    -- ^ /@data@/: a t'GI.Clutter.Objects.ChildMeta.ChildMeta'
    -> m Clutter.Container.Container
    -- ^ __Returns:__ a t'GI.Clutter.Interfaces.Container.Container'
childMetaGetContainer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsChildMeta a) =>
a -> m Container
childMetaGetContainer a
data_ = IO Container -> m Container
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Container -> m Container) -> IO Container -> m Container
forall a b. (a -> b) -> a -> b
$ do
    Ptr ChildMeta
data_' <- a -> IO (Ptr ChildMeta)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
data_
    Ptr Container
result <- Ptr ChildMeta -> IO (Ptr Container)
clutter_child_meta_get_container Ptr ChildMeta
data_'
    Text -> Ptr Container -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"childMetaGetContainer" Ptr Container
result
    Container
result' <- ((ManagedPtr Container -> Container)
-> Ptr Container -> IO Container
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Container -> Container
Clutter.Container.Container) Ptr Container
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
data_
    Container -> IO Container
forall (m :: * -> *) a. Monad m => a -> m a
return Container
result'

#if defined(ENABLE_OVERLOADING)
data ChildMetaGetContainerMethodInfo
instance (signature ~ (m Clutter.Container.Container), MonadIO m, IsChildMeta a) => O.OverloadedMethod ChildMetaGetContainerMethodInfo a signature where
    overloadedMethod = childMetaGetContainer

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


#endif